2
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
4
This file is part of GNU Common Lisp, herein referred to as GCL
6
GCL is free software; you can redistribute it and/or modify it under
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
8
the Free Software Foundation; either version 2, or (at your option)
11
GCL 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 Library General Public
14
License for more details.
16
You should have received a copy of the GNU Library General Public License
17
along with GCL; see the file COPYING. If not, write to the Free Software
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27
Some system constants.
30
#define TRUE 1 /* boolean true value */
31
#define FALSE 0 /* boolean false value */
33
#define FIRSTWORD unsigned char t,flag; char s,m
35
#define NBPP 4 /* number of bytes per pointer */
38
#define PAGEWIDTH 11 /* page width */
41
#define PAGESIZE (1 << PAGEWIDTH) /* page size in bytes */
44
#define CHCODELIM 256 /* character code limit */
45
/* ASCII character set */
46
#define CHFONTLIM 1 /* character font limit */
47
#define CHBITSLIM 1 /* character bits limit */
48
#define CHCODEFLEN 8 /* character code field length */
49
#define CHFONTFLEN 0 /* character font field length */
50
#define CHBITSFLEN 0 /* character bits field length */
52
#define PHTABSIZE 512 /* number of entries */
53
/* in the package hash table */
55
#define ARANKLIM 64 /* array rank limit */
57
#define RTABSIZE CHCODELIM
60
#define CBMINSIZE 64 /* contiguous block minimal size */
63
#define CHAR_SIZE 8 /* number of bits in a char */
68
typedef float shortfloat;
69
typedef double longfloat;
70
typedef unsigned short fatchar;
77
#define SIGNED_CHAR(x) (((char ) -1) < (char )0 ? (char) x \
78
: (x >= (1<<(CHAR_SIZE-1)) ? \
79
x - (((int)(1<<(CHAR_SIZE-1))) << 1) \
84
Definition of the type of LISP objects.
86
typedef union lispunion *object;
88
typedef union int_object iobject;
89
union int_object {object o; int i;};
93
It should not coincide with any legal object value.
95
#define OBJNULL ((object)NULL)
98
Definition of each implementation type.
101
struct fixnum_struct {
103
fixnum FIXVAL; /* fixnum value */
105
#define Mfix(obje) (obje)->FIX.FIXVAL
106
#define fix(x) Mfix(x)
108
#define SMALL_FIXNUM_LIMIT 1024
111
struct fixnum_struct small_fixnum_table[2*SMALL_FIXNUM_LIMIT];
113
#define small_fixnum(i) \
114
(object)(small_fixnum_table+SMALL_FIXNUM_LIMIT+(i))
116
struct shortfloat_struct {
118
shortfloat SFVAL; /* shortfloat value */
120
#define Msf(obje) (obje)->SF.SFVAL
123
struct longfloat_struct {
125
longfloat LFVAL; /* longfloat value */
127
#define Mlf(obje) (obje)->LF.LFVAL
137
int _mp_alloc; /* Number of *limbs* allocated and pointed
138
to by the _mp_d field. */
139
int _mp_size; /* abs(_mp_size) is the number of limbs the
140
last field points to. If _mp_size is
141
negative this is a negative number. */
142
void *_mp_d; /* Pointer to the limbs. */
149
__mpz_struct big_mpz_t;
151
plong *big_self; /* bignum body */
152
int big_length; /* bignum length */
158
object rat_den; /* denominator */
159
/* must be an integer */
160
object rat_num; /* numerator */
161
/* must be an integer */
166
object cmp_real; /* real part */
167
/* must be a number */
168
object cmp_imag; /* imaginary part */
169
/* must be a number */
174
unsigned short ch_code; /* code */
175
unsigned char ch_font; /* font */
176
unsigned char ch_bits; /* bits */
182
struct character character_table1[256+128];
183
#define character_table (character_table1+128)
184
#define code_char(c) (object)(character_table+(c))
185
#define char_code(obje) (obje)->ch.ch_code
186
#define char_font(obje) (obje)->ch.ch_font
187
#define char_bits(obje) (obje)->ch.ch_bits
189
enum stype { /* symbol type */
190
stp_ordinary, /* ordinary */
191
stp_constant, /* constant */
192
stp_special /* special */
195
#define Cnil ((object)&Cnil_body)
196
#define Ct ((object)&Ct_body)
200
#define NOT_SPECIAL ((int (*)())Cnil)
201
#define s_fillp st_fillp
202
#define s_self st_self
206
object s_dbind; /* dynamic binding */
207
int (*s_sfdef)(); /* special form definition */
208
/* This field coincides with c_car */
209
char *s_self; /* print name */
210
/* These fields coincide with */
211
/* st_fillp and st_self. */
212
int s_fillp; /* print name length */
214
object s_gfdef; /* global function definition */
216
/* its expansion function */
217
/* is to be stored. */
218
object s_plist; /* property list */
219
object s_hpack; /* home package */
220
/* Cnil for uninterned symbols */
221
short s_stype; /* symbol type */
223
short s_mflag; /* macro flag */
226
struct symbol Cnil_body, Ct_body;
230
object p_name; /* package name */
232
object p_nicknames; /* nicknames */
233
/* list of strings */
234
object p_shadowings; /* shadowing symbol list */
235
object p_uselist; /* use-list of packages */
236
object p_usedbylist; /* used-by-list of packages */
237
object *p_internal; /* hashtable for internal symbols */
238
object *p_external; /* hashtable for external symbols */
239
int p_internal_size; /* size of internal hash table*/
240
int p_external_size; /* size of external hash table */
241
int p_internal_fp; /* [rough] number of symbols */
242
int p_external_fp; /* [rough] number of symbols */
244
*p_link; /* package link */
248
The values returned by intern and find_symbol.
249
File_symbol may return 0.
256
All the packages are linked through p_link.
258
EXTER struct package *pack_pointer; /* package pointer */
262
object c_cdr; /* cdr */
263
object c_car; /* car */
266
enum httest { /* hash table key test function */
269
htt_equal /* equal */
272
struct htent { /* hash table entry */
273
object hte_key; /* key */
274
object hte_value; /* value */
277
struct hashtable { /* hash table header */
280
*ht_self; /* pointer to the hash table */
281
object ht_rhsize; /* rehash size */
282
object ht_rhthresh; /* rehash threshold */
283
int ht_nent; /* number of entries */
284
int ht_size; /* hash table size */
285
short ht_test; /* key test function */
289
enum aelttype { /* array element type */
291
aet_ch, /* string-char */
293
aet_fix, /* fixnum */
294
aet_sf, /* short-float */
295
aet_lf, /* plong-float */
296
aet_char, /* signed char */
297
aet_uchar, /* unsigned char */
298
aet_short, /* signed short */
299
aet_ushort, /* unsigned short */
303
struct array { /* array header */
305
object a_displaced; /* displaced */
306
short a_rank; /* array rank */
307
short a_elttype; /* element type */
308
object *a_self; /* pointer to the array */
309
short a_adjustable; /* adjustable flag */
310
short a_offset; /* bitvector offset */
311
int a_dim; /* dimension */
312
int *a_dims; /* table of dimensions */
318
struct vector { /* vector header */
320
object v_displaced; /* displaced */
321
short v_hasfillp; /* has-fill-pointer flag */
322
short v_elttype; /* element type */
324
object *v_self; /* pointer to the vector */
325
int v_fillp; /* fill pointer */
326
/* For simple vectors, */
327
/* v_fillp is equal to v_dim. */
328
int v_dim; /* dimension */
329
short v_adjustable; /* adjustable flag */
330
short v_offset; /* not used */
333
struct string { /* string header */
335
object st_displaced; /* displaced */
336
short st_hasfillp; /* has-fill-pointer flag */
337
short st_adjustable; /* adjustable flag */
338
char *st_self; /* pointer to the string */
339
int st_fillp; /* fill pointer */
340
/* For simple strings, */
341
/* st_fillp is equal to st_dim. */
342
int st_dim; /* dimension */
349
object ust_displaced;
351
short ust_adjustable;
352
unsigned char *ust_self;
360
#define USHORT(x,i) (((unsigned short *)(x)->ust.ust_self)[i])
361
#define SHORT(x,i) ((( short *)(x)->ust.ust_self)[i])
363
#define BV_OFFSET(x) ((type_of(x)==t_bitvector ? x->bv.bv_offset : \
364
type_of(x)== t_array ? x->a.a_offset : abort(),0))
366
#define SET_BV_OFFSET(x,val) ((type_of(x)==t_bitvector ? x->bv.bv_offset = val : \
367
type_of(x)== t_array ? x->a.a_offset=val : abort(),0))
372
struct bitvector { /* bitvector header */
374
object bv_displaced; /* displaced */
375
short bv_hasfillp; /* has-fill-pointer flag */
376
short bv_elttype; /* not used */
377
char *bv_self; /* pointer to the bitvector */
378
int bv_fillp; /* fill pointer */
379
/* For simple bitvectors, */
380
/* st_fillp is equal to st_dim. */
381
int bv_dim; /* dimension */
383
short bv_adjustable; /* adjustable flag */
384
short bv_offset; /* bitvector offset */
385
/* the position of the first bit */
386
/* in the first byte */
389
struct fixarray { /* fixnum array header */
391
object fixa_displaced; /* displaced */
392
short fixa_rank; /* array rank */
393
short fixa_elttype; /* element type */
394
fixnum *fixa_self; /* pointer to the array */
395
short fixa_adjustable;/* adjustable flag */
396
short fixa_offset; /* not used */
397
int fixa_dim; /* dimension */
398
int *fixa_dims; /* table of dimensions */
402
struct sfarray { /* short-float array header */
404
object sfa_displaced; /* displaced */
405
short sfa_rank; /* array rank */
406
short sfa_elttype; /* element type */
408
*sfa_self; /* pointer to the array */
409
short sfa_adjustable; /* adjustable flag */
410
short sfa_offset; /* not used */
411
int sfa_dim; /* dimension */
413
int *sfa_dims; /* table of dimensions */
419
struct lfarray { /* plong-float array header */
421
object lfa_displaced; /* displaced */
422
short lfa_rank; /* array rank */
423
short lfa_elttype; /* element type */
425
*lfa_self; /* pointer to the array */
426
short lfa_adjustable; /* adjustable flag */
427
short lfa_offset; /* not used */
428
int lfa_dim; /* dimension */
429
int *lfa_dims; /* table of dimensions */
434
struct structure { /* structure header */
436
object str_def; /* structure definition (a structure) */
437
object *str_self; /* structure self */
440
struct s_data {object name;
446
object print_function;
447
object slot_descriptions;
448
object slot_position;
453
#define S_DATA(x) ((struct s_data *)((x)->str.str_self))
454
#define SLOT_TYPE(def,i) (((S_DATA(def))->raw->ust.ust_self[i]))
455
#define SLOT_POS(def,i) USHORT(S_DATA(def)->slot_position,i)
456
#define STREF(type,x,i) (*((type *)(((char *)((x)->str.str_self))+(i))))
460
enum smmode { /* stream mode */
461
smm_input, /* input */
462
smm_output, /* output */
463
smm_io, /* input-output */
464
smm_probe, /* probe */
465
smm_synonym, /* synonym */
466
smm_broadcast, /* broadcast */
467
smm_concatenated, /* concatenated */
468
smm_two_way, /* two way */
470
smm_string_input, /* string input */
471
smm_string_output, /* string output */
472
smm_user_defined, /* for user defined */
473
smm_socket /* Socket stream */
476
/* for any stream that takes writec_char, directly (not two_way or echo)
477
ie. smm_output,smm_io, smm_string_output, smm_socket
479
#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int1)
482
#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int0)
484
/* file fd for socket */
485
#define SOCKET_STREAM_FD(strm) ((strm)->sm.sm_fd)
486
#define SOCKET_STREAM_BUFFER(strm) ((strm)->sm.sm_object1)
488
/* for smm_string_input */
489
#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_int0)
490
#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_int1)
492
/* for smm_two_way and smm_echo */
493
#define STREAM_OUTPUT_STREAM(strm) ((strm)->sm.sm_object1)
494
#define STREAM_INPUT_STREAM(strm) ((strm)->sm.sm_object0)
496
/* for smm_string_{input,output} */
497
#define STRING_STREAM_STRING(strm) ((strm)->sm.sm_object0)
501
FILE *sm_fp; /* file pointer */
502
object sm_object0; /* some object */
503
object sm_object1; /* some object */
504
int sm_int0; /* some int */
505
int sm_int1; /* column for input or output, stream */
506
char *sm_buffer; /* ptr to BUFSIZE block of storage */
507
char sm_mode; /* stream mode */
508
unsigned char sm_flags; /* flags from gcl_sm_flags */
509
short sm_fd; /* stream fd */
513
#define GET_STREAM_FLAG(strm,name) ((strm)->sm.sm_flags & (1<<(name)))
514
#define SET_STREAM_FLAG(strm,name,val) (val ? \
515
((strm)->sm.sm_flags |= (1<<(name))) : \
516
((strm)->sm.sm_flags &= ~(1<<(name))))
518
#define GCL_MODE_BLOCKING 1
519
#define GCL_MODE_NON_BLOCKING 0
520
#define GCL_TCP_ASYNC 1
534
#define BASEFF (unsigned char *)0xffffffff
536
#define BASEFF (char *)0xffffffff
541
#define BASEFF (unsigned char *)0xffffffff
545
#define BASEFF (unsigned char *)0xffffffff
555
unsigned rnd_value; /* random state value */
558
enum chattrib { /* character attribute */
559
cat_whitespace, /* whitespace */
560
cat_terminating, /* terminating macro */
561
cat_non_terminating, /* non-terminating macro */
562
cat_single_escape, /* single-escape */
563
cat_multiple_escape, /* multiple-escape */
564
cat_constituent /* constituent */
567
struct rtent { /* read table entry */
568
enum chattrib rte_chattrib; /* character attribute */
569
object rte_macro; /* macro function */
570
object *rte_dtab; /* pointer to the */
573
/* non-dispatching */
574
/* macro character, or */
575
/* non-macro character */
578
struct readtable { /* read table */
580
struct rtent *rt_self; /* read table itself */
585
object pn_host; /* host */
586
object pn_device; /* device */
587
object pn_directory; /* directory */
588
object pn_name; /* name */
589
object pn_type; /* type */
590
object pn_version; /* version */
593
struct cfun { /* compiled function header */
595
object cf_name; /* compiled function name */
596
int (*cf_self)(); /* entry address */
597
object cf_data; /* data the function uses */
601
struct cclosure { /* compiled closure header */
603
object cc_name; /* compiled closure name */
604
int (*cc_self)(); /* entry address */
605
object cc_env; /* environment */
606
object cc_data; /* data the closure uses */
609
object *cc_turbo; /* turbo charger */
614
object cl_name; /* name */
615
int (*cl_self)(); /* C start address of code */
616
object cl_data; /* To object holding VV vector */
617
int cl_argd; /* description of args + number */
618
int cl_envdim; /* length of the environment vector */
619
object *cl_env; /* environment vector referenced by cl_self()*/
624
object sfn_name; /* name */
625
int (*sfn_self)(); /* C start address of code */
626
object sfn_data; /* To object holding VV vector */
627
int sfn_argd; /* description of args + number */
633
object vfn_name; /* name */
634
int (*vfn_self)(); /* C start address of code */
635
object vfn_data; /* To object holding VV data */
636
unsigned short vfn_minargs; /* Min args and where varargs start */
637
unsigned short vfn_maxargs; /* Max number of args */
641
char *cfd_start; /* beginning of contblock for fun */
642
int cfd_size; /* size of contblock */
643
int cfd_fillp; /* size of self */
644
object *cfd_self; /* body */
660
Definition of lispunion.
665
struct bignum big; /* bignum */
666
struct ratio rat; /* ratio */
667
struct shortfloat_struct
668
SF; /* short floating-point number */
669
struct longfloat_struct
670
LF; /* plong floating-point number */
671
struct complex cmp; /* complex number */
674
struct symbol s; /* symbol */
675
struct package p; /* package */
676
struct cons c; /* cons */
679
struct array a; /* array */
680
struct vector v; /* vector */
681
struct string st; /* string */
687
struct stream sm; /* stream */
688
struct random rnd; /* random-states */
691
struct pathname pn; /* path name */
692
struct cfun cf; /* compiled function uses value stack] */
693
struct cclosure cc; /* compiled closure uses value stack */
694
struct closure cl; /* compiled closure uses c stack */
695
struct sfun sfn; /* simple function */
696
struct vfun vfn; /* function with variable number of args */
697
struct cfdata cfd; /* compiled fun data */
698
struct spice spc; /* spice */
700
struct dummy d; /* dummy */
702
struct fixarray fixa; /* fixnum array */
703
struct sfarray sfa; /* short-float array */
704
struct lfarray lfa; /* plong-float array */
707
#define address_int unsigned int
710
The struct of free lists.
716
#ifndef INT_TO_ADDRESS
717
#define INT_TO_ADDRESS(x) ((object )(long )x)
720
#define F_LINK(x) ((struct freelist *)(long) x)->f_link
721
#define FL_LINK F_LINK
722
#define SET_LINK(x,val) F_LINK(x) = (address_int) (val)
723
#define OBJ_LINK(x) ((object) INT_TO_ADDRESS(F_LINK(x)))
725
#define FREE (-1) /* free object */
730
#define type_of(obje) ((enum type)(((object)(obje))->d.t))
733
Storage manager for each type.
738
short tm_size; /* element size in bytes */
739
short tm_nppage; /* number per page */
740
object tm_free; /* free list */
741
/* Note that it is of type object. */
742
int tm_nfree; /* number of free elements */
743
int tm_nused; /* number of elements used */
744
int tm_npage; /* number of pages */
745
int tm_maxpage; /* maximum number of pages */
746
char *tm_name; /* type name */
747
int tm_gbccount; /* GBC count */
748
object tm_alt_free; /* Alternate free list (swap with tm_free) */
749
int tm_alt_nfree; /* Alternate nfree (length of nfree) */
750
short tm_sgc; /* this type has at least this many
752
short tm_sgc_minfree; /* number free on a page to qualify for
754
short tm_sgc_max; /* max on sgc pages */
755
short tm_min_grow; /* min amount to grow when growing */
756
short tm_max_grow; /* max amount to grow when growing */
757
short tm_growth_percent; /* percent to increase maxpages */
758
short tm_percent_free; /* percent which must be free after a gc for this type */
764
The table of type managers.
766
EXTER struct typemanager tm_table[ 32 /* (int) t_relocatable */];
768
#define tm_of(t) (&(tm_table[(int)tm_table[(int)(t)].tm_type]))
771
Contiguous block header.
773
struct contblock { /* contiguous block header */
774
int cb_size; /* size in bytes */
776
*cb_link; /* contiguous block link */
780
The pointer to the contiguous blocks.
782
EXTER struct contblock *cb_pointer; /* contblock pointer */
785
Variables for memory management.
787
EXTER int ncb; /* number of contblocks */
788
/* int ncbpage; number of contblock pages */
789
#define ncbpage tm_table[t_contiguous].tm_npage
790
#define maxcbpage tm_table[t_contiguous].tm_maxpage
791
#define cbgbccount tm_table[t_relocatable].tm_gbccount
794
/* int maxcbpage; maximum number of contblock pages */
796
int holepage; /* hole pages */
797
#define nrbpage tm_table[t_relocatable].tm_npage
798
#define rbgbccount tm_table[t_relocatable].tm_gbccount
799
/* int nrbpage; number of relblock pages */
803
char *rb_start; /* relblock start */
804
EXTER char *rb_end; /* relblock end */
805
EXTER char *rb_limit; /* relblock limit */
806
EXTER char *rb_pointer; /* relblock pointer */
807
EXTER char *rb_start1; /* relblock start in copy space */
808
EXTER char *rb_pointer1; /* relblock pointer in copy space */
810
EXTER char *heap_end; /* heap end */
811
EXTER char *core_end; /* core end */
815
/* make f allocate enough extra, so that we can round
816
up, the address given to an even multiple. Special
817
case of size == 0 , in which case we just want an aligned
818
number in the address range
821
#define ALLOC_ALIGNED(f, size,align) \
822
(align <= sizeof(plong) ? (char *)((f)(size)) : \
823
(tmp_alloc = (char *)((f)(size+(size ?(align)-1 : 0)))+(align)-1 , \
824
(char *)(align * (((unsigned int)tmp_alloc)/align))))
825
#define AR_ALLOC(f,n,type) (type *) \
826
(ALLOC_ALIGNED(f,(n)*sizeof(type),sizeof(type)))
834
#define INIT_HOLEPAGE 150
835
#define INIT_NRBPAGE 50
840
#define STATIC register
846
#define TIME_ZONE (-9)
850
/* For IEEEFLOAT, the double may have exponent in the second word
851
(little endian) or first word.*/
853
#if defined(I386) || defined(LITTLE_END)
854
#define HIND 1 /* (int) of double where the exponent and most signif is */
855
#define LIND 0 /* low part of a double */
856
#else /* big endian */
865
#define isUpper(xxx) (((xxx)&0200) == 0 && isupper(xxx))
866
#define isLower(xxx) (((xxx)&0200) == 0 && islower(xxx))
867
#define isDigit(xxx) (((xxx)&0200) == 0 && isdigit(xxx))
868
enum ftype {f_object,f_fixnum};
871
/* ...xx|xx|xxxx|xxxx|
874
/* a9a8a7a6a5a4a3a4a3a2a1a0rrrrnnnnnnnn
875
ai=argtype(i) ret nargs
877
#define SFUN_NARGS(x) (x & 0xff) /* 8 bits */
878
#define RESTYPE(x) (x<<8) /* 3 bits */
879
/* set if the VFUN_NARGS = m ; has been set correctly */
880
#define VFUN_NARG_BIT (1 <<11)
881
#define ARGTYPE(i,x) ((x) <<(12+(i*2)))
882
#define ARGTYPE1(x) (1 | ARGTYPE(0,x))
883
#define ARGTYPE2(x,y) (2 | ARGTYPE(0,x) | ARGTYPE(1,y))
884
#define ARGTYPE3(x,y,z) (3 | ARGTYPE(0,x) | ARGTYPE(1,y) | ARGTYPE(2,z))
886
object make_si_sfun();
887
EXTER object MVloc[10];
889
/* Set new to be an (object *) whose [i]'th elmt is the
890
ith elmnt in a va_list
892
((vl[0] == va_arg(ap,object)) ||
893
(vl[1] == va_arg(ap,object)) || .. vl[n-1] == va_arg(ap,object))
895
#define DONT_COPY_VA_LIST
896
In recent versions of gcc, i think the builtin_alist stuff does not
899
#ifdef DONT_COPY_VA_LIST
900
#define COERCE_VA_LIST(new,vl,n) new = (object *) (vl)
902
#define COERCE_VA_LIST(new,vl,n) \
906
if (n >= 65) FEerror("Too plong vl"); \
907
for (i=0 ; i < (n); i++) new[i]=va_arg(vl,object);}
909
#define make_si_vfun(s,f,min,max) \
910
make_si_vfun1(s,f,min | (max << 8))
912
/* Number of args supplied to a variable arg t_vfun
913
Used by the C function to set optionals */
915
struct call_data { object fun;
919
double double_return;
921
EXTER struct call_data fcall;
923
#define VFUN_NARGS fcall.argd
924
#define RETURN2(x,y) do{object _x = (void *) x; \
925
fcall.values[2]=y;fcall.nvalues=2; \
926
return (x) ;} while(0)
927
#define RETURN1(x) do{fcall.nvalues=1; return (x) ;} while(0)
928
#define RETURN0 do{fcall.nvalues=0; return Cnil ;} while(0)
930
#define RV(x) (*_p++ = x)
932
#define RETURNI(n,val1,listvals) RETURN(n,int,val1,listvals)
933
#define RETURNO(n,val1,listvals) RETURN(n,object,val1,listvals)
935
/* eg: RETURN(3,object,val1,(RV(val2),RV(val3))) */
936
#define RETURN(n,typ,val1,listvals) \
937
do{typ _val1 = val1; object *_p=&fcall.values[1]; listvals; fcall.nvalues= n; return _val1;}while(0)
938
/* #define CALL(n,form) (VFUN_NARGS=n,form) */
942
/* we sometimes have to touch the header of arrays or structures
943
to make sure the page is writable */
945
#define SGC_TOUCH(x) if ((x)->d.m) system_error(); (x)->d.m=0
950
object funcall_cfun();
951
object clear_compiler_properties();
952
EXTER object sSlambda_block_expanded;
956
{if (!(ex)){(void)fprintf(stderr, \
957
"Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);exit(1);}}
962
#ifndef FIX_PATH_STRING
963
#define FIX_PATH_STRING(file) file
967
#define CHECK_INTERRUPT if (signals_pending) raise_pending_signals(sig_safe)
969
#define BEGIN_NO_INTERRUPT \
970
plong old_signals_allowed = signals_allowed; \
973
#define END_NO_INTERRUPT \
974
signals_allowed = old_signals_allowed
975
/* could add: if (signals_pending)
976
raise_pending_signals(sig_use_signals_allowed_value) */
979
#define END_NO_INTERRUPT_SAFE \
980
signals_allowed = old_signals_allowed; \
981
if (signals_pending) \
982
do{ if(signals_allowed ==0) /* should not get here*/abort(); \
983
raise_pending_signals(sig_safe)}while(0)
985
void raise_pending_signals();
987
EXTER unsigned plong signals_allowed, signals_pending ;
added
removed
h/object.h
