Mercurial > hg > xemacs-beta

comparison src/lisp-disunion.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 -- non-union objects.
2 Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: FSF 19.30. Split out from lisp.h. */
22
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 */
25
26 #define Qzero 0
27
28 /* #define Lisp_Object int */
29 typedef EMACS_INT Lisp_Object;
30
31 #ifndef VALMASK
32 # define VALMASK ((1L << (VALBITS)) - 1L)
33 #endif
34 #define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L)
35
36 /* comment from FSFmacs (perhaps not accurate here):
37
38 This is set in the car of a cons and in the plist slot of a symbol
39 to indicate it is marked. Likewise in the plist slot of an interval,
40 the chain slot of a marker, the type slot of a float, and the name
41 slot of a buffer.
42
43 In strings, this bit in the size field indicates that the string
44 is a "large" one, one which was separately malloc'd
45 rather than being part of a string block. */
46
47 #define MARKBIT (1UL << ((VALBITS) + (GCTYPEBITS)))
48
49
50 /* 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,
52 XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
53
54 /* One need 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
56 on all machines, but would penalise machines which don't need it)
57 */
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
66 #define EQ(x,y) ((x) == (y))
67 #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
78 /* Extract the value of a Lisp_Object as a signed integer. */
79
80 #ifndef XREALINT /* Some machines need to do this differently. */
81 # define XREALINT(a) (((a) << (LONGBITS-VALBITS)) >> (LONGBITS-VALBITS))
82 #endif
83
84 /* Extract the value as an unsigned integer. This is a basis
85 for extracting it as a pointer to a structure in storage. */
86
87 #ifndef XUINT
88 # define XUINT(a) ((a) & VALMASK)
89 #endif
90
91 #ifndef XPNTR
92 # ifdef HAVE_SHM
93 /* In this representation, data is found in two widely separated segments. */
94 extern int pure_size;
95 # define XPNTR(a) \
96 (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
97 # else /* not HAVE_SHM */
98 # ifdef DATA_SEG_BITS
99 /* This case is used for the rt-pc.
100 In the diffs I was given, it checked for ptr = 0
101 and did not adjust it in that case.
102 But I don't think that zero should ever be found
103 in a Lisp object whose data type says it points to something.
104 */
105 # define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
106 # else
107 # define XPNTR(a) XUINT (a)
108 # endif
109 # endif /* not HAVE_SHM */
110 #endif /* no XPNTR */
111
112 #ifndef XSETINT
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
121 #ifndef XSETUINT
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
133 /* 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
135 individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
136
137 #ifndef XSETOBJ
138 # define XSETOBJ(var,type,ptr) \
139 do { (var) = (((EMACS_INT) (type) << VALBITS) \
140 + ((EMACS_INT) (ptr) & VALMASK)); \
141 } while(0)
142 #endif
143
144 /* During garbage collection, XGCTYPE must be used for extracting types
145 so that the mark bit is ignored. XMARKBIT accesses the markbit.
146 Markbits are used only in particular slots of particular structure types.
147 Other markbits are always zero.
148 Outside of garbage collection, all mark bits are always zero. */
149
150 #ifndef XGCTYPE
151 # define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK))
152 #endif
153
154 #if ((VALBITS) + (GCTYPEBITS)) == ((LONGBITS) - 1L)
155 /* Make XMARKBIT faster if mark bit is sign bit. */
156 # ifndef XMARKBIT
157 # define XMARKBIT(a) ((a) < 0L)
158 # endif
159 #endif /* markbit is sign bit */
160
161 #ifndef XMARKBIT
162 # define XMARKBIT(a) ((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
179 /* Use this for turning a (void *) into a Lisp_Object, as when the
180 Lisp_Object is passed into a toolkit callback function */
181 #define VOID_TO_LISP(larg,varg) \
182 do { ((larg) = ((Lisp_Object) (varg))); } while (0)
183 #define CVOID_TO_LISP VOID_TO_LISP
184
185 /* Use this for turning a Lisp_Object into a (void *), as when the
186 Lisp_Object is passed into a toolkit callback function */
187 #define LISP_TO_VOID(larg) ((void *) (larg))
188 #define LISP_TO_CVOID(varg) ((CONST void *) (larg))
189
190 /* Convert a Lisp_Object into something that can't be used as an
191 lvalue. Useful for type-checking. */
192 #define NON_LVALUE(larg) ((larg) + 0)