Mercurial > hg > xemacs-beta

comparison src/lisp-disunion.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 eb5470882647
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
23 /* If union type is not wanted, define Lisp_Object as just a number 23 /* If union type is not wanted, define Lisp_Object as just a number
24 and define the macros below to extract fields by shifting */ 24 and define the macros below to extract fields by shifting */
25 25
26 #define Qzero 0 26 #define Qzero 0
27 27
28 /* #define Lisp_Object int */
29 typedef EMACS_INT Lisp_Object; 28 typedef EMACS_INT Lisp_Object;
30 29
31 #ifndef VALMASK 30 #define VALMASK ((1L << (VALBITS)) - 1L)
32 # define VALMASK ((1L << (VALBITS)) - 1L)
33 #endif
34 #define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L) 31 #define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L)
35 32
36 /* comment from FSFmacs (perhaps not accurate here): 33 /* comment from FSFmacs (perhaps not accurate here):
37 34
38 This is set in the car of a cons and in the plist slot of a symbol 35 This is set in the car of a cons and in the plist slot of a symbol
46 43
47 #define MARKBIT (1UL << ((VALBITS) + (GCTYPEBITS))) 44 #define MARKBIT (1UL << ((VALBITS) + (GCTYPEBITS)))
48 45
49 46
50 /* These macros extract various sorts of values from a Lisp_Object. 47 /* These macros extract various sorts of values from a Lisp_Object.
51 For example, if tem is a Lisp_Object whose type is Lisp_Cons, 48 For example, if tem is a Lisp_Object whose type is Lisp_Type_Cons,
52 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ 49 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
53 50
54 /* One need to override this if there must be high bits set in data space 51 /* One needs to override this if there must be high bits set in data space
55 (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work 52 (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work
56 on all machines, but would penalise machines which don't need it) 53 on all machines, but would penalize machines which don't need it) */
57 */ 54 #define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS))
58 #ifndef XTYPE
59 # define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS))
60 #endif
61
62 #ifndef XSETTYPE
63 # define XSETTYPE(a,b) ((a) = XUINT (a) | ((EMACS_INT)(b) << VALBITS))
64 #endif
65 55
66 #define EQ(x,y) ((x) == (y)) 56 #define EQ(x,y) ((x) == (y))
67 #define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y)) 57 #define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y))
68
69 #if 0
70 /* XFASTINT is error-prone and saves a few instructions at best,
71 so there's really no point to it. Just use XINT() or make_int()
72 instead. --ben */
73 /* Use XFASTINT for fast retrieval and storage of integers known
74 to be positive. This takes advantage of the fact that Lisp_Int is 0. */
75 #define XFASTINT(a) (a)
76 #endif /* 0 */
77 58
78 /* Extract the value of a Lisp_Object as a signed integer. */ 59 /* Extract the value of a Lisp_Object as a signed integer. */
79 60
80 #ifndef XREALINT /* Some machines need to do this differently. */ 61 #ifndef XREALINT /* Some machines need to do this differently. */
81 # define XREALINT(a) (((a) << (LONGBITS-VALBITS)) >> (LONGBITS-VALBITS)) 62 # define XREALINT(a) (((a) << (LONGBITS-VALBITS)) >> (LONGBITS-VALBITS))
82 #endif 63 #endif
83 64
84 /* Extract the value as an unsigned integer. This is a basis 65 /* Extract the value as an unsigned integer. This is a basis
85 for extracting it as a pointer to a structure in storage. */ 66 for extracting it as a pointer to a structure in storage. */
86 67
87 #ifndef XUINT 68 #define XUINT(a) ((a) & VALMASK)
88 # define XUINT(a) ((a) & VALMASK)
89 #endif
90 69
91 #ifndef XPNTR 70 #ifdef HAVE_SHM
92 # ifdef HAVE_SHM
93 /* In this representation, data is found in two widely separated segments. */ 71 /* In this representation, data is found in two widely separated segments. */
94 extern int pure_size; 72 extern int pure_size;
95 # define XPNTR(a) \ 73 # define XPNTR(a) \
96 (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)) 74 (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
97 # else /* not HAVE_SHM */ 75 # else /* not HAVE_SHM */
98 # ifdef DATA_SEG_BITS 76 # ifdef DATA_SEG_BITS
99 /* This case is used for the rt-pc. 77 /* This case is used for the rt-pc.
100 In the diffs I was given, it checked for ptr = 0 78 In the diffs I was given, it checked for ptr = 0
101 and did not adjust it in that case. 79 and did not adjust it in that case.
102 But I don't think that zero should ever be found 80 But I don't think that zero should ever be found
103 in a Lisp object whose data type says it points to something. 81 in a Lisp object whose data type says it points to something. */
104 */
105 # define XPNTR(a) (XUINT (a) | DATA_SEG_BITS) 82 # define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
106 # else 83 # else
107 # define XPNTR(a) XUINT (a) 84 # define XPNTR(a) XUINT (a)
108 # endif 85 # endif
109 # endif /* not HAVE_SHM */ 86 #endif /* not HAVE_SHM */
110 #endif /* no XPNTR */
111 87
112 #ifndef XSETINT 88 #define XSETINT(a, b) XSETOBJ (a, Lisp_Type_Int, b)
113 # if 1 /* Back in the dark ages, this def "broke things" */
114 # define XSETINT(a, b) do { XSETOBJ (a, Lisp_Int, b); } while (0)
115 # else /* alternate def to work around some putative bug with the above */
116 # define XSETINT(a, b) do { (a) = (((a) & ~VALMASK) | ((b) & VALMASK)); \
117 } while (0)
118 # endif
119 #endif /* !XSETINT */
120 89
121 #ifndef XSETUINT 90 #define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
122 #define XSETUINT(a, b) XSETINT (a, b)
123 #endif
124
125 #ifndef XSETPNTR
126 #define XSETPNTR(a, b) XSETINT (a, b)
127 #endif
128
129 /* characters do not need to sign extend so there's no need for special
130 futzing like with ints. */
131 #define XSETCHAR(a, b) do { XSETOBJ (a, Lisp_Char, b); } while (0)
132 91
133 /* XSETOBJ was formerly named XSET. The name change was made to catch 92 /* XSETOBJ was formerly named XSET. The name change was made to catch
134 C code that attempts to use this macro. You should always use the 93 C code that attempts to use this macro. You should always use the
135 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ 94 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
136 95
137 #ifndef XSETOBJ 96 #define XSETOBJ(var, type_tag, value) \
138 # define XSETOBJ(var,type,ptr) \ 97 ((void) ((var) = (((EMACS_INT) (type_tag) << VALBITS) \
139 do { (var) = (((EMACS_INT) (type) << VALBITS) \ 98 + ((EMACS_INT) (value) & VALMASK))))
140 + ((EMACS_INT) (ptr) & VALMASK)); \
141 } while(0)
142 #endif
143 99
144 /* During garbage collection, XGCTYPE must be used for extracting types 100 /* During garbage collection, XGCTYPE must be used for extracting types
145 so that the mark bit is ignored. XMARKBIT accesses the markbit. 101 so that the mark bit is ignored. XMARKBIT accesses the markbit.
146 Markbits are used only in particular slots of particular structure types. 102 Markbits are used only in particular slots of particular structure types.
147 Other markbits are always zero. 103 Other markbits are always zero.
148 Outside of garbage collection, all mark bits are always zero. */ 104 Outside of garbage collection, all mark bits are always zero. */
149 105
150 #ifndef XGCTYPE 106 #ifndef XGCTYPE
151 # define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK)) 107 # define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK))
152 #endif 108 #endif
153 109
154 #if ((VALBITS) + (GCTYPEBITS)) == ((LONGBITS) - 1L) 110 #if ((VALBITS) + (GCTYPEBITS)) == ((LONGBITS) - 1L)
155 /* Make XMARKBIT faster if mark bit is sign bit. */ 111 /* Make XMARKBIT faster if mark bit is sign bit. */
156 # ifndef XMARKBIT 112 # define XMARKBIT(a) ((a) < 0L)
157 # define XMARKBIT(a) ((a) < 0L) 113 #else
158 # endif 114 # define XMARKBIT(a) ((a) & (MARKBIT))
159 #endif /* markbit is sign bit */ 115 #endif /* markbit is sign bit */
160 116
161 #ifndef XMARKBIT 117 # define XMARK(a) ((void) ((a) |= (MARKBIT)))
162 # define XMARKBIT(a) ((a) & (MARKBIT)) 118 # define XUNMARK(a) ((void) ((a) &= (~(MARKBIT))))
163 #endif
164
165 #ifndef XSETMARKBIT
166 #define XSETMARKBIT(a,b) \
167 do { ((a) = ((a) & ~(MARKBIT)) | ((b) ? (MARKBIT) : 0)); } while (0)
168 #endif
169
170 #ifndef XMARK
171 # define XMARK(a) do { ((a) |= (MARKBIT)); } while (0)
172 #endif
173
174 #ifndef XUNMARK
175 /* no 'do {} while' because this is used in a mondo macro in lrecord.h */
176 # define XUNMARK(a) ((a) &= (~(MARKBIT)))
177 #endif
178 119
179 /* Use this for turning a (void *) into a Lisp_Object, as when the 120 /* Use this for turning a (void *) into a Lisp_Object, as when the
180 Lisp_Object is passed into a toolkit callback function */ 121 Lisp_Object is passed into a toolkit callback function */
181 #define VOID_TO_LISP(larg,varg) \ 122 #define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg))))
182 do { ((larg) = ((Lisp_Object) (varg))); } while (0)
183 #define CVOID_TO_LISP VOID_TO_LISP 123 #define CVOID_TO_LISP VOID_TO_LISP
184 124
185 /* Use this for turning a Lisp_Object into a (void *), as when the 125 /* Use this for turning a Lisp_Object into a (void *), as when the
186 Lisp_Object is passed into a toolkit callback function */ 126 Lisp_Object is passed into a toolkit callback function */
187 #define LISP_TO_VOID(larg) ((void *) (larg)) 127 #define LISP_TO_VOID(larg) ((void *) (larg))
188 #define LISP_TO_CVOID(varg) ((CONST void *) (larg)) 128 #define LISP_TO_CVOID(varg) ((CONST void *) (larg))
189 129
190 /* Convert a Lisp_Object into something that can't be used as an 130 /* Convert a Lisp_Object into something that can't be used as an