2
object.h -- Data structure definitions.
5
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
6
Copyright (c) 1990, Giuseppe Attardi.
7
Copyright (c) 2001, Juan Jose Garcia Ripoll.
9
ECL is free software; you can redistribute it and/or
10
modify it under the terms of the GNU Library General Public
11
License as published by the Free Software Foundation; either
12
version 2 of the License, or (at your option) any later version.
14
See file '../Copyright' for full details.
22
Integer and boolean types (see config.h)
25
#define TRUE 1 /* boolean true value */
26
#define FALSE 0 /* boolean false value */
28
#define CHAR_CODE_LIMIT 256 /* ASCII character code limit */
30
#if !defined(__cplusplus) && !defined(bool)
33
typedef unsigned char byte;
36
Definition of the type of LISP objects.
38
typedef union cl_lispunion *cl_object;
39
typedef cl_object cl_return;
40
typedef cl_fixnum cl_narg;
41
typedef cl_object (*cl_objectfn)(cl_narg narg, ...);
42
typedef cl_object (*cl_objectfn_fixed)();
46
It should not coincide with any legal object value.
48
#define OBJNULL ((cl_object)NULL)
51
Definition of each implementation type.
54
#define IMMEDIATE(obje) ((cl_fixnum)(obje) & 3)
55
#define IMMEDIATE_TAG 3
57
/* Immediate fixnums: */
59
#define MAKE_FIXNUM(n) ((cl_object)(((cl_fixnum)(n) << 2) | FIXNUM_TAG))
60
#define FIXNUM_MINUSP(n) ((cl_fixnum)(n) < 0)
61
#define FIXNUM_PLUSP(n) ((cl_fixnum)(n) >= (cl_fixnum)MAKE_FIXNUM(0))
62
#define fix(obje) (((cl_fixnum)(obje)) >> 2)
63
#define FIXNUMP(obje) (((cl_fixnum)(obje)) & FIXNUM_TAG)
65
/* Immediate characters: */
66
#define CHARACTER_TAG 2
67
#define CHARACTERP(obje) (((cl_fixnum)(obje)) & 2)
68
#define CODE_CHAR(c) ((cl_object)(((cl_fixnum)((unsigned char)c) << 2)|CHARACTER_TAG))
69
#define CHAR_CODE(obje) ((((cl_fixnum)(obje)) >> 2) & 0xff)
71
#define NUMBER_TYPE(t) (t == t_fixnum || (t >= t_bignum && t <= t_complex))
72
#define REAL_TYPE(t) (t == t_fixnum || (t >= t_bignum && t < t_complex))
73
#define ARRAY_TYPE(t) (t >= t_array && t <= t_bitvector)
74
#define ARRAYP(x) ((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
75
#define VECTORP(x) ((IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
77
#define HEADER int8_t t, m, padding[2]
78
#define HEADER1(field) int8_t t, m, field, padding
79
#define HEADER2(field1,field2) int8_t t, m, field1, field2
80
#define HEADER3(field1,flag2,flag3) int8_t t, m, field1; uint8_t flag2:4, flag3:4
81
#define HEADER4(field1,flag2,flag3,flag4) int8_t t, m, field1; uint8_t flag2:4, flag3:2, flag4:2
83
struct ecl_shortfloat {
85
float SFVAL; /* shortfloat value */
87
#define sf(obje) (obje)->SF.SFVAL
89
struct ecl_longfloat {
91
double LFVAL; /* longfloat value */
93
#define lf(obje) (obje)->LF.LFVAL
101
#define big_dim big_num->_mp_alloc
102
#define big_size big_num->_mp_size
103
#define big_limbs big_num->_mp_d
107
# ifdef HAVE_LONG_LONG
108
typedef long long int big_num_t;
109
# else /* HAVE_LONG_LONG */
110
typedef long int big_num_t; /* would it work? */
111
# endif /* HAVE_LONG_LONG */
118
#endif /* WITH_GMP */
122
cl_object den; /* denominator, must be an integer */
123
cl_object num; /* numerator, must be an integer */
127
#undef complex /* Otherwise we cannot do x->complex.real */
131
cl_object real; /* real part, must be a number */
132
cl_object imag; /* imaginary part, must be a number */
135
enum ecl_stype { /* symbol type */
136
stp_ordinary, /* ordinary */
137
stp_constant, /* constant */
138
stp_special /* special */
141
#define Cnil ((cl_object)cl_symbols)
142
#define Ct ((cl_object)(cl_symbols+1))
143
#define ECL_UNBOUND ((cl_object)(cl_symbols+2))
144
#define ECL_PROTECT_TAG ((cl_object)(cl_symbols+3))
147
HEADER4(stype, mflag, isform, dynamic);
148
/* symbol type and whether it names a macro */
149
cl_object value; /* global value of the symbol */
150
/* Coincides with cons.car */
151
cl_object gfdef; /* global function definition */
153
/* its expansion function */
154
/* is to be stored. */
155
/* Coincides with cons.cdr */
156
cl_object plist; /* property list */
157
/* This field coincides with cons.car */
158
cl_object name; /* print name */
159
cl_object hpack; /* home package */
160
/* Cnil for uninterned symbols */
162
#define SYM_FUN(sym) ((sym)->symbol.gfdef)
166
cl_object name; /* package name, a string */
167
cl_object nicknames; /* nicknames, list of strings */
168
cl_object shadowings; /* shadowing symbol list */
169
cl_object uses; /* use-list of packages */
170
cl_object usedby; /* used-by-list of packages */
171
cl_object internal; /* hashtable for internal symbols */
172
cl_object external; /* hashtable for external symbols */
174
pthread_mutex_t lock; /* thread safe packages */
179
The values returned by intern and find_symbol.
180
File_symbol may return 0.
186
#define LISTP(x) (x == Cnil || CONSP(x))
187
#define CONSP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_cons))
188
#define ATOM(x) ((IMMEDIATE(x) != 0) || ((x)->d.t != t_cons))
189
#define SYMBOLP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol))
192
cl_object cdr; /* cdr */
193
cl_object car; /* car */
196
enum ecl_httest { /* hash table key test function */
199
htt_equal, /* equal */
200
htt_equalp, /* equalp */
201
htt_pack /* symbol hash */
204
struct ecl_hashtable_entry { /* hash table entry */
205
cl_object key; /* key */
206
cl_object value; /* value */
209
struct ecl_hashtable { /* hash table header */
210
HEADER2(test,lockable);
211
struct ecl_hashtable_entry *data; /* pointer to the hash table */
212
cl_index entries; /* number of entries */
213
cl_index size; /* hash table size */
214
cl_object rehash_size; /* rehash size */
215
cl_object threshold; /* rehash threshold */
216
double factor; /* cached value of threshold */
218
pthread_mutex_t lock; /* mutex to prevent race conditions */
222
typedef enum { /* array element type */
224
aet_sf, /* short-float */
225
aet_lf, /* long-float */
227
aet_fix, /* cl_fixnum */
228
aet_index, /* cl_index */
229
/* Below here, list types accepted by streams (i.e. OPEN) */
231
aet_i8, /* integer8 */
232
aet_ch, /* string-char */
233
aet_last_type = aet_ch
236
union ecl_array_data {
248
struct ecl_array { /* array header */
249
/* adjustable flag */
250
/* has-fill-pointer flag */
251
HEADER2(adjustable,rank);
252
cl_object displaced; /* displaced */
253
cl_index dim; /* dimension */
254
cl_index *dims; /* table of dimensions */
255
union ecl_array_data self; /* pointer to the array */
256
byte elttype; /* element type */
257
byte offset; /* bitvector offset */
260
struct ecl_vector { /* vector header */
261
/* adjustable flag */
262
/* has-fill-pointer flag */
263
HEADER2(adjustable,hasfillp);
264
cl_object displaced; /* displaced */
265
cl_index dim; /* dimension */
266
cl_index fillp; /* fill pointer */
267
/* For simple vectors, */
268
/* v_fillp is equal to v_dim. */
269
union ecl_array_data self; /* pointer to the vector */
270
byte elttype; /* element type */
274
struct ecl_string { /* string header */
275
/* adjustable flag */
276
/* has-fill-pointer flag */
277
HEADER2(adjustable,hasfillp);
278
cl_object displaced; /* displaced */
279
cl_index dim; /* dimension */
281
cl_index fillp; /* fill pointer */
282
/* For simple strings, */
283
/* st_fillp is equal to st_dim-1. */
284
unsigned char *self; /* pointer to the string */
288
#define T_STRUCTURE t_instance
289
#define STYPE(x) CLASS_OF(x)
290
#define SLOTS(x) (x)->instance.slots
291
#define SLENGTH(x) (x)->instance.length
292
#define SLOT(x,i) (x)->instance.slots[i]
293
#define SNAME(x) CLASS_NAME(CLASS_OF(x))
295
struct ecl_structure { /* structure header */
297
cl_object name; /* structure name */
298
cl_object *self; /* structure self */
299
cl_fixnum length; /* structure length */
302
#define T_STRUCTURE t_structure
303
#define STYPE(x) x->str.name
304
#define SLOTS(x) (x)->str.self
305
#define SLENGTH(x) (x)->str.length
306
#define SLOT(x,i) (x)->str.self[i]
307
#define SNAME(x) x->str.name
310
enum ecl_smmode { /* stream mode */
311
smm_input, /* input */
312
smm_output, /* output */
313
smm_io, /* input-output */
314
smm_synonym, /* synonym */
315
smm_broadcast, /* broadcast */
316
smm_concatenated, /* concatenated */
317
smm_two_way, /* two way */
319
smm_string_input, /* string input */
320
smm_string_output, /* string output */
321
smm_probe /* probe (only used in open_stream()) */
322
#if defined(ECL_WSOCK)
324
smm_input_wsock, /* input socket (Win32) */
325
smm_output_wsock, /* output socket (Win32) */
326
smm_io_wsock /* input/output socket (Win32) */
331
HEADER4(mode,closed,char_stream_p,signed_bytes);
332
/* stream mode of enum smmode */
333
/* stream element type */
334
FILE *file; /* file pointer */
335
cl_object object0; /* some object */
336
cl_object object1; /* some object */
337
cl_fixnum int0; /* some int */
338
cl_fixnum int1; /* some int */
339
char *buffer; /* file buffer */
340
cl_index byte_size; /* size of byte in binary streams */
341
unsigned char bit_buffer;
343
int8_t buffer_state; /* 0: unknown, 1: reading, -1: writing */
344
uint8_t header; /* number of significant bits in the last byte */
349
cl_index value; /* random state value */
352
enum ecl_chattrib { /* character attribute */
353
cat_whitespace, /* whitespace */
354
cat_terminating, /* terminating macro */
355
cat_non_terminating, /* non-terminating macro */
356
cat_single_escape, /* single-escape */
357
cat_multiple_escape, /* multiple-escape */
358
cat_constituent /* constituent */
361
struct ecl_readtable_entry { /* read table entry */
362
enum ecl_chattrib syntax_type; /* character attribute */
363
cl_object macro; /* macro function */
364
cl_object *dispatch_table; /* pointer to the */
367
/* non-dispatching */
368
/* macro character, or */
369
/* non-macro character */
372
enum ecl_readtable_case {
379
struct ecl_readtable { /* read table */
381
enum ecl_readtable_case read_case; /* readtable-case */
382
struct ecl_readtable_entry *table; /* read table itself */
385
struct ecl_pathname {
386
HEADER1(logical); /* logical pathname? */
387
cl_object host; /* host */
388
cl_object device; /* device */
389
cl_object directory; /* directory */
390
cl_object name; /* name */
391
cl_object type; /* type */
392
cl_object version; /* version */
395
struct ecl_codeblock {
396
HEADER2(self_destruct,locked); /* delete DLL after gc */
397
/* do not garbage collect this library */
398
void *handle; /* handle returned by dlopen */
399
void *entry; /* entry point */
400
cl_object *data; /* data vector */
402
cl_object *temp_data; /* data vector for toplevel forms */
404
const char *data_text; /* string with objects to be defined */
406
cl_object next; /* next codeblock within same library */
411
cl_object links; /* list of symbols with linking calls */
414
struct ecl_bytecodes {
416
cl_object name; /* function name */
417
cl_object lex; /* lexical environment */
418
cl_object specials; /* list of special variables */
419
cl_object definition; /* function definition in list form */
420
cl_index code_size; /* number of bytecodes */
421
cl_index data_size; /* number of constants */
422
char *code; /* the intermediate language */
423
cl_object *data; /* non-inmediate constants used in the code */
426
struct ecl_cfun { /* compiled function header */
428
cl_object name; /* compiled function name */
429
cl_objectfn entry; /* entry address */
430
cl_object block; /* descriptor of C code block for GC */
433
struct ecl_cclosure { /* compiled closure header */
435
cl_object env; /* environment */
436
cl_objectfn entry; /* entry address */
437
cl_object block; /* descriptor of C code block for GC */
440
struct ecl_foreign { /* user defined datatype */
442
cl_object tag; /* a tag identifying the type */
443
cl_index size; /* the amount of memory allocated */
444
char *data; /* the data itself */
461
struct cl_env_struct *env;
468
pthread_mutex_t mutex;
473
#define CLASS_OF(x) (x)->instance.clas
474
#define CLASS_NAME(x) (x)->instance.slots[0]
475
#define CLASS_SUPERIORS(x) (x)->instance.slots[1]
476
#define CLASS_INFERIORS(x) (x)->instance.slots[2]
477
#define CLASS_SLOTS(x) (x)->instance.slots[3]
478
#define CLASS_CPL(x) (x)->instance.slots[4]
480
struct ecl_instance { /* instance header */
482
cl_index length; /* instance length */
483
cl_object clas; /* instance class */
484
cl_object sig; /* generation signature */
485
cl_object *slots; /* instance slots */
490
Definition of lispunion.
493
struct ecl_bignum big; /* bignum */
494
struct ecl_ratio ratio; /* ratio */
495
struct ecl_shortfloat SF; /* short floating-point number */
496
struct ecl_longfloat LF; /* long floating-point number */
497
struct ecl_complex complex;/* complex number */
498
struct ecl_symbol symbol; /* symbol */
499
struct ecl_package pack; /* package */
500
struct ecl_cons cons; /* cons */
501
struct ecl_hashtable hash; /* hash table */
502
struct ecl_array array; /* array */
503
struct ecl_vector vector; /* vector */
504
struct ecl_string string; /* string */
505
struct ecl_stream stream; /* stream */
506
struct ecl_random random; /* random-states */
507
struct ecl_readtable readtable; /* read table */
508
struct ecl_pathname pathname; /* path name */
509
struct ecl_bytecodes bytecodes; /* bytecompiled closure */
510
struct ecl_cfun cfun; /* compiled function */
511
struct ecl_cclosure cclosure; /* compiled closure */
513
struct ecl_dummy d; /* dummy */
515
struct ecl_instance instance; /* clos instance */
517
struct ecl_structure str; /* structure */
520
struct ecl_process process; /* process */
521
struct ecl_lock lock; /* lock */
523
struct ecl_codeblock cblock; /* codeblock */
524
struct ecl_foreign foreign; /* user defined data type */
528
Implementation types.
533
/* The most specific numeric types come first. Assumed by
534
some routines, like cl_expt */
535
t_fixnum, /* 1 immediate fixnum */
536
t_character, /* 2 immediate character */
537
t_bignum = 4, /* 4 */
539
t_shortfloat, /* 6 */
551
t_readtable, /* 12 */
553
t_bytecodes, /* 14 */
559
t_structure, /* 17 */
565
t_codeblock, /* 21 */
569
t_contiguous, /* contiguous block */
570
FREE = 127 /* free object */
577
#if defined(__cplusplus) || defined(__GNUC__)
578
static inline cl_type type_of(cl_object o) {
579
int i = IMMEDIATE(o);
580
return (i? (cl_type)i : (cl_type)(o->d.t));
584
((cl_type)(IMMEDIATE(o) ? IMMEDIATE(o) : ((o)->d.t)))
588
This is used to retrieve optional arguments
added
removed
src/h/object.h
