Commit | Line | Data |
---|---|---|
c906108c SS |
1 | /* This is a minimally edited version of Guile's tags.h. */ |
2 | /* classes: h_files */ | |
3 | ||
4 | #ifndef TAGSH | |
5 | #define TAGSH | |
197e01b6 | 6 | /* Copyright (C) 1995, 1999 Free Software Foundation, Inc. |
c5aa993b | 7 | |
c906108c SS |
8 | * This program is free software; you can redistribute it and/or modify |
9 | * it under the terms of the GNU General Public License as published by | |
10 | * the Free Software Foundation; either version 2, or (at your option) | |
11 | * any later version. | |
12 | * | |
13 | * This program is distributed in the hope that it will be useful, | |
14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | * GNU General Public License for more details. | |
17 | * | |
18 | * You should have received a copy of the GNU General Public License | |
19 | * along with this program; if not, write to the Free Software | |
197e01b6 EZ |
20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 | * Boston, MA 02110-1301, USA. | |
c906108c SS |
22 | * |
23 | * As a special exception, the Free Software Foundation gives permission | |
24 | * for additional uses of the text contained in its release of GUILE. | |
25 | * | |
26 | * The exception is that, if you link the GUILE library with other files | |
27 | * to produce an executable, this does not by itself cause the | |
28 | * resulting executable to be covered by the GNU General Public License. | |
29 | * Your use of that executable is in no way restricted on account of | |
30 | * linking the GUILE library code into it. | |
31 | * | |
32 | * This exception does not however invalidate any other reasons why | |
33 | * the executable file might be covered by the GNU General Public License. | |
34 | * | |
35 | * This exception applies only to the code released by the | |
36 | * Free Software Foundation under the name GUILE. If you copy | |
37 | * code from other Free Software Foundation releases into a copy of | |
38 | * GUILE, as the General Public License permits, the exception does | |
39 | * not apply to the code that you add in this way. To avoid misleading | |
40 | * anyone as to the status of such modified files, you must delete | |
41 | * this exception notice from them. | |
42 | * | |
43 | * If you write modifications of your own for GUILE, it is your choice | |
44 | * whether to permit this exception to apply to your modifications. | |
45 | * If you do not wish that, delete this exception notice. | |
46 | */ | |
47 | \f | |
48 | ||
49 | /** This file defines the format of SCM values and cons pairs. | |
50 | ** It is here that tag bits are assigned for various purposes. | |
51 | **/ | |
c906108c | 52 | \f |
c5aa993b | 53 | |
c906108c | 54 | /* Three Bit Tags |
c5aa993b | 55 | |
c906108c SS |
56 | * 000 -- a non-immediate value. Points into the pair heap. |
57 | * | |
58 | * 001 -- a gloc (i.e., a resolved global variable in a CAR in a code graph) | |
c5aa993b JM |
59 | * or the CAR of an object handle (i.e., the tagged pointer to the |
60 | * vtable part of a user-defined object). | |
c906108c SS |
61 | * |
62 | * If X has this tag, the value at CDAR(X - 1) distinguishes | |
c5aa993b JM |
63 | * glocs from object handles. The distinction only needs |
64 | * to be made in a few places. Only a few parts of the code know | |
65 | * about glocs. In most cases, when a value in the CAR of a pair | |
66 | * has the tag 001, it means that the pair is an object handle. | |
c906108c SS |
67 | * |
68 | * 010 -- the tag for immediate, exact integers. | |
69 | * | |
70 | * 011 -- in the CAR of a pair, this tag indicates that the pair is a closure. | |
c5aa993b JM |
71 | * The remaining bits of the CAR are a pointer into the pair heap |
72 | * to the code graph for the closure. | |
c906108c SS |
73 | * |
74 | * 1xy -- an extension tag which means that there is a five or six bit | |
c5aa993b JM |
75 | * tag to the left of the low three bits. See the nice diagrams |
76 | * in ../doc/code.doc if you want to know what the bits mean. | |
c906108c | 77 | */ |
c906108c SS |
78 | \f |
79 | ||
80 | ||
81 | ||
c5aa993b | 82 | |
c906108c SS |
83 | #define scm_tc3_cons 0 |
84 | #define scm_tc3_cons_gloc 1 | |
85 | #define scm_tc3_closure 3 | |
86 | ||
87 | #define scm_tc7_ssymbol 5 | |
88 | #define scm_tc7_msymbol 7 | |
89 | #define scm_tc7_string 13 | |
90 | #define scm_tc7_bvect 15 | |
91 | #define scm_tc7_vector 21 | |
92 | #define scm_tc7_lvector 23 | |
93 | #define scm_tc7_ivect 29 | |
94 | #define scm_tc7_uvect 31 | |
95 | /* spare 37 39 */ | |
96 | #define scm_tc7_fvect 45 | |
97 | #define scm_tc7_dvect 47 | |
98 | #define scm_tc7_cvect 53 | |
99 | #define scm_tc7_port 55 | |
100 | #define scm_tc7_contin 61 | |
101 | #define scm_tc7_cclo 63 | |
102 | /* spare 69 71 77 79 */ | |
103 | #define scm_tc7_subr_0 85 | |
104 | #define scm_tc7_subr_1 87 | |
105 | #define scm_tc7_cxr 93 | |
106 | #define scm_tc7_subr_3 95 | |
107 | #define scm_tc7_subr_2 101 | |
108 | #define scm_tc7_asubr 103 | |
109 | #define scm_tc7_subr_1o 109 | |
110 | #define scm_tc7_subr_2o 111 | |
111 | #define scm_tc7_lsubr_2 117 | |
112 | #define scm_tc7_lsubr 119 | |
113 | #define scm_tc7_rpsubr 125 | |
114 | ||
115 | #define scm_tc7_smob 127 | |
116 | #define scm_tc_free_cell 127 | |
117 | ||
118 | #define scm_tc16_flo 0x017f | |
119 | #define scm_tc_flo 0x017fL | |
120 | ||
121 | #define SCM_REAL_PART (1L<<16) | |
122 | #define SCM_IMAG_PART (2L<<16) | |
123 | #define scm_tc_dblr (scm_tc16_flo|REAL_PART) | |
124 | #define scm_tc_dblc (scm_tc16_flo|REAL_PART|IMAG_PART) | |
125 | ||
126 | #define scm_tc16_bigpos 0x027f | |
127 | #define scm_tc16_bigneg 0x037f | |
128 | ||
129 | #define scm_tc16_fport (scm_tc7_port + 0*256L) | |
130 | #define scm_tc16_pipe (scm_tc7_port + 1*256L) | |
131 | #define scm_tc16_strport (scm_tc7_port + 2*256L) | |
132 | #define scm_tc16_sfport (scm_tc7_port + 3*256L) | |
133 | ||
134 | ||
135 | ||
136 | /* For cons pairs with immediate values in the CAR */ | |
137 | #define scm_tcs_cons_imcar 2:case 4:case 6:case 10:\ | |
138 | case 12:case 14:case 18:case 20:\ | |
139 | case 22:case 26:case 28:case 30:\ | |
140 | case 34:case 36:case 38:case 42:\ | |
141 | case 44:case 46:case 50:case 52:\ | |
142 | case 54:case 58:case 60:case 62:\ | |
143 | case 66:case 68:case 70:case 74:\ | |
144 | case 76:case 78:case 82:case 84:\ | |
145 | case 86:case 90:case 92:case 94:\ | |
146 | case 98:case 100:case 102:case 106:\ | |
147 | case 108:case 110:case 114:case 116:\ | |
148 | case 118:case 122:case 124:case 126 | |
149 | ||
150 | /* For cons pairs with non-immediate values in the CAR */ | |
151 | #define scm_tcs_cons_nimcar 0:case 8:case 16:case 24:\ | |
152 | case 32:case 40:case 48:case 56:\ | |
153 | case 64:case 72:case 80:case 88:\ | |
154 | case 96:case 104:case 112:case 120 | |
155 | ||
156 | /* A CONS_GLOC occurs in code. It's CAR is a pointer to the | |
157 | * CDR of a variable. The low order bits of the CAR are 001. | |
158 | * The CDR of the gloc is the code continuation. | |
159 | */ | |
160 | #define scm_tcs_cons_gloc 1:case 9:case 17:case 25:\ | |
161 | case 33:case 41:case 49:case 57:\ | |
162 | case 65:case 73:case 81:case 89:\ | |
163 | case 97:case 105:case 113:case 121 | |
164 | ||
165 | #define scm_tcs_closures 3:case 11:case 19:case 27:\ | |
166 | case 35:case 43:case 51:case 59:\ | |
167 | case 67:case 75:case 83:case 91:\ | |
168 | case 99:case 107:case 115:case 123 | |
169 | ||
170 | #define scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case scm_tc7_subr_1:case scm_tc7_cxr:\ | |
171 | case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\ | |
172 | case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr | |
173 | ||
174 | #define scm_tcs_symbols scm_tc7_ssymbol:case scm_tc7_msymbol | |
175 | ||
176 | #define scm_tcs_bignums tc16_bigpos:case tc16_bigneg | |
c906108c SS |
177 | \f |
178 | ||
c5aa993b | 179 | |
c906108c SS |
180 | /* References to objects are of type SCM. Values may be non-immediate |
181 | * (pointers) or immediate (encoded, immutable, scalar values that fit | |
182 | * in an SCM variable). | |
183 | */ | |
184 | ||
185 | typedef long SCM; | |
186 | ||
187 | /* Cray machines have pointers that are incremented once for each word, | |
188 | * rather than each byte, the 3 most significant bits encode the byte | |
189 | * within the word. The following macros deal with this by storing the | |
190 | * native Cray pointers like the ones that looks like scm expects. This | |
191 | * is done for any pointers that might appear in the car of a scm_cell, pointers | |
192 | * to scm_vector elts, functions, &c are not munged. | |
193 | */ | |
194 | #ifdef _UNICOS | |
c5aa993b JM |
195 | #define SCM2PTR(x) ((int)(x) >> 3) |
196 | #define PTR2SCM(x) (((SCM)(x)) << 3) | |
197 | #define SCM_POINTERS_MUNGED | |
c906108c | 198 | #else |
c5aa993b JM |
199 | #define SCM2PTR(x) (x) |
200 | #define PTR2SCM(x) ((SCM)(x)) | |
c906108c | 201 | #endif /* def _UNICOS */ |
c906108c SS |
202 | \f |
203 | ||
c5aa993b | 204 | |
c906108c SS |
205 | /* Immediate? Predicates |
206 | */ | |
207 | #define SCM_IMP(x) (6 & (int)(x)) | |
208 | #define SCM_NIMP(x) (!SCM_IMP(x)) | |
c906108c SS |
209 | \f |
210 | ||
c5aa993b | 211 | |
c906108c | 212 | enum scm_tags |
c5aa993b JM |
213 | { |
214 | scm_tc8_char = 0xf4 | |
215 | }; | |
c906108c SS |
216 | |
217 | #define SCM_ITAG8(X) ((int)(X) & 0xff) | |
218 | #define SCM_MAKE_ITAG8(X, TAG) (((X)<<8) + TAG) | |
219 | #define SCM_ITAG8_DATA(X) ((X)>>8) | |
c5aa993b | 220 | \f |
c906108c SS |
221 | |
222 | ||
c906108c SS |
223 | /* Local Environment Structure |
224 | */ | |
225 | #define SCM_ILOCP(n) ((0xff & (int)(n))==0xfc) | |
226 | #define SCM_ILOC00 (0x000000fcL) | |
227 | #define SCM_IDINC (0x00100000L) | |
228 | #define SCM_ICDR (0x00080000L) | |
229 | #define SCM_IFRINC (0x00000100L) | |
230 | #define SCM_IDSTMSK (-SCM_IDINC) | |
231 | #define SCM_IFRAME(n) ((int)((SCM_ICDR-SCM_IFRINC)>>8) & ((int)(n)>>8)) | |
232 | #define SCM_IDIST(n) (((unsigned long)(n))>>20) | |
233 | #define SCM_ICDRP(n) (SCM_ICDR & (n)) | |
c906108c | 234 | \f |
c5aa993b | 235 | |
c906108c SS |
236 | /* Immediate Symbols, Special Symbols, Flags (various constants). |
237 | */ | |
238 | ||
239 | /* ISYMP tests for ISPCSYM and ISYM */ | |
240 | #define SCM_ISYMP(n) ((0x187 & (int)(n))==4) | |
241 | ||
242 | /* IFLAGP tests for ISPCSYM, ISYM and IFLAG */ | |
243 | #define SCM_IFLAGP(n) ((0x87 & (int)(n))==4) | |
244 | #define SCM_ISYMNUM(n) ((int)((n)>>9)) | |
245 | #define SCM_ISYMCHARS(n) (scm_isymnames[SCM_ISYMNUM(n)]) | |
246 | #define SCM_MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L) | |
247 | #define SCM_MAKISYM(n) (((n)<<9)+0x74L) | |
248 | #define SCM_MAKIFLAG(n) (((n)<<9)+0x174L) | |
249 | ||
250 | /* This table must agree with the declarations | |
251 | * in repl.c: {Names of immediate symbols}. | |
252 | * | |
253 | * These are used only in eval but their values | |
254 | * have to be allocated here. | |
255 | * | |
256 | */ | |
257 | ||
258 | #define SCM_IM_AND SCM_MAKSPCSYM(0) | |
259 | #define SCM_IM_BEGIN SCM_MAKSPCSYM(1) | |
260 | #define SCM_IM_CASE SCM_MAKSPCSYM(2) | |
261 | #define SCM_IM_COND SCM_MAKSPCSYM(3) | |
262 | #define SCM_IM_DO SCM_MAKSPCSYM(4) | |
263 | #define SCM_IM_IF SCM_MAKSPCSYM(5) | |
264 | #define SCM_IM_LAMBDA SCM_MAKSPCSYM(6) | |
265 | #define SCM_IM_LET SCM_MAKSPCSYM(7) | |
266 | #define SCM_IM_LETSTAR SCM_MAKSPCSYM(8) | |
267 | #define SCM_IM_LETREC SCM_MAKSPCSYM(9) | |
268 | #define SCM_IM_OR SCM_MAKSPCSYM(10) | |
269 | #define SCM_IM_QUOTE SCM_MAKSPCSYM(11) | |
270 | #define SCM_IM_SET SCM_MAKSPCSYM(12) | |
271 | #define SCM_IM_DEFINE SCM_MAKSPCSYM(13) | |
272 | #define SCM_IM_APPLY SCM_MAKISYM(14) | |
273 | #define SCM_IM_CONT SCM_MAKISYM(15) | |
274 | #define SCM_NUM_ISYMS 16 | |
275 | ||
276 | /* Important immediates | |
277 | */ | |
278 | ||
279 | #define SCM_BOOL_F SCM_MAKIFLAG(SCM_NUM_ISYMS+0) | |
280 | #define SCM_BOOL_T SCM_MAKIFLAG(SCM_NUM_ISYMS+1) | |
281 | #define SCM_UNDEFINED SCM_MAKIFLAG(SCM_NUM_ISYMS+2) | |
282 | #define SCM_EOF_VAL SCM_MAKIFLAG(SCM_NUM_ISYMS+3) | |
283 | ||
284 | #ifdef SICP | |
285 | #define SCM_EOL SCM_BOOL_F | |
286 | #else | |
287 | #define SCM_EOL SCM_MAKIFLAG(SCM_NUM_ISYMS+4) | |
288 | #endif | |
289 | ||
290 | #define SCM_UNSPECIFIED SCM_MAKIFLAG(SCM_NUM_ISYMS+5) | |
c906108c SS |
291 | \f |
292 | ||
c5aa993b | 293 | |
c906108c SS |
294 | /* Heap Pairs and the Empty List Predicates |
295 | */ | |
296 | #define SCM_NULLP(x) (SCM_EOL == (x)) | |
297 | #define SCM_NNULLP(x) (SCM_EOL != (x)) | |
298 | #define SCM_CELLP(x) (!SCM_NCELLP(x)) | |
299 | #define SCM_NCELLP(x) ((sizeof(scm_cell)-1) & (int)(x)) | |
c5aa993b | 300 | \f |
c906108c SS |
301 | |
302 | ||
c906108c | 303 | #define SCM_UNBNDP(x) (SCM_UNDEFINED==(x)) |
c906108c SS |
304 | \f |
305 | ||
c5aa993b | 306 | |
c906108c SS |
307 | /* Testing and Changing GC Marks in Various Standard Positions |
308 | */ | |
309 | #define SCM_GCMARKP(x) (1 & (int)SCM_CDR(x)) | |
310 | #define SCM_GC8MARKP(x) (0x80 & (int)SCM_CAR(x)) | |
311 | #define SCM_SETGCMARK(x) (SCM_CDR(x) |= 1) | |
312 | #define SCM_CLRGCMARK(x) (SCM_CDR(x) &= ~1L) | |
313 | #define SCM_SETGC8MARK(x) (SCM_CAR(x) |= 0x80) | |
314 | #define SCM_CLRGC8MARK(x) (SCM_CAR(x) &= ~0x80L) | |
c906108c | 315 | \f |
c5aa993b | 316 | |
c906108c SS |
317 | /* Extracting Tag Bits, With or Without GC Safety and Optional Bits |
318 | */ | |
319 | #define SCM_TYP3(x) (7 & (int)SCM_CAR(x)) | |
320 | #define SCM_TYP7(x) (0x7f & (int)SCM_CAR(x)) | |
321 | #define SCM_TYP7S(x) (0x7d & (int)SCM_CAR(x)) | |
322 | #define SCM_TYP16(x) (0xffff & (int)SCM_CAR(x)) | |
323 | #define SCM_TYP16S(x) (0xfeff & (int)SCM_CAR(x)) | |
324 | #define SCM_GCTYP16(x) (0xff7f & (int)SCM_CAR(x)) | |
c906108c | 325 | \f |
c5aa993b | 326 | |
c906108c | 327 | /* Two slightly extensible types: smobs and ptobs. |
c5aa993b | 328 | |
c906108c SS |
329 | */ |
330 | #define SCM_SMOBNUM(x) (0x0ff & (CAR(x)>>8)); | |
331 | #define SCM_PTOBNUM(x) (0x0ff & (CAR(x)>>8)); | |
c5aa993b | 332 | \f |
c906108c SS |
333 | |
334 | ||
c906108c SS |
335 | |
336 | #define SCM_DIRP(x) (SCM_NIMP(x) && (TYP16(x)==(scm_tc16_dir))) | |
337 | #define SCM_OPDIRP(x) (SCM_NIMP(x) && (CAR(x)==(scm_tc16_dir | OPN))) | |
c906108c SS |
338 | \f |
339 | ||
c5aa993b | 340 | |
c906108c SS |
341 | /* Lvectors |
342 | */ | |
343 | #define SCM_LVECTORP(x) (TYP7(x)==tc7_lvector) | |
c906108c | 344 | \f |
c5aa993b | 345 | |
c906108c SS |
346 | #if 0 |
347 | \f | |
348 | /* Sockets | |
349 | */ | |
350 | #define tc_socket (tc7_port | OPN) | |
351 | #define SCM_SOCKP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc_socket)) | |
352 | #define SCM_SOCKTYP(x) (CAR(x)>>24) | |
c906108c SS |
353 | \f |
354 | ||
c5aa993b | 355 | |
c906108c SS |
356 | extern int scm_tc16_key_vector; |
357 | #define SCM_KEYVECP(X) (scm_tc16_key_vector == TYP16 (X)) | |
358 | #define SCM_KEYVECLEN(OBJ) (((unsigned long)CAR (obj)) >> 16) | |
c906108c | 359 | \f |
c5aa993b | 360 | |
c906108c SS |
361 | #define SCM_MALLOCDATA(obj) ((char *)CDR(obj)) |
362 | #define SCM_MALLOCLEN(obj) (((unsigned long)CAR (obj)) >> 16) | |
363 | #define SCM_WORDDATA(obj) (CDR (obj)) | |
364 | ||
365 | ||
366 | #define SCM_BYTECODEP(X) ((TYP7 (X) == tc7_cclo) && (CCLO_SUBR (X) == rb_proc)) | |
367 | #define SCM_BYTECODE_CONSTANTS(X) (VELTS(X)[1]) | |
368 | #define SCM_BYTECODE_CODE(X) (VELTS(X)[2]) | |
369 | #define SCM_BYTECODE_NAME(X) (VELTS(X)[3]) | |
370 | #define SCM_BYTECODE_BCODE(X) (VELTS(X)[4]) | |
371 | #define SCM_BYTECODE_ELTS 5 | |
c906108c | 372 | \f |
c5aa993b | 373 | |
c906108c SS |
374 | #define SCM_FREEP(x) (CAR(x)==tc_free_cell) |
375 | #define SCM_NFREEP(x) (!FREEP(x)) | |
376 | \f | |
c5aa993b | 377 | #endif /* 0 */ |
c906108c | 378 | \f |
c906108c | 379 | |
c5aa993b | 380 | #endif /* TAGSH */ |