Mercurial > hg > xemacs-beta

comparison src/lisp-union.h @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 3d6bfa290dbd
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Fundamental definitions for XEmacs Lisp interpreter -- union objects.
2 Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
3 Free Software Foundation, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
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
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: FSF 19.30. Split out from lisp.h. */
23
24 #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
25
26 /* Big-endian lowtags, little-endian hightags */
27 typedef
28 union Lisp_Object
29 {
30 struct
31 {
32 unsigned EMACS_INT type_mark: GCTYPEBITS + 1;
33 signed EMACS_INT val: VALBITS;
34 } s;
35 struct
36 {
37 #ifdef __GNUC__ /* Non-ANSI extension */
38 enum Lisp_Type type: GCTYPEBITS;
39 #else
40 unsigned EMACS_INT type: GCTYPEBITS;
41 #endif /* __GNUC__ */
42 /* The markbit is not really part of the value of a Lisp_Object,
43 and is always zero except during garbage collection. */
44 unsigned EMACS_INT markbit: 1;
45 unsigned EMACS_INT val: VALBITS;
46 } gu;
47 EMACS_INT i;
48 /* GCC bites yet again. I fart in the general direction of
49 the GCC authors.
50
51 This was formerly declared 'void *v' etc. but that causes
52 GCC to accept any (yes, any) pointer as the argument of
53 a function declared to accept a Lisp_Object. */
54 struct __nosuchstruct__ *v;
55 CONST struct __nosuchstruct__ *cv; /* C wanks */
56 }
57 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
91 #ifndef XMAKE_LISP
92 #if (__GNUC__ > 1)
93 /* Use GCC's struct initializers feature */
94 #define XMAKE_LISP(vartype,ptr) \
95 ((union Lisp_Object) { gu: { markbit: 0, \
96 type: (vartype), \
97 val: ((unsigned EMACS_INT) ptr) } })
98 #endif /* __GNUC__ */
99 #endif /* !XMAKE_LISP */
100
101
102 #ifdef XMAKE_LISP
103 #define Qzero (XMAKE_LISP (Lisp_Int, 0))
104 #define make_int(a) (XMAKE_LISP (Lisp_Int, (a)))
105 #else
106 extern Lisp_Object Qzero;
107 #endif
108
109
110 #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)
112
113 #define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
114 #define XSETTYPE(a,b) ((a).gu.type = (b))
115 #define XGCTYPE(a) XTYPE (a)
116
117 /* 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
119 this, so it stays commented out. */
120 #if 0 /* EXPLICIT_SIGN_EXTEND */
121 /* Make sure we sign-extend; compilers have been known to fail to do so. */
122 #define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
123 #else
124 #define XREALINT(a) ((a).s.val)
125 #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
135 #define XUINT(a) ((a).gu.val)
136 #ifdef HAVE_SHM
137 /* In this representation, data is found in two widely separated segments. */
138 extern int pure_size;
139 # define XPNTR(a) \
140 ((void *)(((a).gu.val) | ((a).gu.val > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)))
141 #else /* not HAVE_SHM */
142 # ifdef DATA_SEG_BITS
143 /* This case is used for the rt-pc and hp-pa.
144 In the diffs I was given, it checked for ptr = 0
145 and did not adjust it in that case.
146 But I don't think that zero should ever be found
147 in a Lisp object whose data type says it points to something.
148 */
149 # define XPNTR(a) ((void *)(((a).gu.val) | DATA_SEG_BITS))
150 # else /* not DATA_SEG_BITS */
151 # define XPNTR(a) ((void *) ((a).gu.val))
152 # endif /* not DATA_SEG_BITS */
153 #endif /* not HAVE_SHM */
154 #define XSETINT(a, b) do { ((a) = make_int (b)); } while (0)
155 #define XSETUINT(a, b) XSETINT (a, b)
156 #define XSETPNTR(a, b) XSETINT (a, b)
157
158 #define XSETCHAR(a, b) do { ((a) = make_char (b)); } while (0)
159
160 /* 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
162 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
163
164 #ifdef XMAKE_LISP
165 #define XSETOBJ(var,vartype,ptr) \
166 do { ((var) = XMAKE_LISP (vartype, ptr)); } while (0)
167 #else
168 /* This is haired up to avoid evaluating var twice...
169 This is necessary only in the "union" version.
170 The "int" version has never done double evaluation.
171 */
172 /* XEmacs change: put the assignment to val first; otherwise you
173 can trip up the error_check_*() stuff */
174 #define XSETOBJ(var, vartype, ptr) \
175 do { \
176 Lisp_Object *tmp_xset_var = &(var); \
177 (*tmp_xset_var).s.val = ((EMACS_INT) (ptr)); \
178 (*tmp_xset_var).gu.markbit = 0; \
179 (*tmp_xset_var).gu.type = (vartype); \
180 } while (0)
181 #endif /* undefined XMAKE_LISP */
182
183 /* During garbage collection, XGCTYPE must be used for extracting types
184 so that the mark bit is ignored. XMARKBIT access the markbit.
185 Markbits are used only in particular slots of particular structure types.
186 Other markbits are always zero.
187 Outside of garbage collection, all mark bits are always zero. */
188
189
190 #define XMARKBIT(a) ((a).gu.markbit)
191 #define XSETMARKBIT(a,b) do { (XMARKBIT (a) = (b)); } while (0)
192 #define XMARK(a) do { XMARKBIT (a) = 1; } while (0)
193 /* no 'do {} while' because this is used in a mondo macro in lrecord.h */
194 #define XUNMARK(a) (XMARKBIT (a) = 0)
195
196 /* Use this for turning a (void *) into a Lisp_Object, as when the
197 Lisp_Object is passed into a toolkit callback function */
198 #define VOID_TO_LISP(larg,varg) \
199 do { ((larg).v = (struct __nosuchstruct__ *) (varg)); } while (0)
200 #define CVOID_TO_LISP(larg,varg) \
201 do { ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)); } while (0)
202
203 /* Use this for turning a Lisp_Object into a (void *), as when the
204 Lisp_Object is passed into a toolkit callback function */
205 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
206 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
207
208 /* Convert a Lisp_Object into something that can't be used as an
209 lvalue. Useful for type-checking. */
210 #if (__GNUC__ > 1)
211 #define NON_LVALUE(larg) ({ (larg); })
212 #else
213 /* 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
215 will catch errors. */
216 #define NON_LVALUE(larg) (larg)
217 #endif
218