Mercurial > hg > xemacs-beta

comparison src/lisp-union.h @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 11cf20601dec
children 8626e4521993
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
17 You should have received a copy of the GNU General Public License 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 18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
21 21
22 /* Synched up with: FSF 19.30. Split out from lisp.h. */ 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. */
23 28
24 typedef 29 typedef
25 union Lisp_Object 30 union Lisp_Object
26 { 31 {
32 /* if non-valbits are at lower addresses */
33 #if defined(WORDS_BIGENDIAN) == defined(USE_MINIMAL_TAGBITS)
27 struct 34 struct
28 { 35 {
29 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) 36 EMACS_UINT val : VALBITS;
30 /* Big-endian lowtags, little-endian hightags */ 37 #if GCMARKBITS > 0
31 unsigned EMACS_INT type_mark: GCTYPEBITS + GCMARKBITS; 38 unsigned int markbit: GCMARKBITS;
32 signed EMACS_INT val: VALBITS; 39 #endif
33 #else /* If WORDS_BIGENDIAN, or little-endian hightags */ 40 enum_field (Lisp_Type) type : GCTYPEBITS;
34 signed EMACS_INT val: VALBITS; 41 } gu;
35 unsigned EMACS_INT mark_type: GCTYPEBITS + GCMARKBITS; 42
36 #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
37 } s;
38 struct 43 struct
39 { 44 {
40 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS)) 45 signed EMACS_INT val : INT_VALBITS;
41 unsigned EMACS_INT val: VALBITS; 46 unsigned int bits : INT_GCBITS;
42 #endif 47 } s;
43 #ifdef __GNUC__ /* Non-ANSI extension */ 48
44 enum Lisp_Type type: GCTYPEBITS;
45 #else
46 unsigned EMACS_INT type: GCTYPEBITS;
47 #endif /* __GNUC__ */
48 /* The markbit is not really part of the value of a Lisp_Object,
49 and is always zero except during garbage collection. */
50 #if GCMARKBITS > 0
51 unsigned EMACS_INT markbit: GCMARKBITS;
52 #endif
53 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
54 unsigned EMACS_INT val: VALBITS;
55 #endif
56 } gu;
57 #ifdef USE_MINIMAL_TAGBITS
58 struct 49 struct
59 { 50 {
60 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) 51 EMACS_UINT val : INT_VALBITS;
61 unsigned bit: GCTYPEBITS - 1; 52 unsigned int bits : INT_GCBITS;
62 #endif 53 } u;
63 signed EMACS_INT val: VALBITS + 1; 54 #else /* non-valbits are at higher addresses */
64 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
65 unsigned bit: GCTYPEBITS - 1;
66 #endif
67 } si;
68 struct 55 struct
69 { 56 {
70 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) 57 enum_field (Lisp_Type) type : GCTYPEBITS;
71 unsigned bit: GCTYPEBITS - 1; 58 #if GCMARKBITS > 0
59 unsigned int markbit: GCMARKBITS;
72 #endif 60 #endif
73 unsigned EMACS_INT val: VALBITS + 1; 61 EMACS_UINT val : VALBITS;
74 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS)) 62 } gu;
75 unsigned bit: GCTYPEBITS - 1; 63
76 #endif 64 struct
77 } u_i; 65 {
78 #endif /* USE_MINIMAL_TAGBITS */ 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
79 EMACS_UINT ui; 78 EMACS_UINT ui;
80 EMACS_INT i; 79 signed EMACS_INT i;
81 /* GCC bites yet again. I fart in the general direction of
82 the GCC authors.
83 80
84 This was formerly declared 'void *v' etc. but that causes 81 /* This was formerly declared 'void *v' etc. but that causes
85 GCC to accept any (yes, any) pointer as the argument of 82 GCC to accept any (yes, any) pointer as the argument of
86 a function declared to accept a Lisp_Object. */ 83 a function declared to accept a Lisp_Object. */
87 struct __nosuchstruct__ *v; 84 struct nosuchstruct *v;
88 CONST struct __nosuchstruct__ *cv; /* C wanks */ 85 CONST struct nosuchstruct *cv;
89 } 86 }
90 Lisp_Object; 87 Lisp_Object;
91 88
92 #ifndef USE_MINIMAL_TAGBITS 89 #define XCHARVAL(x) ((x).gu.val)
93 #ifndef XMAKE_LISP 90
94 #if (__GNUC__ > 1) 91 #ifdef USE_MINIMAL_TAGBITS
95 /* Use GCC's struct initializers feature */ 92 # define XSETINT(var, value) do { \
96 #define XMAKE_LISP(vartype,value) \ 93 Lisp_Object *_xzx = &(var); \
97 ((union Lisp_Object) { gu: { markbit: 0, \ 94 _xzx->s.val = (value); \
98 type: (vartype), \ 95 _xzx->s.bits = 1; \
99 val: ((unsigned EMACS_INT) value) } }) 96 } while (0)
100 #endif /* __GNUC__ */ 97 # define XSETCHAR(var, value) do { \
101 #endif /* !XMAKE_LISP */ 98 Lisp_Object *_xzx = &(var); \
99 _xzx->gu.val = (EMACS_UINT) (value); \
100 _xzx->gu.type = Lisp_Type_Char; \
101 } while (0)
102 # define XSETOBJ(var, vartype, value) \
103 ((void) ((var).ui = (EMACS_UINT) (value)))
104 # define XPNTRVAL(x) ((x).ui)
105 #else /* ! USE_MINIMAL_TAGBITS */
106 # define XSETOBJ(var, vartype, value) do { \
107 Lisp_Object *_xzx = &(var); \
108 _xzx->gu.val = (EMACS_UINT) (value); \
109 _xzx->gu.type = (vartype); \
110 _xzx->gu.markbit = 0; \
111 } while (0)
112 # define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value)
113 # define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
114 # define XPNTRVAL(x) ((x).gu.val)
102 #endif /* ! USE_MINIMAL_TAGBITS */ 115 #endif /* ! USE_MINIMAL_TAGBITS */
103 116
104 #ifdef XMAKE_LISP 117 INLINE Lisp_Object make_int (EMACS_INT val);
105 #define Qzero (XMAKE_LISP (Lisp_Type_Int, 0)) 118 INLINE Lisp_Object
106 #define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a))) 119 make_int (EMACS_INT val)
107 #define make_char(a) (XMAKE_LISP (Lisp_Type_Char, (a))) 120 {
121 Lisp_Object obj;
122 XSETINT(obj, val);
123 return obj;
124 }
125
126 INLINE Lisp_Object make_char (Emchar val);
127 INLINE Lisp_Object
128 make_char (Emchar val)
129 {
130 Lisp_Object obj;
131 XSETCHAR(obj, val);
132 return obj;
133 }
134
135 extern Lisp_Object Qnull_pointer, Qzero;
136
137 #define XREALINT(x) ((x).s.val)
138 #define XUINT(x) ((x).u.val)
139 #define XTYPE(x) ((x).gu.type)
140 #define XGCTYPE(x) XTYPE (x)
141 #define EQ(x,y) ((x).v == (y).v)
142
143 #ifdef USE_MINIMAL_TAGBITS
144 #define INTP(x) ((x).s.bits)
145 #define GC_EQ(x,y) EQ (x, y)
108 #else 146 #else
109 extern Lisp_Object Qzero; 147 #define INTP(x) (XTYPE(x) == Lisp_Type_Int)
148 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y))
110 #endif 149 #endif
111 150
112 extern Lisp_Object Qnull_pointer; 151 #if GCMARKBITS > 0
113 152 /* XMARKBIT accesses the markbit. Markbits are used only in
114 #define EQ(x,y) ((x).v == (y).v) 153 particular slots of particular structure types. Other markbits are
115 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type) 154 always zero. Outside of garbage collection, all mark bits are
116 155 always zero. */
117 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type) 156 # define XMARKBIT(x) ((x).gu.markbit)
118 #define XGCTYPE(a) XTYPE (a) 157 # define XMARK(x) ((void) (XMARKBIT (x) = 1))
119 158 # define XUNMARK(x) ((void) (XMARKBIT (x) = 0))
120 /* This was commented out a long time ago. I uncommented it, but it
121 makes the Alpha crash, and that's the only system that would use
122 this, so it stays commented out. */
123 #if 0 /* EXPLICIT_SIGN_EXTEND */
124 /* Make sure we sign-extend; compilers have been known to fail to do so. */
125 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
126 #else 159 #else
127 #ifdef USE_MINIMAL_TAGBITS 160 # define XUNMARK(x) DO_NOTHING
128 # define XREALINT(a) ((a).si.val)
129 #else
130 # define XREALINT(a) ((a).s.val)
131 #endif
132 #endif /* EXPLICIT_SIGN_EXTEND */
133
134 #ifdef USE_MINIMAL_TAGBITS
135 # define XUINT(a) ((a).u_i.val)
136 #else
137 # define XUINT(a) XPNTRVAL(a)
138 #endif 161 #endif
139 162
140 #ifdef USE_MINIMAL_TAGBITS 163 /* Convert between a (void *) and a Lisp_Object, as when the
141 # define XPNTRVAL(a) ((a).ui) 164 Lisp_Object is passed to a toolkit callback function */
142 # define XCHARVAL(a) ((a).gu.val)
143 #else
144 # define XPNTRVAL(a) ((a).gu.val)
145 # define XCHARVAL(a) XPNTRVAL(a)
146 #endif
147
148 #ifdef HAVE_SHM
149 /* In this representation, data is found in two widely separated segments. */
150 extern int pure_size;
151 # define XPNTR(a) \
152 ((void *)(XPNTRVAL(a)) | (XPNTRVAL(a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)))
153 #else /* not HAVE_SHM */
154 # ifdef DATA_SEG_BITS
155 /* This case is used for the rt-pc and hp-pa.
156 In the diffs I was given, it checked for ptr = 0
157 and did not adjust it in that case.
158 But I don't think that zero should ever be found
159 in a Lisp object whose data type says it points to something.
160 */
161 # define XPNTR(a) ((void *)((XPNTRVAL(a)) | DATA_SEG_BITS))
162 # else /* not DATA_SEG_BITS */
163 # define XPNTR(a) ((void *) (XPNTRVAL(a)))
164 # endif /* not DATA_SEG_BITS */
165 #endif /* not HAVE_SHM */
166
167 #ifdef USE_MINIMAL_TAGBITS
168 # define XSETINT(a, b) \
169 do { Lisp_Object *_xzx = &(a) ; \
170 (*_xzx).si.val = (b) ; \
171 (*_xzx).si.bit = 1; \
172 } while (0)
173 # define XSETCHAR(a, b) \
174 do { Lisp_Object *_xzx = &(a) ; \
175 (*_xzx).gu.val = (b) ; \
176 (*_xzx).gu.type = Lisp_Type_Char; \
177 } while (0)
178 #else
179 # define XSETINT(a, b) ((void) ((a) = make_int (b)))
180 # define XSETCHAR(a, b) ((void) ((a) = make_char (b)))
181 #endif
182
183 /* XSETOBJ was formerly named XSET. The name change was made to catch
184 C code that attempts to use this macro. You should always use the
185 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
186
187 #ifdef USE_MINIMAL_TAGBITS
188 # define XSETOBJ(var, vartype, value) \
189 ((void) ((var).ui = (EMACS_UINT)(value)))
190 #else
191 # ifdef XMAKE_LISP
192 # define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b)))
193 # else
194 /* This is haired up to avoid evaluating var twice...
195 This is necessary only in the "union" version.
196 The "int" version has never done double evaluation.
197 */
198 /* XEmacs change: put the assignment to val first; otherwise you
199 can trip up the error_check_*() stuff */
200 # define XSETOBJ(var, vartype, value) \
201 do { \
202 Lisp_Object *tmp_xset_var = &(var); \
203 (*tmp_xset_var).s.val = ((EMACS_INT) (value)); \
204 (*tmp_xset_var).gu.markbit = 0; \
205 (*tmp_xset_var).gu.type = (vartype); \
206 } while (0)
207 # endif /* ! XMAKE_LISP */
208 #endif /* ! USE_MINIMAL_TAGBITS */
209
210 #if GCMARKBITS > 0
211 /*
212 * XMARKBIT access the markbit. Markbits are used only in particular
213 * slots of particular structure types. Other markbits are always
214 * zero. Outside of garbage collection, all mark bits are always
215 * zero.
216 */
217 # define XMARKBIT(a) ((a).gu.markbit)
218 # define XMARK(a) ((void) (XMARKBIT (a) = 1))
219 # define XUNMARK(a) ((void) (XMARKBIT (a) = 0))
220 #else
221 # define XUNMARK(a) DO_NOTHING
222 #endif
223
224 /* Use this for turning a (void *) into a Lisp_Object, as when the
225 Lisp_Object is passed into a toolkit callback function */
226 #define VOID_TO_LISP(larg,varg) \ 165 #define VOID_TO_LISP(larg,varg) \
227 ((void) ((larg).v = (struct __nosuchstruct__ *) (varg))) 166 ((void) ((larg).v = (struct nosuchstruct *) (varg)))
228 #define CVOID_TO_LISP(larg,varg) \ 167 #define CVOID_TO_LISP(larg,varg) \
229 ((void) ((larg).cv = (CONST struct __nosuchstruct__ *) (varg))) 168 ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg)))
230
231 /* Use this for turning a Lisp_Object into a (void *), as when the
232 Lisp_Object is passed into a toolkit callback function */
233 #define LISP_TO_VOID(larg) ((void *) ((larg).v)) 169 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
234 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv)) 170 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
235 171
236 /* Convert a Lisp_Object into something that can't be used as an 172 /* Convert a Lisp_Object into something that can't be used as an
237 lvalue. Useful for type-checking. */ 173 lvalue. Useful for type-checking. */