Mercurial > hg > xemacs-beta

comparison src/lisp-disunion.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 eb5470882647
children 78f53ef88e17
comparison
equal deleted inserted replaced
206:d3e9274cbc4e 207:e45d5e7c476e
17 along with XEmacs; see the file COPYING. If not, write to 17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 19 Boston, MA 02111-1307, USA. */
20 20
21 /* Synched up with: FSF 19.30. Split out from lisp.h. */ 21 /* Synched up with: FSF 19.30. Split out from lisp.h. */
22 22 /* This file has diverged greatly from FSF Emacs. Syncing is no
23 /* If union type is not wanted, define Lisp_Object as just a number 23 longer desired or possible */
24 and define the macros below to extract fields by shifting */ 24
25 25 /*
26 #define Qzero 0 26 * Format of a non-union-type Lisp Object
27 *
28 * For the USE_MINIMAL_TAGBITS implementation:
29 *
30 * 3 2 1 0
31 * bit 10987654321098765432109876543210
32 * --------------------------------
33 * VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVTT
34 *
35 * For the non-USE_MINIMAL_TAGBITS implementation:
36 *
37 * 3 2 1 0
38 * bit 10987654321098765432109876543210
39 * --------------------------------
40 * TTTMVVVVVVVVVVVVVVVVVVVVVVVVVVVV
41 *
42 * V = value bits
43 * T = type bits
44 * M = mark bits
45 *
46 * For integral Lisp types, i.e. integers and characters, the value
47 * bits are the Lisp object.
48 *
49 * The object is obtained by masking off the type and mark
50 * bits. In the USE_MINIMAL_TAGBITS implementation, bit 1 is
51 * used as a value bit by splitting the Lisp integer type into
52 * two subtypes, Lisp_Type_Int_Even and Lisp_Type_Int_Odd. By
53 * this trickery we get 31 bits for integers instead of 30.
54 *
55 * In the non-USE_MINIMAL_TAGBITS world, Lisp integers are 28
56 * bits, or more properly (LONGBITS - GCTYPEBITS - 1) bits.
57 *
58 * For non-integral types, the value bits of Lisp_Object contain a
59 * pointer to structure containing the object. The pointer is
60 * obtained by masking off the type and mark bits.
61 *
62 * In the USE_MINIMAL_TAGBITS implementation, all
63 * pointer-based types are coalesced under a single type called
64 * Lisp_Type_Record. The type bits for this type are required
65 * by the implementation to be 00, just like the least
66 * significant bits of word-aligned struct pointers on 32-bit
67 * hardware. Because of this, Lisp_Object pointers don't have
68 * to be masked and are full-sized.
69 *
70 * In the non-USE_MINIMAL_TAGBITS implementation, the type and
71 * mark bits must be masked off and pointers are limited to 28
72 * bits (really LONGBITS - GCTYPEBITS - 1 bits).
73 */
74
75 #ifdef USE_MINIMAL_TAGBITS
76 # define Qzero Lisp_Type_Int_Even
77 # define VALMASK (((1L << (VALBITS)) - 1L) << (GCTYPEBITS))
78 #else
79 # define Qzero Lisp_Type_Int
80 # define VALMASK ((1L << (VALBITS)) - 1L)
81 # define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L)
82 #endif
27 83
28 typedef EMACS_INT Lisp_Object; 84 typedef EMACS_INT Lisp_Object;
29 85
30 #define VALMASK ((1L << (VALBITS)) - 1L) 86 #define Qnull_pointer 0
31 #define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L) 87
32 88 /*
33 /* comment from FSFmacs (perhaps not accurate here): 89 * There are no mark bits in the USE_MINIMAL_TAGBITS implementation.
34 90 * Integers and characters don't need to be marked. All other types
35 This is set in the car of a cons and in the plist slot of a symbol 91 * are lrecord-based, which means they get marked by incrementing
36 to indicate it is marked. Likewise in the plist slot of an interval, 92 * their ->implementation pointer.
37 the chain slot of a marker, the type slot of a float, and the name 93 */
38 slot of a buffer. 94 #if GCMARKBITS > 0
39 95 /*
40 In strings, this bit in the size field indicates that the string 96 * XMARKBIT accesses the markbit. Markbits are used only in particular
41 is a "large" one, one which was separately malloc'd 97 * slots of particular structure types. Other markbits are always
42 rather than being part of a string block. */ 98 * zero. Outside of garbage collection, all mark bits are always zero.
43 99 */
44 #define MARKBIT (1UL << (VALBITS)) 100 # define MARKBIT (1UL << (VALBITS))
45 101 # define XMARKBIT(a) ((a) & (MARKBIT))
46 102
47 /* These macros extract various sorts of values from a Lisp_Object. 103 # define XMARK(a) ((void) ((a) |= (MARKBIT)))
48 For example, if tem is a Lisp_Object whose type is Lisp_Type_Cons, 104 # define XUNMARK(a) ((void) ((a) &= (~(MARKBIT))))
49 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ 105 #endif
50 106
51 /* One needs to override this if there must be high bits set in data space 107 /*
52 (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work 108 * Extract the type bits from a Lisp_Object. If using USE_MINIMAL_TAGBITS,
53 on all machines, but would penalize machines which don't need it) */ 109 * the least significant two bits are the type bits. Otherwise the
54 #define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT)(a)) >> ((VALBITS) + 1))) 110 * most significant GCTYPEBITS bits are the type bits.
111 *
112 * In the non-USE_MINIMAL_TAGBITS case, one needs to override this
113 * if there must be high bits set in data space. Masking the bits
114 * (doing the result of the below & ((1 << (GCTYPEBITS)) - 1) would
115 * work on all machines, but would penalize machines which don't
116 * need it)
117 */
118 #ifdef USE_MINIMAL_TAGBITS
119 # define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT)(a)) & ~(VALMASK)))
120 #else
121 # define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT)(a)) >> ((VALBITS) + 1)))
122 #endif
123
124 /*
125 * This applies only to the non-USE_MINIMAL_TAGBITS Lisp_Object.
126 *
127 * In the past, during garbage collection, XGCTYPE needed to be used
128 * for extracting types so that the mark bit was ignored. XGCTYPE
129 * did and exatr & operation to remove the mark bit. But the mark
130 * bit has been since moved so that the type bits could be extracted
131 * with a single shift operation, making XGCTYPE no more expensive
132 * than XTYPE, so the two operations are now equivalent.
133 */
134 #ifndef XGCTYPE
135 # define XGCTYPE(a) XTYPE(a)
136 #endif
55 137
56 #define EQ(x,y) ((x) == (y)) 138 #define EQ(x,y) ((x) == (y))
57 #define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y)) 139
58 140 #ifdef USE_MINIMAL_TAGBITS
59 /* Extract the value of a Lisp_Object as a signed integer. */ 141 # define GC_EQ(x,y) EQ(x,y)
60 142 #else
143 # define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y))
144 #endif
145
146 /*
147 * Extract the value of a Lisp_Object as a signed integer.
148 *
149 * The right shifts below are non-portable because >> is allowed to
150 * sign extend or not signed extend signed integers depending on the
151 * compiler implementors preference. But this right-shifting of
152 * signed ints has been here forever, so the apparently reality is
153 * that all compilers of any consequence do sign extension, which is
154 * what is needed here.
155 */
61 #ifndef XREALINT /* Some machines need to do this differently. */ 156 #ifndef XREALINT /* Some machines need to do this differently. */
62 # define XREALINT(a) (((a) << (LONGBITS-VALBITS)) >> (LONGBITS-VALBITS)) 157 # ifdef USE_MINIMAL_TAGBITS
63 #endif 158 # define XREALINT(a) ((a) >> (LONGBITS-VALBITS-1))
64 159 # else
65 /* Extract the value as an unsigned integer. This is a basis 160 # define XREALINT(a) (((a) << (LONGBITS-VALBITS)) >> (LONGBITS-VALBITS))
66 for extracting it as a pointer to a structure in storage. */ 161 # endif
67 162 #endif
68 #define XUINT(a) ((a) & VALMASK) 163
164 /*
165 * Extract the pointer value bits of a pointer based type.
166 */
167 #ifdef USE_MINIMAL_TAGBITS
168 # define XPNTRVAL(a) (a) /* This depends on Lisp_Type_Record == 0 */
169 # define XCHARVAL(a) ((a) >> (LONGBITS-VALBITS))
170 #else
171 # define XPNTRVAL(a) ((a) & VALMASK)
172 # define XCHARVAL(a) XPNTRVAL(a)
173 #endif
69 174
70 #ifdef HAVE_SHM 175 #ifdef HAVE_SHM
71 /* In this representation, data is found in two widely separated segments. */ 176 /* In this representation, data is found in two widely separated segments. */
72 extern int pure_size; 177 extern int pure_size;
73 # define XPNTR(a) \ 178 # define XPNTR(a) \
74 (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)) 179 (XPNTRVAL (a) | (XPNTRVAL (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
75 # else /* not HAVE_SHM */ 180 # else /* not HAVE_SHM */
76 # ifdef DATA_SEG_BITS 181 # ifdef DATA_SEG_BITS
77 /* This case is used for the rt-pc. 182 /* This case is used for the rt-pc.
78 In the diffs I was given, it checked for ptr = 0 183 In the diffs I was given, it checked for ptr = 0
79 and did not adjust it in that case. 184 and did not adjust it in that case.
80 But I don't think that zero should ever be found 185 But I don't think that zero should ever be found
81 in a Lisp object whose data type says it points to something. */ 186 in a Lisp object whose data type says it points to something. */
82 # define XPNTR(a) (XUINT (a) | DATA_SEG_BITS) 187 # define XPNTR(a) (XPNTRVAL (a) | DATA_SEG_BITS)
83 # else 188 # else
84 # define XPNTR(a) XUINT (a) 189 # define XPNTR(a) XPNTRVAL (a)
85 # endif 190 # endif
86 #endif /* not HAVE_SHM */ 191 #endif /* not HAVE_SHM */
87 192
88 #define XSETINT(a, b) XSETOBJ (a, Lisp_Type_Int, b) 193 #ifdef USE_MINIMAL_TAGBITS
89 194
90 #define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value) 195 /* XSETINT depends on Lisp_Type_Int_Even == 1 and Lisp_Type_Int_Odd == 3 */
91 196 # define XSETINT(var, value) \
92 /* XSETOBJ was formerly named XSET. The name change was made to catch 197 ((void) ((var) = ((value) << (LONGBITS-VALBITS-1)) + 1))
93 C code that attempts to use this macro. You should always use the 198 # define XSETCHAR(var, value) \
94 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ 199 ((void) ((var) = ((value) << (LONGBITS-VALBITS)) + Lisp_Type_Char))
95 200 # define XSETOBJ(var, type_tag, value) \
96 #define XSETOBJ(var, type_tag, value) \ 201 ((void) ((var) = ((EMACS_UINT) (value))))
97 ((void) ((var) = (((EMACS_INT) (type_tag) << ((VALBITS) + 1)) \ 202
98 + ((EMACS_INT) (value) & VALMASK)))) 203 #else
99 204
100 /* During garbage collection, XGCTYPE must be used for extracting types 205 # define XSETINT(a, b) XSETOBJ (a, Lisp_Type_Int, b)
101 so that the mark bit is ignored. XMARKBIT accesses the markbit. 206 # define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
102 Markbits are used only in particular slots of particular structure types. 207 # define XSETOBJ(var, type_tag, value) \
103 Other markbits are always zero. 208 ((void) ((var) = (((EMACS_UINT) (type_tag) << ((VALBITS) + 1)) \
104 Outside of garbage collection, all mark bits are always zero. */ 209 + ((EMACS_INT) (value) & VALMASK))))
105 210 #endif
106 #ifndef XGCTYPE
107 # define XGCTYPE(a) XTYPE(a)
108 #endif
109
110 # define XMARKBIT(a) ((a) & (MARKBIT))
111
112 # define XMARK(a) ((void) ((a) |= (MARKBIT)))
113 # define XUNMARK(a) ((void) ((a) &= (~(MARKBIT))))
114 211
115 /* Use this for turning a (void *) into a Lisp_Object, as when the 212 /* Use this for turning a (void *) into a Lisp_Object, as when the
116 Lisp_Object is passed into a toolkit callback function */ 213 Lisp_Object is passed into a toolkit callback function */
117 #define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg)))) 214 #define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg))))
118 #define CVOID_TO_LISP VOID_TO_LISP 215 #define CVOID_TO_LISP VOID_TO_LISP