#ifndef XLDMEM_H #define XLDMEM_H /* xldmem.h - dynamic memory definitions */ /* Copyright (c) 1989, by David Michael Betz. */ /* You may give out copies of this software; for conditions see the file */ /* COPYING included with this distribution. */ /* small fixnum range */ #ifndef SFIXMIN #define SFIXMIN (-128) #endif #ifndef SFIXMAX #define SFIXMAX 255 #endif #define SFIXSIZE (SFIXMAX-SFIXMIN+1) /* character range */ #define CHARMIN 0 #define CHARMAX 255 #define CHARSIZE (CHARMAX-CHARMIN+1) /* new node access macros */ #define ntype(x) ((x)->n_type) #define setntype(x,t) ((x)->n_type = (t)) /* cons access macros */ #define car(x) ((x)->n_car) #define cdr(x) ((x)->n_cdr) #ifdef NEWGC #define Rplaca(x,y) ((x)->n_car = (y)) #define Rplacd(x,y) ((x)->n_cdr = (y)) #else #define rplaca(x,y) ((x)->n_car = (y)) #define rplacd(x,y) ((x)->n_cdr = (y)) #endif /* NEWGC */ /* symbol access macros */ #define getvalue(x) getelement(x,0) #define setvalue(x,v) setelement(x,0,v) #define getfunction(x) getelement(x,1) #define setfunction(x,v) setelement(x,1,v) #define getplist(x) getelement(x,2) #define setplist(x,v) setelement(x,2,v) #define getpname(x) getelement(x,3) #define setpname(x,v) setelement(x,3,v) #ifdef PACKAGES #define getpackage(x) getelement(x,4) #define setpackage(x,v) setelement(x,4,v) #define SYMSIZE 5 #else #define SYMSIZE 4 #endif /* PACKAGES */ /* closure access macros */ #define getname(x) getelement(x,0) #define setname(x,v) setelement(x,0,v) #define gettype(x) getelement(x,1) #define settype(x,v) setelement(x,1,v) #define getargs(x) getelement(x,2) #define setargs(x,v) setelement(x,2,v) #define getoargs(x) getelement(x,3) #define setoargs(x,v) setelement(x,3,v) #define getrest(x) getelement(x,4) #define setrest(x,v) setelement(x,4,v) #define getkargs(x) getelement(x,5) #define setkargs(x,v) setelement(x,5,v) #define getaargs(x) getelement(x,6) #define setaargs(x,v) setelement(x,6,v) #define getbody(x) getelement(x,7) #define setbody(x,v) setelement(x,7,v) #define getenvi(x) getelement(x,8) #define setenvi(x,v) setelement(x,8,v) #define getfenv(x) getelement(x,9) #define setfenv(x,v) setelement(x,9,v) #define getlambda(x) getelement(x,10) #define setlambda(x,v) setelement(x,10,v) #define CLOSIZE 11 #ifdef BYTECODE #define getbcctype(x) car(x) #define setbcctype(x,v) rplaca(x,v) #define getbcccode(x) cdr(x) #define setbcccode(x,v) rplacd(x,v) #endif /* BYTECODE */ /* vector access macros */ #define getsize(x) ((x)->n_vsize) #define getelement(x,i) ((x)->n_vdata[i]) #ifdef NEWGC #define Setelement(x,i,v) ((x)->n_vdata[i] = (v)) #else #define setelement(x,i,v) ((x)->n_vdata[i] = (v)) #endif /* NEWGC */ /* object access macros */ #define getclass(x) getelement(x,0) #define getivar(x,i) getelement(x,i+1) #define setivar(x,i,v) setelement(x,i+1,v) /* instance variable numbers for the class 'Class' */ #define MESSAGES 0 /* list of messages */ #define IVARS 1 /* list of instance variable names */ #define CVARS 2 /* list of class variable names */ #define CVALS 3 /* list of class variable values */ #define SUPERCLASS 4 /* pointer to the superclass */ #define IVARCNT 5 /* number of class instance variables */ #define IVARTOTAL 6 /* total number of instance variables */ #define PNAME 7 /* print name TAA Mod */ /* number of instance variables for the class 'Class' */ #define CLASSSIZE 8 /* subr/fsubr access macros */ #define getsubr(x) ((x)->n_subr) #define getoffset(x) ((x)->n_offset) #ifdef MULVALS #define mulvalp(x) ((x)->n_mvflag) #define setmulvalp(x, v) ((x)->n_mvflag = (v)) #endif /* MULVALS */ /* fixnum/flonum/char access macros */ #define getfixnum(x) ((x)->n_fixnum) #define getflonum(x) ((x)->n_flonum) #define getchcode(x) ((x)->n_chcode) /* complex number access macros */ #define getreal(x) car(x) #define getimag(x) cdr(x) #ifdef BIGNUMS /* rational number access macros */ #define getnumer(x) car(x) #define getdenom(x) cdr(x) /* bignum access macros */ typedef unsigned short BIGNUMDATA; #define getbignumarray(x) ((x)->n_bdata) #define getbignumsize(x) ((x)->n_bsize) #define getbignumsign(x) ((x)->n_bdata[0]) #endif /* string access macros */ #define getstring(x) ((x)->n_string) #define getslength(x) ((x)->n_strlen) /* the following functions were TAA modifications */ #define getstringch(x,i) (((unsigned char *)((x)->n_string))[i]) #define setstringch(x,i,v) ((x)->n_string[i] = (char)(v)) /* tvec access macros */ #define gettvecdata(x) ((ALLOCTYPE *) getstring(x)) #define gettlength(x) getslength(x) #define gettvectype(x) ((unsigned char *) (gettvecdata(x)))[gettlength(x)] #define settvectype(x,t) \ (((unsigned char *) (gettvecdata(x)))[gettlength(x)] = (unsigned char) (t)) enum { CD_CHARACTER = 0, CD_FIXTYPE, CD_FLOTYPE, CD_CXFIXTYPE, CD_CXFLOTYPE, CD_CHAR, CD_UCHAR, CD_SHORT, CD_INT, CD_LONG, CD_FLOAT, CD_DOUBLE, CD_COMPLEX, CD_DCOMPLEX, CD_TRUE }; /* file stream access macros */ #define getfile(x) ((x)->n_fp) #define setfile(x,v) ((x)->n_fp = (v)) #define getsavech(x) ((x)->n_savech) #define setsavech(x,v) ((x)->n_savech = (v)) /* unnamed stream access macros */ #define gethead(x) car(x) #define sethead(x,v) rplaca(x,v) #define gettail(x) cdr(x) #define settail(x,v) rplacd(x,v) /* displaced array access macros */ #define getdarraydim(x) car(x) #define getdarraydata(x) cdr(x) #define getdarrayrank(x) getsize(getdarraydim(x)) /* random state access macros */ #define getrndgen(x) car(x) #define setrndgen(x,v) rplaca(x,v) #define getrnddata(x) cdr(x) #define setrnddata(x,v) rplacd(x,v) /* allocated data access macros *//* L. Tierney */ #define getadaddr(x) ((x)->n_adaddr) #define getadreloc(x) nuflags(x) #define getadsize(x) (((x)->n_adsize)) #define setadreloc(x,c) setnuflags(x,c) /* native pointers *//* L. Tierney */ /* Use the CONS representation with pointer in the CAR cell */ #define getnpaddr(x) ((ALLOCTYPE *) car(x)) #define setnpaddr(x,v) (car(x) = (LVAL) (v)) #define getnpprot(x) cdr(x) #define setnpprot(x,v) rplacd(x,v) #ifdef BYTECODE /* CPS node macros */ #define getcpstype(x) getelement(x, 0) #define setcpstype(x,v) setelement(x, 0, v) #define CPSNODESIZE 8 /* byte code macros */ #define getbccode(x) getelement(x, 0) #define getbcjtab(x) getelement(x, 1) #define getbclits(x) getelement(x, 2) #define getbcidx(x) getelement(x, 3) #define getbcenv(x) getelement(x, 4) #define getbcname(x) getelement(x, 5) #define getbcdef(x) getelement(x, 6) #define setbccode(x, v) setelement(x, 0, v) #define setbcjtab(x, v) setelement(x, 1, v) #define setbclits(x, v) setelement(x, 2, v) #define setbcidx(x, v) setelement(x, 3, v) #define setbcenv(x, v) setelement(x, 4, v) #define setbcname(x, v) setelement(x, 5, v) #define setbcdef(x, v) setelement(x, 6, v) #define BCODESIZE 7 #endif /* BYTECODE */ #ifdef PACKAGES /* package macros */ #define getintsyms(x) getelement(x, 0) #define getextsyms(x) getelement(x, 1) #define getshadowing(x) getelement(x, 2) #define getuses(x) getelement(x, 3) #define getusedby(x) getelement(x, 4) #define getpacknames(x) getelement(x, 5) #define setintsyms(x,v) setelement(x, 0, v) #define setextsyms(x,v) setelement(x, 1, v) #define setshadowing(x,v) setelement(x, 2, v) #define setuses(x,v) setelement(x, 3, v) #define setusedby(x,v) setelement(x, 4, v) #define setpacknames(x,v) setelement(x, 5, v) #define PACKSIZE 6 #endif /* PACKAGES */ /* node types */ #define FREE 0 #define SUBR 1 #define FSUBR 2 #define FIXNUM 4 #define FLONUM 5 #define STRING 6 #define STREAM 7 #define CHAR 8 #ifdef BIGNUMS #define BIGNUM 9 #endif #define ADATA 10 #define TVEC 11 #define NATPTR 12 /* native pointer */ #define WEAKBOX 13 /* Non-array types from CONS up use CAR and CDR fields */ /* This means that all types from CONS up have garbage collectable elements */ #define CONS 16 #define COMPLEX 17 #ifdef BIGNUMS #define RATIO 18 #endif #define USTREAM 19 #define DARRAY 20 #define RNDSTATE 21 #ifdef BYTECODE #define BCCLOSURE 22 #endif /* BYTECODE */ #define ARRAY 32 /* arrayed types */ #define SYMBOL (ARRAY+1) #define OBJECT (ARRAY+2) #define VECTOR (ARRAY+3) #define CLOSURE (ARRAY+4) #define STRUCT (ARRAY+5) #ifdef BYTECODE #define CPSNODE (ARRAY+6) #define BCODE (ARRAY+7) #endif /* BYTECODE */ #ifdef PACKAGES #define PACKAGE (ARRAY+8) #endif /* PACKAGES */ #define TYPEFIELD 0x3f #ifdef NEWGC #define NUMTYPES (ARRAY+9) #endif /* NEWGC */ /* subr/fsubr node */ #define n_subr n_info.n_xsubr.xs_subr #define n_offset n_info.n_xsubr.xs_offset #define n_mvflag n_info.n_xsubr.xs_mvflag /* cons node */ #define n_car n_info.n_xcons.xc_car #define n_cdr n_info.n_xcons.xc_cdr /* fixnum node */ #define n_fixnum n_info.n_xfixnum.xf_fixnum /* flonum node */ #define n_flonum n_info.n_xflonum.xf_flonum /* character node */ #define n_chcode n_info.n_xchar.xc_chcode /* string node */ #define n_string n_info.n_xstring.xs_string #define n_strlen n_info.n_xstring.xs_length /* stream node */ #define n_fp n_info.n_xstream.xs_fp #define n_savech n_info.n_xstream.xs_savech #define S_READING 1 /* File is in reading mode */ #define S_WRITING 2 /* file is in writing mode */ #define S_FORREADING 4 /* File open for reading */ #define S_FORWRITING 8 /* file open for writing */ #define S_BINARY 16 /* file is binary file */ #define S_UNSIGNED 32 /* file is unsigned binary */ #define n_sflags n_info.n_xstream.xs_flags #define n_cpos n_info.n_xstream.xs_cpos /* position of char file*/ #define n_bsiz n_info.n_xstream.xs_cpos /* byte size of bin file*/ #ifdef BIGNUMS /* bignum node */ #define n_bsize n_info.n_xbignum.xb_length #define n_bdata n_info.n_xbignum.xb_data #endif /* vector/object node */ #define n_vsize n_info.n_xvector.xv_size #define n_vdata n_info.n_xvector.xv_data /* allocated data node *//* L. Tierney */ #define n_adaddr n_info.n_xadata.xa_addr #define n_adsize n_info.n_xadata.xa_size /* node structure */ typedef struct node { #ifdef NEWGC union { struct node *n_next; /* pointer for forwarding list */ struct { short forward; /* next doubly-linked list node offset */ short backward; /* previous doubly-linked list node offset */ } n_gc_offsets; } n_gc; short n_base_offset; /* offset from beginning of segment */ unsigned char n_type; /* type of node */ unsigned char n_flags; /* flag bits */ #else /* 32 bit compilers that pack structures will do better with these chars at the end */ #ifndef ALIGN32 unsigned char n_type; /* type of node */ unsigned char n_flags; /* flag bits */ #endif #endif /* NEWGC */ union ninfo { /* value */ struct xsubr { /* subr/fsubr node */ struct node *(*xs_subr) _((void)); /* function pointer */ short xs_offset; /* offset into funtab */ #ifdef MULVALS unsigned char xs_mvflag; /* multiple value return */ #endif } n_xsubr; struct xcons { /* cons node */ struct node *xc_car; /* the car pointer */ struct node *xc_cdr; /* the cdr pointer */ } n_xcons; struct xfixnum { /* fixnum node */ FIXTYPE xf_fixnum; /* fixnum value */ } n_xfixnum; struct xflonum { /* flonum node */ FLOTYPE xf_flonum; /* flonum value */ } n_xflonum; struct xchar { /* character node */ int xc_chcode; /* character code */ } n_xchar; #ifdef BIGNUMS struct xbignum { /* bignum node */ unsigned xb_length; /* length of data in #BIGNUMDATAs */ BIGNUMDATA *xb_data;/* sign BIGNUMDATA followed by xb_length BIGNUMDATAs */ } n_xbignum; #endif struct xstring { /* string node */ unsigned xs_length; /* string length */ char *xs_string; /* string pointer */ } n_xstring; struct xstream { /* stream node */ FILEP xs_fp; /* the file pointer */ unsigned char xs_savech; /* lookahead character */ char xs_flags; /* read/write mode flags */ short xs_cpos; /* character position in line */ } n_xstream; struct xvector { /* vector/object/symbol/structure node */ int xv_size; /* vector size */ struct node **xv_data; /* vector data */ } n_xvector; #ifdef XLISP_STAT struct xadata { char *xa_addr; long xa_size; } n_xadata; #endif /* XLISP_STAT */ /* $putpatch.c$: "MODULE_XLDMEM_H_NINFO" */ } n_info; #ifndef NEWGC #ifdef ALIGN32 unsigned char n_type; /* type of node */ unsigned char n_flags; #endif /* ALIGN32 */ #endif /* NEWGC */ } *LVAL; /* memory segment structure definition */ typedef struct segment { int sg_size; struct segment *sg_next; struct node sg_nodes[1]; } SEGMENT; /* memory allocation functions */ #ifdef ANSI #define ALLOCTYPE void #else #define ALLOCTYPE char #endif /* ANSI */ extern VOID gc _((void)); /* do a garbage collect */ extern SEGMENT *newsegment _((int n)); /* create a new segment */ extern ALLOCTYPE *VALLOC _((unsigned long)); extern VOID VRELEASE _((ALLOCTYPE *p, unsigned long size)); #ifdef NEWGC extern VOID sweep_free_nodes _((void)); extern VOID initialize_node _((LVAL node)); #endif /* NEWGC */ extern LVAL cons _((LVAL x, LVAL y)); /* (cons x y) */ extern LVAL cvsymbol _((char *pname)); /* convert a string to a symbol */ extern LVAL cvstring _((char *str)); /* convert a string */ extern LVAL cvfile _((FILEP fp, int flags)); /* convert a FILEP to a file */ extern LVAL cvsubr _((LVAL (*fcn) _((void)), int type, int offset)); /* convert a function to a subr/fsubr */ #ifdef JMAC extern LVAL Cvfixnum _((FIXTYPE n)); /* convert a fixnum */ extern LVAL Cvchar _((int n)); /* convert a character */ #else extern LVAL cvfixnum _((FIXTYPE n)); /* convert a fixnum */ extern LVAL cvchar _((int n)); /* convert a character */ #endif extern LVAL cvflonum _((FLOTYPE n)); /* convert a flonum */ #ifdef BIGNUMS extern LVAL cvratio _((FIXTYPE n, FIXTYPE d)); /* convert a ratio */ extern LVAL cvbratio _((LVAL n, LVAL d)); /* convert a ratio */ #endif extern LVAL newstring _((unsigned size)); /* create a new string */ extern LVAL newvector _((unsigned size)); /* create a new vector */ extern LVAL newobject _((LVAL cls, int size)); /* create a new object */ extern LVAL newclosure _((LVAL name, LVAL type, LVAL env, LVAL fenv)); /* create a new closure */ extern LVAL newustream _((void)); /* create a new unnamed stream */ extern LVAL newstruct _((LVAL type, int size)); /* create a new structure */ extern LVAL newcomplex _((LVAL r, LVAL i)); /* create a new complex number */ extern LVAL newicomplex _((FIXTYPE r, FIXTYPE i)); extern LVAL newdcomplex _((FLOTYPE r, FLOTYPE i)); #ifdef BIGNUMS /* most functions are in xlbignum.c */ extern LVAL newbignum _((unsigned size)); extern LVAL cvtflonum _((LVAL num)); /* convert a rational to a float */ #endif extern VOID defconstant _((LVAL sym, LVAL val)); extern LVAL newdarray _((LVAL dim, LVAL data)); /**** put in xldmem.c */ #ifdef XLISP_STAT extern LVAL newadata _((int n, int m, int reloc)); extern VOID reallocaddata _((LVAL val, int n, int m)); extern VOID freeadata _((LVAL val)); #endif /* XLISP_STAT */ extern LVAL newtvec _((int n, int m)); extern LVAL newnatptr _((ALLOCTYPE *p, LVAL v)); extern LVAL newrndstate _((LVAL gen, LVAL m)); extern LVAL newbcclosure _((LVAL type, LVAL code)); #ifdef BYTECODE extern LVAL newcpsnode _((LVAL type)); /* create a new CPS node for compiler */ extern LVAL newbcode _((LVAL code, LVAL jtab, LVAL lits, LVAL idx, LVAL env)); /* create a new byte code vector */ #endif /* BYTECODE */ #ifdef PACKAGES extern LVAL newpackage _((void)); /* create a new package */ #endif /* PACKAGES */ #ifdef NEWGC extern LVAL rplaca _((LVAL x, LVAL y)), rplacd _((LVAL x, LVAL y)); extern LVAL setelement _((LVAL x, int i, LVAL y)); #endif /* NEWGC */ /* node flags access macros */ #ifdef NEWGC #define ngcflag1(x) ((x)->n_flags & 1) #define setngcflag1(x) ((x)->n_flags |= 1) #define unsetngcflag1(x) ((x)->n_flags &= ~1) #define ngcflag2(x) ((x)->n_flags & 2) #define setngcflag2(x) ((x)->n_flags |= 2) #define unsetngcflag2(x) ((x)->n_flags &= ~2) #define nuflags(x) ((x)->n_flags & 4) #define setnuflags(x,t) ((t) ? ((x)->n_flags |= 4) : ((x)->n_flags &= ~4)) #define F_SPECIAL 4 #define F_CONSTANT 8 #define setsnormal(x) ((x)->n_flags &= ~(F_SPECIAL | F_CONSTANT)) #define setsspecial(x) ((x)->n_flags |= F_SPECIAL) #define setsconstant(x) ((x)->n_flags |= (F_SPECIAL | F_CONSTANT)) #define constantp(x) ((x)->n_flags & F_CONSTANT) #define specialp(x) ((x)->n_flags & F_SPECIAL) #else #define F_SPECIAL 1 #define F_CONSTANT 2 #define F_NORMAL 0 #define setsflags(x,c) ((x)->n_flags = (c)) #define setsnormal(x) setsflags(x, F_NORMAL) #define setsspecial(x) setsflags(x, F_SPECIAL) #define setsconstant(x) setsflags(x, F_CONSTANT | F_SPECIAL) #define constantp(x) ((x)->n_flags & F_CONSTANT) #define specialp(x) ((x)->n_flags & F_SPECIAL) #ifdef JMAC /* Speed ups, reduce function calls for fixed characters and numbers */ /* Speed is exeptionaly noticed on machines with a large instruction cache */ /* No size effects here (JonnyG) */ extern SEGMENT *fixseg, *charseg; extern FIXTYPE _tfixed; extern int _tint; #define cvfixnum(n) ((_tfixed = (n)), \ ((_tfixed > SFIXMIN && _tfixed < SFIXMAX) ? \ &fixseg->sg_nodes[(int)_tfixed-SFIXMIN] : \ Cvfixnum(_tfixed))) #if (CHARMIN == 0) /* eliminate a comparison */ #define cvchar(c) ((_tint = (c)), \ (((unsigned)_tint) <= CHARMAX ? \ &charseg->sg_nodes[_tint-CHARMIN] : \ Cvchar(_tint))) #else #define cvchar(c) ((_tint = (c)), \ ((_tint >= CHARMIN && _tint <= CHARMAX) ? \ &charseg->sg_nodes[_tint-CHARMIN] : \ Cvchar(_tint))) #endif #endif #define nuflags(x) ((x)->n_flags) #define setnuflags(x,t) ((x)->n_flags = (t)) #endif /* NEWGC */ #define setsvalue(s,v) (setvalue(s,v), setsspecial(s)) /* $putpatch.c$: "MODULE_XLDMEM_H_GLOBALS" */ #endif /* XLDMEM_H */