home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lisp
/
interpre
/
xlispplu
/
sources
/
xldmem.h
< prev
next >
Wrap
C/C++ Source or Header
|
1992-02-03
|
13KB
|
347 lines
/* xldmem.h - dynamic memory definitions */
/* Copyright (c) 1987, by David Michael Betz
All Rights Reserved
Permission is granted for unrestricted non-commercial use */
/* small fixnum range */
#define SFIXMIN (-128)
#define SFIXMAX 255
#define SFIXSIZE 384
/* character range */
#define CHARMIN 0
#define CHARMAX 255
#define CHARSIZE 256
/* new node access macros */
#define ntype(x) ((x)->n_type)
/* cons access macros */
#define car(x) ((x)->n_car)
#define cdr(x) ((x)->n_cdr)
#define rplaca(x,y) ((x)->n_car = (y))
#define rplacd(x,y) ((x)->n_cdr = (y))
/* symbol access macros */
#define getvalue(x) ((x)->n_vdata[0])
#define setvalue(x,v) ((x)->n_vdata[0] = (v))
#define getfunction(x) ((x)->n_vdata[1])
#define setfunction(x,v) ((x)->n_vdata[1] = (v))
#define getplist(x) ((x)->n_vdata[2])
#define setplist(x,v) ((x)->n_vdata[2] = (v))
#define getpname(x) ((x)->n_vdata[3])
#define setpname(x,v) ((x)->n_vdata[3] = (v))
#define SYMSIZE 4
/* closure access macros */
#define getname(x) ((x)->n_vdata[0])
#define setname(x,v) ((x)->n_vdata[0] = (v))
#define gettype(x) ((x)->n_vdata[1])
#define settype(x,v) ((x)->n_vdata[1] = (v))
#define getargs(x) ((x)->n_vdata[2])
#define setargs(x,v) ((x)->n_vdata[2] = (v))
#define getoargs(x) ((x)->n_vdata[3])
#define setoargs(x,v) ((x)->n_vdata[3] = (v))
#define getrest(x) ((x)->n_vdata[4])
#define setrest(x,v) ((x)->n_vdata[4] = (v))
#define getkargs(x) ((x)->n_vdata[5])
#define setkargs(x,v) ((x)->n_vdata[5] = (v))
#define getaargs(x) ((x)->n_vdata[6])
#define setaargs(x,v) ((x)->n_vdata[6] = (v))
#define getbody(x) ((x)->n_vdata[7])
#define setbody(x,v) ((x)->n_vdata[7] = (v))
#define getenvi(x) ((x)->n_vdata[8])
#define setenvi(x,v) ((x)->n_vdata[8] = (v))
#define getfenv(x) ((x)->n_vdata[9])
#define setfenv(x,v) ((x)->n_vdata[9] = (v))
#define getlambda(x) ((x)->n_vdata[10])
#define setlambda(x,v) ((x)->n_vdata[10] = (v))
#define CLOSIZE 11
/* vector access macros */
#define getsize(x) ((x)->n_vsize)
#define getelement(x,i) ((x)->n_vdata[i])
#define setelement(x,i,v) ((x)->n_vdata[i] = (v))
/* object access macros */
#define getclass(x) ((x)->n_vdata[0])
#define getivar(x,i) ((x)->n_vdata[i+1])
#define setivar(x,i,v) ((x)->n_vdata[i+1] = (v))
/* subr/fsubr access macros */
#define getsubr(x) ((x)->n_subr)
#define getoffset(x) ((x)->n_offset)
/* fixnum/flonum/char access macros */
#define getfixnum(x) ((x)->n_fixnum)
#define getflonum(x) ((x)->n_flonum)
#define getchcode(x) ((x)->n_chcode)
#ifdef RATIOS
/* rational number access macros */
#define getnumer(x) ((x)->n_numer)
#define getdenom(x) ((x)->n_denom)
#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 FAR *)((x)->n_string))[i])
#define setstringch(x,i,v) ((x)->n_string[i] = (char)(v))
/* 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) ((x)->n_car)
#define sethead(x,v) ((x)->n_car = (v))
#define gettail(x) ((x)->n_cdr)
#define settail(x,v) ((x)->n_cdr = (v))
/* node types */
#define FREE 0
#define SUBR 1
#define FSUBR 2
#define CONS 3
#define FIXNUM 4
#define FLONUM 5
#define STRING 6
#define STREAM 7
#define CHAR 8
#define USTREAM 9
#ifdef RATIOS
#define RATIO 10
#endif
#define ARRAY 16 /* arrayed types */
#define SYMBOL (ARRAY+1)
#define OBJECT (ARRAY+2)
#define VECTOR (ARRAY+3)
#define CLOSURE (ARRAY+4)
#define STRUCT (ARRAY+5)
#ifdef COMPLX
#define COMPLEX (ARRAY+6)
#endif
#define TYPEFIELD 0x1f
/* subr/fsubr node */
#define n_subr n_info.n_xsubr.xs_subr
#define n_offset n_info.n_xsubr.xs_offset
/* 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 n_sflags n_info.n_xstream.xs_flags
#define n_cpos n_info.n_xstream.xs_cpos
#ifdef RATIOS
/* rational number node */
#define n_numer n_info.n_xratio.xf_numer
#define n_denom n_info.n_xratio.xf_denom
#endif
/* vector/object node */
#define n_vsize n_info.n_xvector.xv_size
#define n_vdata n_info.n_xvector.xv_data
#ifndef ALIGN32
#define n_spflags n_info.n_xvector.xv_flags
#endif
/* node structure */
typedef struct node {
/* 32 bit compilers that pack structures will do better with
these chars at the end */
#ifndef ALIGN32
char n_type; /* type of node */
#endif
union ninfo { /* value */
struct xsubr { /* subr/fsubr node */
#ifdef ANSI
struct node FAR*(*xs_subr)(void); /* function pointer */
#else
struct node FAR*(*xs_subr)(); /* function pointer */
#endif
int xs_offset; /* offset into funtab */
} n_xsubr;
struct xcons { /* cons node */
struct node FAR*xc_car; /* the car pointer */
struct node FAR*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 RATIOS
struct xratio { /* rational number (ratio) node */
FIXTYPE xf_numer, xf_denom; /* numerator and denominator */
} n_xratio;
#endif
struct xstring { /* string node */
unsigned xs_length; /* string length */
char FAR *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 FAR * FAR *xv_data; /* vector data */
#ifndef ALIGN32
char xv_flags; /* constant and special symbol flags */
#endif
} n_xvector;
/* $putpatch.c$: "MODULE_XLDMEM_H_NINFO" */
} n_info;
#ifdef ALIGN32
char n_type; /* type of node */
char n_spflags;
#endif
} FAR *LVAL;
/* memory segment structure definition */
typedef struct segment {
int sg_size;
struct segment FAR *sg_next;
struct node sg_nodes[1];
} SEGMENT;
/* memory allocation functions */
#ifdef ANSI
extern void gc(void); /* do a garbage collect */
extern SEGMENT FAR *newsegment(int n); /* create a new segment */
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 FAR *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 RATIOS
extern LVAL cvratio(FIXTYPE n, FIXTYPE 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 */
#ifdef COMPLX
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);
#endif
extern void defconstant(LVAL sym, LVAL val);
#else /* not ANSI */
extern VOID gc(); /* do a garbage collect */
extern SEGMENT *newsegment(); /* create a new segment */
extern LVAL cons(); /* (cons x y) */
extern LVAL cvsymbol(); /* convert a string to a symbol */
extern LVAL cvstring(); /* convert a string */
extern LVAL cvfile(); /* convert a FILEP to a file */
extern LVAL cvsubr(); /* convert a function to a subr/fsubr */
#ifdef JMAC
extern LVAL Cvfixnum(); /* convert a fixnum */
extern LVAL Cvchar(); /* convert a character */
#else
extern LVAL cvfixnum(); /* convert a fixnum */
extern LVAL cvchar(); /* convert a character */
#endif
extern LVAL cvflonum(); /* convert a flonum */
#ifdef RATIOS
extern LVAL cvratio();
#endif
extern LVAL newstring(); /* create a new string */
extern LVAL newvector(); /* create a new vector */
extern LVAL newobject(); /* create a new object */
extern LVAL newclosure(); /* create a new closure */
extern LVAL newustream(); /* create a new unnamed stream */
extern LVAL newstruct(); /* create a new structure */
#ifdef COMPLX
extern LVAL newcomplex(); /* create a new complex number */
extern LVAL newicomplex();
extern LVAL newdcomplex();
#endif
#endif
#define F_SPECIAL 1
#define F_CONSTANT 2
#define F_NORMAL 0
#define setsvalue(s,v) (setvalue(s,v), setsflags(s, F_SPECIAL))
#define setsflags(x,c) ((x)->n_spflags = (c))
#define constantp(x) ((x)->n_spflags & F_CONSTANT)
#define specialp(x) ((x)->n_spflags & 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 FAR *fixseg, FAR *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
/* $putpatch.c$: "MODULE_XLDMEM_H_GLOBALS" */