/* 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)

/* 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))

/* 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
#ifdef JGC
#define FIXNUM	4
#define FLONUM	5
#define STRING	6
#define STREAM	7
#define CHAR	8
#define USTREAM 9
#define ARRAY	16		/* arrayed types */
#define SYMBOL	(ARRAY+1)
#define OBJECT	(ARRAY+2)
#define VECTOR	(ARRAY+3)
#define CLOSURE (ARRAY+4)
#ifdef STRUCTS
#define STRUCT	(ARRAY+5)
#endif
#define TYPEFIELD 0x1f
#else
#define SYMBOL	4
#define FIXNUM	5
#define FLONUM	6
#define STRING	7
#define OBJECT	8
#define STREAM	9
#define VECTOR	10
#define CLOSURE 11
#define CHAR	12
#define USTREAM 13
#ifdef STRUCTS
#define STRUCT	14
#endif
#endif
/* 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
#ifdef BETTERIO
#define S_READING		1
#define S_WRITING		2
#define n_sflags		n_info.n_xstream.xs_flags
#endif

/* vector/object node */
#define n_vsize			n_info.n_xvector.xv_size
#define n_vdata			n_info.n_xvector.xv_data

/* node structure */
typedef struct node {
#ifndef __HIGHC__
	char n_type;				/* type of node */
#ifndef JGC
	char n_flags;				/* flag bits */
#endif
#endif
	union ninfo {				/* value */
		struct xsubr {			/* subr/fsubr node */
#ifdef ANSI
			struct node *(*xs_subr)(void);	/* function pointer */
#else
			struct node *(*xs_subr)();	/* function pointer */
#endif
			int xs_offset;				/* offset into funtab */
		} 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;
		struct xstring {		/* string node */
			int xs_length;				/* string length */
			char *xs_string;			/* string pointer */
		} n_xstring;
		struct xstream {		/* stream node */
			FILE *xs_fp;				/* the file pointer */
#ifdef BETTERIO
			char xs_savech;
			char xs_flags;
#else
			int xs_savech;				/* lookahead character */
#endif
		} n_xstream;
		struct xvector {		/* vector/object/symbol/structure node */
			int xv_size;				/* vector size */
			struct node **xv_data;		/* vector data */
		} n_xvector;
	} n_info;
#ifdef __HIGHC__
	char n_type;				/* type of node */
#ifndef JGC
	char n_flags;				/* flag bits */
#endif
#endif
} *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
extern void gc(void);				/* do a garbage collect */
extern SEGMENT *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 *str);	/* convert a string */
extern LVAL cvfile(FILE *fp);		/* convert a FILE * 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 */

extern LVAL newstring(int size);	/* create a new string */
extern LVAL newvector(int 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 */
#ifdef STRUCTS
extern LVAL newstruct(LVAL type, int size);	/* create a new structure */
#endif
#else
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 FILE * 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 */

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 */
#ifdef STRUCTS
extern LVAL newstruct();		/* create a new structure */
#endif
#endif

#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)))

#define cvchar(c) ((_tint = c), \
				((_tint >= CHARMIN && _tint <= CHARMAX) ? \
						&charseg->sg_nodes[_tint-CHARMIN] : \
				Cvchar(_tint)))

#endif