Mercurial > hg > xemacs-beta

comparison src/lisp-union.h @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents 376386a54a3c
children e45d5e7c476e
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
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 /* Synched up with: FSF 19.30. Split out from lisp.h. */
23 23
24 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
25
26 /* Big-endian lowtags, little-endian hightags */
27 typedef 24 typedef
28 union Lisp_Object 25 union Lisp_Object
26 {
27 struct
29 { 28 {
30 struct 29 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
31 { 30 /* Big-endian lowtags, little-endian hightags */
32 unsigned EMACS_INT type_mark: GCTYPEBITS + 1; 31 unsigned EMACS_INT type_mark: GCTYPEBITS + 1;
33 signed EMACS_INT val: VALBITS; 32 signed EMACS_INT val: VALBITS;
34 } s; 33 #else /* If WORDS_BIGENDIAN, or little-endian hightags */
35 struct 34 signed EMACS_INT val: VALBITS;
36 { 35 unsigned EMACS_INT mark_type: GCTYPEBITS + 1;
36 #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
37 } s;
38 struct
39 {
40 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
41 unsigned EMACS_INT val: VALBITS;
42 #endif
37 #ifdef __GNUC__ /* Non-ANSI extension */ 43 #ifdef __GNUC__ /* Non-ANSI extension */
38 enum Lisp_Type type: GCTYPEBITS; 44 enum Lisp_Type type: GCTYPEBITS;
39 #else 45 #else
40 unsigned EMACS_INT type: GCTYPEBITS; 46 unsigned EMACS_INT type: GCTYPEBITS;
41 #endif /* __GNUC__ */ 47 #endif /* __GNUC__ */
42 /* The markbit is not really part of the value of a Lisp_Object, 48 /* The markbit is not really part of the value of a Lisp_Object,
43 and is always zero except during garbage collection. */ 49 and is always zero except during garbage collection. */
44 unsigned EMACS_INT markbit: 1; 50 unsigned EMACS_INT markbit: 1;
45 unsigned EMACS_INT val: VALBITS; 51 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
46 } gu; 52 unsigned EMACS_INT val: VALBITS;
47 EMACS_INT i; 53 #endif
48 /* GCC bites yet again. I fart in the general direction of 54 } gu;
49 the GCC authors. 55 EMACS_INT i;
56 /* GCC bites yet again. I fart in the general direction of
57 the GCC authors.
50 58
51 This was formerly declared 'void *v' etc. but that causes 59 This was formerly declared 'void *v' etc. but that causes
52 GCC to accept any (yes, any) pointer as the argument of 60 GCC to accept any (yes, any) pointer as the argument of
53 a function declared to accept a Lisp_Object. */ 61 a function declared to accept a Lisp_Object. */
54 struct __nosuchstruct__ *v; 62 struct __nosuchstruct__ *v;
55 CONST struct __nosuchstruct__ *cv; /* C wanks */ 63 CONST struct __nosuchstruct__ *cv; /* C wanks */
56 } 64 }
57 Lisp_Object; 65 Lisp_Object;
58
59 #else /* If WORDS_BIGENDIAN, or little-endian hightags */
60
61 /* Big-endian hightags, little-endian lowtags */
62 typedef
63 union Lisp_Object
64 {
65 struct
66 {
67 signed EMACS_INT val: VALBITS;
68 unsigned EMACS_INT mark_type: GCTYPEBITS + 1;
69 } s;
70 struct
71 {
72 unsigned EMACS_INT val: VALBITS;
73 #ifdef __GNUC__ /* Non-ANSI extension */
74 enum Lisp_Type type: GCTYPEBITS;
75 #else
76 unsigned EMACS_INT type: GCTYPEBITS;
77 #endif /* __GNUC__ */
78 /* The markbit is not really part of the value of a Lisp_Object,
79 and is always zero except during garbage collection. */
80 unsigned EMACS_INT markbit: 1;
81 } gu;
82 EMACS_INT i;
83 struct __nosuchstruct__ *v;
84 CONST struct __nosuchstruct__ *cv; /* C sucks */
85 }
86 Lisp_Object;
87
88 #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
89
90 66
91 #ifndef XMAKE_LISP 67 #ifndef XMAKE_LISP
92 #if (__GNUC__ > 1) 68 #if (__GNUC__ > 1)
93 /* Use GCC's struct initializers feature */ 69 /* Use GCC's struct initializers feature */
94 #define XMAKE_LISP(vartype,ptr) \ 70 #define XMAKE_LISP(vartype,value) \
95 ((union Lisp_Object) { gu: { markbit: 0, \ 71 ((union Lisp_Object) { gu: { markbit: 0, \
96 type: (vartype), \ 72 type: (vartype), \
97 val: ((unsigned EMACS_INT) ptr) } }) 73 val: ((unsigned EMACS_INT) value) } })
98 #endif /* __GNUC__ */ 74 #endif /* __GNUC__ */
99 #endif /* !XMAKE_LISP */ 75 #endif /* !XMAKE_LISP */
100 76
101 77
102 #ifdef XMAKE_LISP 78 #ifdef XMAKE_LISP
103 #define Qzero (XMAKE_LISP (Lisp_Int, 0)) 79 #define Qzero (XMAKE_LISP (Lisp_Type_Int, 0))
104 #define make_int(a) (XMAKE_LISP (Lisp_Int, (a))) 80 #define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a)))
105 #else 81 #else
106 extern Lisp_Object Qzero; 82 extern Lisp_Object Qzero;
107 #endif 83 #endif
108 84
109 85
110 #define EQ(x,y) ((x).v == (y).v) 86 #define EQ(x,y) ((x).v == (y).v)
111 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type) 87 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type)
112 88
113 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type) 89 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
114 #define XSETTYPE(a,b) ((a).gu.type = (b))
115 #define XGCTYPE(a) XTYPE (a) 90 #define XGCTYPE(a) XTYPE (a)
116 91
117 /* This was commented out a long time ago. I uncommented it, but it 92 /* This was commented out a long time ago. I uncommented it, but it
118 makes the Alpha crash, and that's the only system that would use 93 makes the Alpha crash, and that's the only system that would use
119 this, so it stays commented out. */ 94 this, so it stays commented out. */
121 /* Make sure we sign-extend; compilers have been known to fail to do so. */ 96 /* Make sure we sign-extend; compilers have been known to fail to do so. */
122 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS))) 97 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
123 #else 98 #else
124 #define XREALINT(a) ((a).s.val) 99 #define XREALINT(a) ((a).s.val)
125 #endif /* EXPLICIT_SIGN_EXTEND */ 100 #endif /* EXPLICIT_SIGN_EXTEND */
126
127 #if 0
128 /* XFASTINT is error-prone and saves a few instructions at best,
129 so there's really no point to it. Just use XINT() or make_int()
130 instead. --ben */
131 /* The + 0 is to prevent XFASTINT being used on the LHS of an assignment */
132 #define XFASTINT(a) ((a).gu.val + 0)
133 #endif /* 0 */
134 101
135 #define XUINT(a) ((a).gu.val) 102 #define XUINT(a) ((a).gu.val)
136 #ifdef HAVE_SHM 103 #ifdef HAVE_SHM
137 /* In this representation, data is found in two widely separated segments. */ 104 /* In this representation, data is found in two widely separated segments. */
138 extern int pure_size; 105 extern int pure_size;
148 */ 115 */
149 # define XPNTR(a) ((void *)(((a).gu.val) | DATA_SEG_BITS)) 116 # define XPNTR(a) ((void *)(((a).gu.val) | DATA_SEG_BITS))
150 # else /* not DATA_SEG_BITS */ 117 # else /* not DATA_SEG_BITS */
151 # define XPNTR(a) ((void *) ((a).gu.val)) 118 # define XPNTR(a) ((void *) ((a).gu.val))
152 # endif /* not DATA_SEG_BITS */ 119 # endif /* not DATA_SEG_BITS */
153 #endif /* not HAVE_SHM */ 120 #endif /* not HAVE_SHM */
154 #define XSETINT(a, b) do { ((a) = make_int (b)); } while (0) 121 #define XSETINT(a, b) ((void) ((a) = make_int (b)))
155 #define XSETUINT(a, b) XSETINT (a, b)
156 #define XSETPNTR(a, b) XSETINT (a, b)
157 122
158 #define XSETCHAR(a, b) do { ((a) = make_char (b)); } while (0) 123 #define XSETCHAR(a, b) ((void) ((a) = make_char (b)))
159 124
160 /* XSETOBJ was formerly named XSET. The name change was made to catch 125 /* XSETOBJ was formerly named XSET. The name change was made to catch
161 C code that attempts to use this macro. You should always use the 126 C code that attempts to use this macro. You should always use the
162 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ 127 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
163 128
164 #ifdef XMAKE_LISP 129 #ifdef XMAKE_LISP
165 #define XSETOBJ(var,vartype,ptr) \ 130 #define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b)))
166 do { ((var) = XMAKE_LISP (vartype, ptr)); } while (0)
167 #else 131 #else
168 /* This is haired up to avoid evaluating var twice... 132 /* This is haired up to avoid evaluating var twice...
169 This is necessary only in the "union" version. 133 This is necessary only in the "union" version.
170 The "int" version has never done double evaluation. 134 The "int" version has never done double evaluation.
171 */ 135 */
172 /* XEmacs change: put the assignment to val first; otherwise you 136 /* XEmacs change: put the assignment to val first; otherwise you
173 can trip up the error_check_*() stuff */ 137 can trip up the error_check_*() stuff */
174 #define XSETOBJ(var, vartype, ptr) \ 138 #define XSETOBJ(var, vartype, value) \
175 do { \ 139 do { \
176 Lisp_Object *tmp_xset_var = &(var); \ 140 Lisp_Object *tmp_xset_var = &(var); \
177 (*tmp_xset_var).s.val = ((EMACS_INT) (ptr)); \ 141 (*tmp_xset_var).s.val = ((EMACS_INT) (value)); \
178 (*tmp_xset_var).gu.markbit = 0; \ 142 (*tmp_xset_var).gu.markbit = 0; \
179 (*tmp_xset_var).gu.type = (vartype); \ 143 (*tmp_xset_var).gu.type = (vartype); \
180 } while (0) 144 } while (0)
181 #endif /* undefined XMAKE_LISP */ 145 #endif /* undefined XMAKE_LISP */
182 146
183 /* During garbage collection, XGCTYPE must be used for extracting types 147 /* During garbage collection, XGCTYPE must be used for extracting types
184 so that the mark bit is ignored. XMARKBIT access the markbit. 148 so that the mark bit is ignored. XMARKBIT access the markbit.
185 Markbits are used only in particular slots of particular structure types. 149 Markbits are used only in particular slots of particular structure types.
186 Other markbits are always zero. 150 Other markbits are always zero.
187 Outside of garbage collection, all mark bits are always zero. */ 151 Outside of garbage collection, all mark bits are always zero. */
188
189 152
190 #define XMARKBIT(a) ((a).gu.markbit) 153 #define XMARKBIT(a) ((a).gu.markbit)
191 #define XSETMARKBIT(a,b) do { (XMARKBIT (a) = (b)); } while (0) 154 #define XMARK(a) ((void) (XMARKBIT (a) = 1))
192 #define XMARK(a) do { XMARKBIT (a) = 1; } while (0) 155 #define XUNMARK(a) ((void) (XMARKBIT (a) = 0))
193 /* no 'do {} while' because this is used in a mondo macro in lrecord.h */
194 #define XUNMARK(a) (XMARKBIT (a) = 0)
195 156
196 /* Use this for turning a (void *) into a Lisp_Object, as when the 157 /* Use this for turning a (void *) into a Lisp_Object, as when the
197 Lisp_Object is passed into a toolkit callback function */ 158 Lisp_Object is passed into a toolkit callback function */
198 #define VOID_TO_LISP(larg,varg) \ 159 #define VOID_TO_LISP(larg,varg) \
199 do { ((larg).v = (struct __nosuchstruct__ *) (varg)); } while (0) 160 ((void) ((larg).v = (struct __nosuchstruct__ *) (varg)))
200 #define CVOID_TO_LISP(larg,varg) \ 161 #define CVOID_TO_LISP(larg,varg) \
201 do { ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)); } while (0) 162 ((void) ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)))
202 163
203 /* Use this for turning a Lisp_Object into a (void *), as when the 164 /* Use this for turning a Lisp_Object into a (void *), as when the
204 Lisp_Object is passed into a toolkit callback function */ 165 Lisp_Object is passed into a toolkit callback function */
205 #define LISP_TO_VOID(larg) ((void *) ((larg).v)) 166 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
206 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv)) 167 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
213 /* Well, you can't really do it without using a function call, and 174 /* Well, you can't really do it without using a function call, and
214 there's no real point in that; no-union-type is the rule, and that 175 there's no real point in that; no-union-type is the rule, and that
215 will catch errors. */ 176 will catch errors. */
216 #define NON_LVALUE(larg) (larg) 177 #define NON_LVALUE(larg) (larg)
217 #endif 178 #endif
218