This commit was generated by cvs2svn to compensate for changes in r37, which
[chise/xemacs-chise.git.1] / src / lisp-union.h
1 /* Fundamental definitions for XEmacs Lisp interpreter -- union objects.
2    Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
3    Free Software Foundation, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Divergent from FSF.  */
23
24 /* Definition of Lisp_Object type as a union.
25    The declaration order of the objects within the struct members
26    of the union is dependent on ENDIAN-ness and USE_MINIMAL_TAGBITS.
27    See lisp-disunion.h for more details.  */
28
29 typedef
30 union Lisp_Object
31 {
32   /* if non-valbits are at lower addresses */
33 #if defined(WORDS_BIGENDIAN) == defined(USE_MINIMAL_TAGBITS)
34   struct
35   {
36     EMACS_UINT val : VALBITS;
37 #if GCMARKBITS > 0
38     unsigned int markbit: GCMARKBITS;
39 #endif
40     enum_field (Lisp_Type) type : GCTYPEBITS;
41   } gu;
42
43   struct
44   {
45     signed EMACS_INT val : INT_VALBITS;
46     unsigned int bits : INT_GCBITS;
47   } s;
48
49   struct
50   {
51     EMACS_UINT val : INT_VALBITS;
52     unsigned int bits : INT_GCBITS;
53   } u;
54 #else /* non-valbits are at higher addresses */
55   struct
56   {
57     enum_field (Lisp_Type) type : GCTYPEBITS;
58 #if GCMARKBITS > 0
59     unsigned int markbit: GCMARKBITS;
60 #endif
61     EMACS_UINT val : VALBITS;
62   } gu;
63
64   struct
65   {
66     unsigned int bits : INT_GCBITS;
67     signed EMACS_INT val : INT_VALBITS;
68   } s;
69
70   struct
71   {
72     unsigned int bits : INT_GCBITS;
73     EMACS_UINT val : INT_VALBITS;
74   } u;
75
76 #endif /* non-valbits are at higher addresses */
77
78   EMACS_UINT ui;
79   signed EMACS_INT i;
80
81   /* This was formerly declared 'void *v' etc. but that causes
82      GCC to accept any (yes, any) pointer as the argument of
83      a function declared to accept a Lisp_Object. */
84   struct nosuchstruct *v;
85   CONST struct nosuchstruct *cv;
86 }
87 Lisp_Object;
88
89 #define XCHARVAL(x) ((x).gu.val)
90
91 #ifdef USE_MINIMAL_TAGBITS
92
93 # define XSETINT(var, value) do {       \
94   EMACS_INT xset_value = (value);       \
95   Lisp_Object *xset_var = &(var);       \
96   xset_var->s.bits = 1;                 \
97   xset_var->s.val = xset_value;         \
98 } while (0)
99 # define XSETCHAR(var, value) do {      \
100   Emchar xset_value = (value);          \
101   Lisp_Object *xset_var = &(var);       \
102   xset_var->gu.type = Lisp_Type_Char;   \
103   xset_var->gu.val = xset_value;        \
104 } while (0)
105 # define XSETOBJ(var, vartype, value) do {      \
106   EMACS_UINT xset_value = (EMACS_UINT) (value); \
107   (var).ui = xset_value;                        \
108 } while (0)
109 # define XPNTRVAL(x) ((x).ui)
110
111 #else /* ! USE_MINIMAL_TAGBITS */
112
113 # define XSETOBJ(var, vartype, value) do {      \
114   EMACS_UINT xset_value = (EMACS_UINT) (value); \
115   Lisp_Object *xset_var = &(var);               \
116   xset_var->gu.type = (vartype);                \
117   xset_var->gu.markbit = 0;                     \
118   xset_var->gu.val = xset_value;                \
119 } while (0)
120 # define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value)
121 # define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
122 # define XPNTRVAL(x) ((x).gu.val)
123
124 #endif /* ! USE_MINIMAL_TAGBITS */
125
126 INLINE Lisp_Object make_int (EMACS_INT val);
127 INLINE Lisp_Object
128 make_int (EMACS_INT val)
129 {
130   Lisp_Object obj;
131   XSETINT(obj, val);
132   return obj;
133 }
134
135 INLINE Lisp_Object make_char (Emchar val);
136 INLINE Lisp_Object
137 make_char (Emchar val)
138 {
139   Lisp_Object obj;
140   XSETCHAR(obj, val);
141   return obj;
142 }
143
144 extern Lisp_Object Qnull_pointer, Qzero;
145
146 #define XREALINT(x) ((x).s.val)
147 #define XUINT(x) ((x).u.val)
148 #define XTYPE(x) ((x).gu.type)
149 #define XGCTYPE(x) XTYPE (x)
150 #define EQ(x,y) ((x).v == (y).v)
151
152 #ifdef USE_MINIMAL_TAGBITS
153 #define INTP(x) ((x).s.bits)
154 #define GC_EQ(x,y) EQ (x, y)
155 #else
156 #define INTP(x) (XTYPE(x) == Lisp_Type_Int)
157 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y))
158 #endif
159
160 #if GCMARKBITS > 0
161 /* XMARKBIT accesses the markbit.  Markbits are used only in
162    particular slots of particular structure types.  Other markbits are
163    always zero.  Outside of garbage collection, all mark bits are
164    always zero. */
165 # define XMARKBIT(x) ((x).gu.markbit)
166 # define XMARK(x) ((void) (XMARKBIT (x) = 1))
167 # define XUNMARK(x) ((void) (XMARKBIT (x) = 0))
168 #else
169 # define XUNMARK(x) DO_NOTHING
170 #endif
171
172 /* Convert between a (void *) and a Lisp_Object, as when the
173    Lisp_Object is passed to a toolkit callback function */
174 #define VOID_TO_LISP(larg,varg) \
175      ((void) ((larg).v = (struct nosuchstruct *) (varg)))
176 #define CVOID_TO_LISP(larg,varg) \
177      ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg)))
178 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
179 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
180
181 /* Convert a Lisp_Object into something that can't be used as an
182    lvalue.  Useful for type-checking. */
183 #if (__GNUC__ > 1)
184 #define NON_LVALUE(larg) ({ (larg); })
185 #else
186 /* Well, you can't really do it without using a function call, and
187    there's no real point in that; no-union-type is the rule, and that
188    will catch errors. */
189 #define NON_LVALUE(larg) (larg)
190 #endif