Mercurial > hg > xemacs-beta

comparison src/lisp-union.h @ 207:e45d5e7c476e r20-4b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b2
author cvs
date Mon, 13 Aug 2007 10:03:52 +0200
parents 3d6bfa290dbd
children 78f53ef88e17
comparison
equal deleted inserted replaced
206:d3e9274cbc4e 207:e45d5e7c476e
26 { 26 {
27 struct 27 struct
28 { 28 {
29 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) 29 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
30 /* Big-endian lowtags, little-endian hightags */ 30 /* Big-endian lowtags, little-endian hightags */
31 unsigned EMACS_INT type_mark: GCTYPEBITS + 1; 31 unsigned EMACS_INT type_mark: GCTYPEBITS + GCMARKBITS;
32 signed EMACS_INT val: VALBITS; 32 signed EMACS_INT val: VALBITS;
33 #else /* If WORDS_BIGENDIAN, or little-endian hightags */ 33 #else /* If WORDS_BIGENDIAN, or little-endian hightags */
34 signed EMACS_INT val: VALBITS; 34 signed EMACS_INT val: VALBITS;
35 unsigned EMACS_INT mark_type: GCTYPEBITS + 1; 35 unsigned EMACS_INT mark_type: GCTYPEBITS + GCMARKBITS;
36 #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */ 36 #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
37 } s; 37 } s;
38 struct 38 struct
39 { 39 {
40 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS)) 40 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
45 #else 45 #else
46 unsigned EMACS_INT type: GCTYPEBITS; 46 unsigned EMACS_INT type: GCTYPEBITS;
47 #endif /* __GNUC__ */ 47 #endif /* __GNUC__ */
48 /* 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,
49 and is always zero except during garbage collection. */ 49 and is always zero except during garbage collection. */
50 unsigned EMACS_INT markbit: 1; 50 #if GCMARKBITS > 0
51 unsigned EMACS_INT markbit: GCMARKBITS;
52 #endif
51 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) 53 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
52 unsigned EMACS_INT val: VALBITS; 54 unsigned EMACS_INT val: VALBITS;
53 #endif 55 #endif
54 } gu; 56 } gu;
57 #ifdef USE_MINIMAL_TAGBITS
58 struct
59 {
60 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
61 unsigned bit: GCTYPEBITS - 1;
62 #endif
63 signed EMACS_INT val: VALBITS + 1;
64 #if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
65 unsigned bit: GCTYPEBITS - 1;
66 #endif
67 } si;
68 #endif /* USE_MINIMAL_TAGBITS */
69 EMACS_UINT ui;
55 EMACS_INT i; 70 EMACS_INT i;
56 /* GCC bites yet again. I fart in the general direction of 71 /* GCC bites yet again. I fart in the general direction of
57 the GCC authors. 72 the GCC authors.
58 73
59 This was formerly declared 'void *v' etc. but that causes 74 This was formerly declared 'void *v' etc. but that causes
62 struct __nosuchstruct__ *v; 77 struct __nosuchstruct__ *v;
63 CONST struct __nosuchstruct__ *cv; /* C wanks */ 78 CONST struct __nosuchstruct__ *cv; /* C wanks */
64 } 79 }
65 Lisp_Object; 80 Lisp_Object;
66 81
82 #ifndef USE_MINIMAL_TAGBITS
67 #ifndef XMAKE_LISP 83 #ifndef XMAKE_LISP
68 #if (__GNUC__ > 1) 84 #if (__GNUC__ > 1)
69 /* Use GCC's struct initializers feature */ 85 /* Use GCC's struct initializers feature */
70 #define XMAKE_LISP(vartype,value) \ 86 #define XMAKE_LISP(vartype,value) \
71 ((union Lisp_Object) { gu: { markbit: 0, \ 87 ((union Lisp_Object) { gu: { markbit: 0, \
72 type: (vartype), \ 88 type: (vartype), \
73 val: ((unsigned EMACS_INT) value) } }) 89 val: ((unsigned EMACS_INT) value) } })
74 #endif /* __GNUC__ */ 90 #endif /* __GNUC__ */
75 #endif /* !XMAKE_LISP */ 91 #endif /* !XMAKE_LISP */
76 92 #endif /* ! USE_MINIMAL_TAGBITS */
77 93
78 #ifdef XMAKE_LISP 94 #ifdef XMAKE_LISP
79 #define Qzero (XMAKE_LISP (Lisp_Type_Int, 0)) 95 #define Qzero (XMAKE_LISP (Lisp_Type_Int, 0))
80 #define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a))) 96 #define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a)))
97 #define make_char(a) (XMAKE_LISP (Lisp_Type_Char, (a)))
81 #else 98 #else
82 extern Lisp_Object Qzero; 99 extern Lisp_Object Qzero;
83 #endif 100 #endif
84 101
102 extern Lisp_Object Qnull_pointer;
85 103
86 #define EQ(x,y) ((x).v == (y).v) 104 #define EQ(x,y) ((x).v == (y).v)
87 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type) 105 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type)
88 106
89 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type) 107 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
94 this, so it stays commented out. */ 112 this, so it stays commented out. */
95 #if 0 /* EXPLICIT_SIGN_EXTEND */ 113 #if 0 /* EXPLICIT_SIGN_EXTEND */
96 /* Make sure we sign-extend; compilers have been known to fail to do so. */ 114 /* Make sure we sign-extend; compilers have been known to fail to do so. */
97 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS))) 115 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
98 #else 116 #else
99 #define XREALINT(a) ((a).s.val) 117 #ifdef USE_MINIMAL_TAGBITS
118 # define XREALINT(a) ((a).si.val)
119 #else
120 # define XREALINT(a) ((a).s.val)
121 #endif
100 #endif /* EXPLICIT_SIGN_EXTEND */ 122 #endif /* EXPLICIT_SIGN_EXTEND */
101 123
102 #define XUINT(a) ((a).gu.val) 124 #ifdef USE_MINIMAL_TAGBITS
125 # define XPNTRVAL(a) ((a).ui)
126 # define XCHARVAL(a) ((a).gu.val)
127 #else
128 # define XPNTRVAL(a) ((a).gu.val)
129 # define XCHARVAL(a) XPNTRVAL(a)
130 #endif
131
103 #ifdef HAVE_SHM 132 #ifdef HAVE_SHM
104 /* In this representation, data is found in two widely separated segments. */ 133 /* In this representation, data is found in two widely separated segments. */
105 extern int pure_size; 134 extern int pure_size;
106 # define XPNTR(a) \ 135 # define XPNTR(a) \
107 ((void *)(((a).gu.val) | ((a).gu.val > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))) 136 ((void *)(XPNTRVAL(a)) | (XPNTRVAL(a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)))
108 #else /* not HAVE_SHM */ 137 #else /* not HAVE_SHM */
109 # ifdef DATA_SEG_BITS 138 # ifdef DATA_SEG_BITS
110 /* This case is used for the rt-pc and hp-pa. 139 /* This case is used for the rt-pc and hp-pa.
111 In the diffs I was given, it checked for ptr = 0 140 In the diffs I was given, it checked for ptr = 0
112 and did not adjust it in that case. 141 and did not adjust it in that case.
113 But I don't think that zero should ever be found 142 But I don't think that zero should ever be found
114 in a Lisp object whose data type says it points to something. 143 in a Lisp object whose data type says it points to something.
115 */ 144 */
116 # define XPNTR(a) ((void *)(((a).gu.val) | DATA_SEG_BITS)) 145 # define XPNTR(a) ((void *)((XPNTRVAL(a)) | DATA_SEG_BITS))
117 # else /* not DATA_SEG_BITS */ 146 # else /* not DATA_SEG_BITS */
118 # define XPNTR(a) ((void *) ((a).gu.val)) 147 # define XPNTR(a) ((void *) (XPNTRVAL(a)))
119 # endif /* not DATA_SEG_BITS */ 148 # endif /* not DATA_SEG_BITS */
120 #endif /* not HAVE_SHM */ 149 #endif /* not HAVE_SHM */
121 #define XSETINT(a, b) ((void) ((a) = make_int (b))) 150
122 151 #ifdef USE_MINIMAL_TAGBITS
123 #define XSETCHAR(a, b) ((void) ((a) = make_char (b))) 152 # define XSETINT(a, b) \
153 do { Lisp_Object *_xzx = &(a) ; \
154 (*_xzx).si.val = (b) ; \
155 (*_xzx).si.bit = 1; \
156 } while (0)
157 # define XSETCHAR(a, b) \
158 do { Lisp_Object *_xzx = &(a) ; \
159 (*_xzx).gu.val = (b) ; \
160 (*_xzx).gu.type = Lisp_Type_Char; \
161 } while (0)
162 #else
163 # define XSETINT(a, b) ((void) ((a) = make_int (b)))
164 # define XSETCHAR(a, b) ((void) ((a) = make_char (b)))
165 #endif
124 166
125 /* XSETOBJ was formerly named XSET. The name change was made to catch 167 /* XSETOBJ was formerly named XSET. The name change was made to catch
126 C code that attempts to use this macro. You should always use the 168 C code that attempts to use this macro. You should always use the
127 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ 169 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
128 170
129 #ifdef XMAKE_LISP 171 #ifdef USE_MINIMAL_TAGBITS
130 #define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b))) 172 # define XSETOBJ(var, vartype, value) \
131 #else 173 ((void) ((var).ui = (EMACS_UINT)(value)))
174 #else
175 # ifdef XMAKE_LISP
176 # define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b)))
177 # else
132 /* This is haired up to avoid evaluating var twice... 178 /* This is haired up to avoid evaluating var twice...
133 This is necessary only in the "union" version. 179 This is necessary only in the "union" version.
134 The "int" version has never done double evaluation. 180 The "int" version has never done double evaluation.
135 */ 181 */
136 /* XEmacs change: put the assignment to val first; otherwise you 182 /* XEmacs change: put the assignment to val first; otherwise you
137 can trip up the error_check_*() stuff */ 183 can trip up the error_check_*() stuff */
138 #define XSETOBJ(var, vartype, value) \ 184 # define XSETOBJ(var, vartype, value) \
139 do { \ 185 do { \
140 Lisp_Object *tmp_xset_var = &(var); \ 186 Lisp_Object *tmp_xset_var = &(var); \
141 (*tmp_xset_var).s.val = ((EMACS_INT) (value)); \ 187 (*tmp_xset_var).s.val = ((EMACS_INT) (value)); \
142 (*tmp_xset_var).gu.markbit = 0; \ 188 (*tmp_xset_var).gu.markbit = 0; \
143 (*tmp_xset_var).gu.type = (vartype); \ 189 (*tmp_xset_var).gu.type = (vartype); \
144 } while (0) 190 } while (0)
145 #endif /* undefined XMAKE_LISP */ 191 # endif /* ! XMAKE_LISP */
146 192 #endif /* ! USE_MINIMAL_TAGBITS */
147 /* During garbage collection, XGCTYPE must be used for extracting types 193
148 so that the mark bit is ignored. XMARKBIT access the markbit. 194 #if GCMARKBITS > 0
149 Markbits are used only in particular slots of particular structure types. 195 /*
150 Other markbits are always zero. 196 * XMARKBIT access the markbit. Markbits are used only in particular
151 Outside of garbage collection, all mark bits are always zero. */ 197 * slots of particular structure types. Other markbits are always
152 198 * zero. Outside of garbage collection, all mark bits are always
153 #define XMARKBIT(a) ((a).gu.markbit) 199 * zero.
154 #define XMARK(a) ((void) (XMARKBIT (a) = 1)) 200 */
155 #define XUNMARK(a) ((void) (XMARKBIT (a) = 0)) 201 # define XMARKBIT(a) ((a).gu.markbit)
202 # define XMARK(a) ((void) (XMARKBIT (a) = 1))
203 # define XUNMARK(a) ((void) (XMARKBIT (a) = 0))
204 #endif
156 205
157 /* Use this for turning a (void *) into a Lisp_Object, as when the 206 /* Use this for turning a (void *) into a Lisp_Object, as when the
158 Lisp_Object is passed into a toolkit callback function */ 207 Lisp_Object is passed into a toolkit callback function */
159 #define VOID_TO_LISP(larg,varg) \ 208 #define VOID_TO_LISP(larg,varg) \
160 ((void) ((larg).v = (struct __nosuchstruct__ *) (varg))) 209 ((void) ((larg).v = (struct __nosuchstruct__ *) (varg)))