#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 */
syntax highlighted by Code2HTML, v. 0.9.1