[unix-history] / usr / src / cmd / lisp / h / global.h

/* sccs id  @(#)global.h	34.4  10/22/80  */

/**********************************************************************/
/*                                                                    */
/*   file: global.h						      */
/*   contents:							      */
/* GLOBAL STUFF *******************************************************/

#include <stdio.h>
#include <pagsiz.h>
#include "config.h"
#ifdef UNIXTS
#include "tsfix.h"
#endif

#define AD 0

#define	peekc(p)	(p->_cnt>0? *(p)->_ptr&0377:_filbuf(p)==-1?-1:((p)->_cnt++,*--(p)->_ptr&0377))

#define FALSE	0
#define	TRUE	1
#define EVER	;;
#define	CNIL	((lispval) -4)
#define nil	((lispval) 0)
#define eofa	((lispval) 20)
#define NOTNIL(a)	((int)a)
#define ISNIL(a)	(!(int)a)
#define STRBLEN 512


#define	NULL_CHAR	0
#define	LF	'\n'
#define	WILDCHR	'\0177'


/* type flags and the macros to get them ********************************/

#define	UNBO	-1
#define	STRNG	0
#define	ATOM	1
#define	INT	2
#define	DTPR	3
#define DOUB	4
#define	BCD	5
#define	PORT	6
#define	ARRAY	7
#define SDOT	9
#define VALUE	10

#define HUNK2	11		/* The hunks */
#define HUNK4	12
#define HUNK8	13
#define HUNK16	14
#define HUNK32	15
#define HUNK64	16
#define HUNK128	17

/* the numbers per page of the different data objects *******************/

#define NUMSPACES 16

#define ATOMSPP 25
#define STRSPP NBPG
#define INTSPP 128
#define DTPRSPP 64
#define DOUBSPP 64
#define ARRAYSPP 25
#define SDOTSPP 64
#define VALSPP 128
#define BCDSPP 64

#define HUNK2SPP 64		 /* hunk page sizes */
#define HUNK4SPP 32
#define HUNK8SPP 16
#define HUNK16SPP 8
#define HUNK32SPP 4
#define HUNK64SPP 2
#define HUNK128SPP 1

extern char typetable[];  /*  the table with types for each page  */

#define TYPL(a1)	((typetable+1)[(int)(a1) >> 9])
#define SETTYPE(a1,b)   {if((itemp = ((int)a1) >> 9) >= TTSIZE) badmem();\
			(typetable + 1)[itemp] = (b); }

#define	TYPE(a1)	((typetable+1)[(int)(a1) >> 9])
#define	HUNKP(a1)	((TYPE(a1)+5) & 16)
#define	HUNKSIZE(a1)	((TYPE(a1)+5) & 15)

#define VALID(a)	(a >= CNIL && a < datalim)

/* some types ***********************************************************/
#define lispint long
#define MAX10LNG 200000000		/* max long divided by 10	*/


typedef union lispobj *lispval ;

struct dtpr {
	lispval	cdr, car;
};

struct sdot {
	int 	I;
	lispval	CDR;
};


struct	atom	{
	lispval		clb;		/* current level binding*/
	lispval 	plist;		/* pointer to prop list	*/
#ifndef WILD
	lispval		fnbnd;		/* function binding	*/
#endif
	struct	atom	*hshlnk;	/* hash link to next	*/
	char		*pname;		/* print name	*/
	};
#ifdef WILD
#define fnbnd clb
#endif

struct array {
	lispval accfun,		/*  access function--may be anything  */
		aux;		/*  slot for dimensions or auxilliary data  */
	char *data;		/*  pointer to first byte of array    */
	lispval length, delta;	/* length in items and length of one item */
};

struct bfun {
	lispval (*entry)();	/*  entry point to routine  */
	lispval	discipline,	/*  argument-passing discipline  */
		language,	/*  language coded in	*/
		params,		/*  parameter list if relevant  */
		loctab;		/*  local table  */
};

struct Hunk {
	lispval hunk[1];
};

union lispobj {
	struct atom a;
	FILE *p;
	struct dtpr d;
	long int i;
	long int *j;
	double r;
	lispval (*f)();
	struct array ar;
	struct sdot s;
	char c;
	lispval l;
	struct bfun bcd;
	struct Hunk h;
};


#include "sigtab.h"   /* table of all pointers to lisp data */

/* Port definitions *****************************************************/
extern FILE	*piport,		/* standard input port		*/
	*poport,		/* standard output port		*/
	*errport,		/* port for error messages	*/
	*rdrport;		/* temporary port for readr	*/
extern FILE *xports[];		/* page of file *'s for lisp	*/
extern int lineleng ;		/* line length desired		*/
extern char rbktf;		/* logical flag: ] mode		*/
extern char *ctable;		/* Character table in current use */
#define Xdqc ctable[131]
#define Xesc ctable[130]
#define Xsdc ctable[129]

/* name stack ***********************************************************/

#define NAMESIZE 3072

/* the name stack limit is raised by NAMINC every namestack overflow to allow
   a user function to handle the error
*/
#define NAMINC 25

extern struct nament {
	lispval	val,
		atm;
}	*bnp,			/* first free bind entry*/
	*bnplim;		/* limit of bindstack   */

struct argent {
	lispval	val;
};
extern struct argent *lbot, *np, *namptr;
extern struct nament	*bnp;			/* first free bind entry*/
extern struct argent *nplim;	 	/* don't have this = np	*/
extern struct argent *orgnp;	/* used by top level to reset to start  */
extern struct nament *orgbnp;	/* used by top level to reset to start  */
extern struct nament *bnplim;		/* limit of bindstack   */
extern struct argent	*np,			/* top entry on stack	*/
		*lbot,			/* bottom of cur frame	*/
		*namptr;		/* temporary pointer	*/
extern lispval sigacts[16];
extern lispval hunk_pages[7], hunk_items[7], hunk_name[7];

#define TNP	if(np >= nplim) namerr();

#define TNP	if(np >= nplim) namerr();
#define INRNP	if (np++ >= nplim) namerr();
#define protect(p) (np++->val = (p))
#define chkarg(p,x); if((p)!=np-lbot) argerr(x);


/** status codes **********************************************/
/*							      */
/* these define how status and sstatus should service probes  */
/* into the lisp data base				      */

/* common status codes */
#define ST_NO 0

/* status codes */
#define ST_READ 1
#define ST_FEATR 2
#define ST_SYNT 3
#define ST_RINTB 4
#define ST_NFETR 5
#define ST_DMPR  6
#define ST_CTIM  7
#define ST_LOCT  8
#define ST_ISTTY 9
#define ST_UNDEF 10

/* sstatus codes */
#define ST_SET 1
#define ST_FEATW 2
#define ST_TOLC 3
#define ST_CORE 4
#define ST_INTB 5
#define ST_NFETW 6
#define ST_DMPW  7
#define ST_AUTR 8
#define ST_TRAN 9
#define ST_BCDTR 10


/* number of counters for fasl to use in a profiling lisp  */
#define NMCOUNT 5000

/* hashing things *******************************************************/
#define	HASHTOP	1024	/*  we handle 8-bit characters by dropping top bit  */
extern struct	atom	*hasht[HASHTOP];
extern int	hash;		/* set by ratom		*/
extern int	atmlen;		/* length of atom including final null	*/


/** exception handling ***********************************************/
extern int exception;	/* if TRUE then an exception is pending, one of */
			/* the below 				        */
extern int sigintcnt;   /* if > 0 then there is a SIGINT pending	*/

/* big string buffer for whomever needs it ******************************/
extern char	strbuf[STRBLEN];
extern char	*endstrb;

/* break and error declarations *****************************************/
#define	SAVSIZE	44		/* number of bytes saved by setexit	*/
#define	BRRETB	1
#define BRCONT	2
#define	BRGOTO	3
#define	BRRETN	4
#define INTERRUPT 5
#define THROW	6
extern int	depth;		/* depth of nested breaks		*/
extern lispval	contval;	/* the value being returned up		*/
extern int	retval;		/* used by each error/prog call		*/
extern int	rsetsw;		/* used by *rset mode			*/


/* other stuff **********************************************************/
extern lispval	ftemp,vtemp,argptr,ttemp;	/* temporaries: use briefly  */
extern int itemp;
					/* for pointer type conversion  */
#include	"dfuncs.h"

#define	NUMBERP	2
#define	BCDP	5
#define	PORTP	6
#define ARRAYP	7

#define	ABSVAL	0
#define	MINUS	1
#define	ADD1	2
#define	SUB1	3
#define	NOT	4
#define	LNILL	5
#define	ZEROP	6
#define	ONEP	7
#define	PLUS	8
#define	TIMES	9
#define	DIFFERENCE	10
#define	QUOTIENT	11
#define	MOD	12
#define	LESSP	13
#define	GREATERP	14
#define	SUM	15
#define	PRODUCT	16
#define	AND	17
#define	OR	18
#define	XOR	19

interpt();
handler();  extern sigdelay, sigstruck;

/* limit of valid data area **************************************/

extern lispval datalim;

/** macros to push and pop the value of an atom on the stack ******/

#define PUSHDOWN(atom,value)\
	{bnp->atm=(atom);bnp++->val=(atom)->a.clb;(atom)->a.clb=value;\
	if(bnp>bnplim) binderr();}

#define POP\
	{--bnp;bnp->atm->a.clb=bnp->val;}

/** macro for evaluating atoms in eval and interpreter  ***********/

#define EVALATOM(x)	vtemp = x->a.clb;\
			if( vtemp == CNIL ) {\
				printf("%s: ",(x)->a.pname);\
				vtemp = error("UNBOUND VARIABLE",TRUE);}

/*  having to do with small integers					*/

#define SMALL(i)	((lispval)(1024 + (i<<2)))
#define P(p)		((lispval) (xports +((p)-_iob)))
#define PN(p)		((int) ((p)-_iob))
#define okport(arg,default) (vtemp = arg,((TYPE((vtemp))!=PORT)?default:(vtemp)->p))

extern lispval ioname[];	/* names of open files */
/*  interpreter globals   */

extern int lctrace;

/* register lisp macros for registers */

#define saveonly(n)	asm("#save	n")
#define snpand(n)	asm("#protect	n")
Commit	Line	Data
31cef89c	1	/* sccs id @(#)global.h 34.4 10/22/80 */
d9a8b75b JF	2
	3	/**********************************************************************/
	4	/* */
	5	/* file: global.h */
	6	/* contents: */
	7	/* GLOBAL STUFF *******************************************************/
	8
31cef89c BJ	9	#include <stdio.h>
	10	#include <pagsiz.h>
	11	#include "config.h"
	12	#ifdef UNIXTS
	13	#include "tsfix.h"
	14	#endif
	15
	16	#define AD 0
	17
	18	#define peekc(p) (p->_cnt>0? (p)->_ptr&0377:_filbuf(p)==-1?-1:((p)->_cnt++,--(p)->_ptr&0377))
d9a8b75b JF	19
	20	#define FALSE 0
	21	#define TRUE 1
	22	#define EVER ;;
d9a8b75b JF	23	#define CNIL ((lispval) -4)
	24	#define nil ((lispval) 0)
	25	#define eofa ((lispval) 20)
	26	#define NOTNIL(a) ((int)a)
	27	#define ISNIL(a) (!(int)a)
31cef89c	28	#define STRBLEN 512
d9a8b75b JF	29
	30
	31	#define NULL_CHAR 0
	32	#define LF '\n'
	33	#define WILDCHR '\0177'
	34
	35
	36	/* type flags and the macros to get them ********************************/
	37
	38	#define UNBO -1
	39	#define STRNG 0
	40	#define ATOM 1
	41	#define INT 2
	42	#define DTPR 3
	43	#define DOUB 4
	44	#define BCD 5
	45	#define PORT 6
	46	#define ARRAY 7
	47	#define SDOT 9
	48	#define VALUE 10
	49
31cef89c BJ	50	#define HUNK2 11 /* The hunks */
	51	#define HUNK4 12
	52	#define HUNK8 13
	53	#define HUNK16 14
	54	#define HUNK32 15
	55	#define HUNK64 16
	56	#define HUNK128 17
	57
d9a8b75b	58	/* the numbers per page of the different data objects *******************/
31cef89c BJ	59
	60	#define NUMSPACES 16
	61
d9a8b75b JF	62	#define ATOMSPP 25
	63	#define STRSPP NBPG
	64	#define INTSPP 128
	65	#define DTPRSPP 64
	66	#define DOUBSPP 64
	67	#define ARRAYSPP 25
	68	#define SDOTSPP 64
	69	#define VALSPP 128
	70	#define BCDSPP 64
	71
31cef89c BJ	72	#define HUNK2SPP 64 /* hunk page sizes */
	73	#define HUNK4SPP 32
	74	#define HUNK8SPP 16
	75	#define HUNK16SPP 8
	76	#define HUNK32SPP 4
	77	#define HUNK64SPP 2
	78	#define HUNK128SPP 1
d9a8b75b	79
31cef89c	80	extern char typetable[]; /* the table with types for each page */
d9a8b75b	81
31cef89c BJ	82	#define TYPL(a1) ((typetable+1)[(int)(a1) >> 9])
	83	#define SETTYPE(a1,b) {if((itemp = ((int)a1) >> 9) >= TTSIZE) badmem();\
	84	(typetable + 1)[itemp] = (b); }
d9a8b75b	85
31cef89c BJ	86	#define TYPE(a1) ((typetable+1)[(int)(a1) >> 9])
	87	#define HUNKP(a1) ((TYPE(a1)+5) & 16)
	88	#define HUNKSIZE(a1) ((TYPE(a1)+5) & 15)
d9a8b75b JF	89
	90	#define VALID(a) (a >= CNIL && a < datalim)
	91
	92	/* some types ***********************************************************/
	93	#define lispint long
	94	#define MAX10LNG 200000000 /* max long divided by 10 */
	95
	96
	97	typedef union lispobj *lispval ;
31cef89c BJ	98
	99	struct dtpr {
	100	lispval cdr, car;
	101	};
	102
d9a8b75b JF	103	struct sdot {
	104	int I;
	105	lispval CDR;
	106	};
	107
	108
	109	struct atom {
	110	lispval clb; /* current level binding*/
	111	lispval plist; /* pointer to prop list */
	112	#ifndef WILD
	113	lispval fnbnd; /* function binding */
	114	#endif
	115	struct atom hshlnk; / hash link to next */
	116	char pname; / print name */
	117	};
	118	#ifdef WILD
	119	#define fnbnd clb
	120	#endif
	121
	122	struct array {
	123	lispval accfun, /* access function--may be anything */
	124	aux; /* slot for dimensions or auxilliary data */
	125	char data; / pointer to first byte of array */
	126	lispval length, delta; /* length in items and length of one item */
	127	};
	128
	129	struct bfun {
	130	lispval (entry)(); / entry point to routine */
	131	lispval discipline, /* argument-passing discipline */
	132	language, /* language coded in */
	133	params, /* parameter list if relevant */
	134	loctab; /* local table */
31cef89c BJ	135	};
	136
	137	struct Hunk {
	138	lispval hunk[1];
	139	};
d9a8b75b JF	140
	141	union lispobj {
	142	struct atom a;
	143	FILE *p;
	144	struct dtpr d;
	145	long int i;
	146	long int *j;
	147	double r;
	148	lispval (*f)();
	149	struct array ar;
	150	struct sdot s;
	151	char c;
	152	lispval l;
	153	struct bfun bcd;
31cef89c	154	struct Hunk h;
d9a8b75b JF	155	};
	156
	157
	158	#include "sigtab.h" /* table of all pointers to lisp data */
	159
	160	/* Port definitions *****************************************************/
	161	extern FILE piport, / standard input port */
	162	poport, / standard output port */
	163	errport, / port for error messages */
	164	rdrport; / temporary port for readr */
	165	extern FILE xports[]; / page of file 's for lisp /
	166	extern int lineleng ; /* line length desired */
	167	extern char rbktf; /* logical flag: ] mode */
	168	extern char ctable; / Character table in current use */
	169	#define Xdqc ctable[131]
	170	#define Xesc ctable[130]
	171	#define Xsdc ctable[129]
	172
	173	/* name stack ***********************************************************/
	174
31cef89c BJ	175	#define NAMESIZE 3072
	176
	177	/* the name stack limit is raised by NAMINC every namestack overflow to allow
	178	a user function to handle the error
	179	*/
	180	#define NAMINC 25
d9a8b75b	181
31cef89c	182	extern struct nament {
d9a8b75b JF	183	lispval val,
	184	atm;
	185	} bnp, / first free bind entry*/
	186	bnplim; / limit of bindstack */
	187
31cef89c	188	struct argent {
d9a8b75b	189	lispval val;
31cef89c BJ	190	};
	191	extern struct argent lbot, np, *namptr;
	192	extern struct nament bnp; / first free bind entry*/
	193	extern struct argent nplim; / don't have this = np */
	194	extern struct argent orgnp; / used by top level to reset to start */
	195	extern struct nament orgbnp; / used by top level to reset to start */
	196	extern struct nament bnplim; / limit of bindstack */
	197	extern struct argent np, / top entry on stack */
	198	lbot, / bottom of cur frame */
	199	namptr; / temporary pointer */
	200	extern lispval sigacts[16];
	201	extern lispval hunk_pages[7], hunk_items[7], hunk_name[7];
d9a8b75b JF	202
d9a8b75b JF	203	#define TNP if(np >= nplim) namerr();
d9a8b75b	204
31cef89c BJ	205	#define TNP if(np >= nplim) namerr();
	206	#define INRNP if (np++ >= nplim) namerr();
	207	#define protect(p) (np++->val = (p))
	208	#define chkarg(p,x); if((p)!=np-lbot) argerr(x);
d9a8b75b JF	209
	210
	211	/ status codes ********************************************/
	212	/* */
	213	/* these define how status and sstatus should service probes */
	214	/* into the lisp data base */
	215
	216	/* common status codes */
	217	#define ST_NO 0
	218
	219	/* status codes */
	220	#define ST_READ 1
	221	#define ST_FEATR 2
	222	#define ST_SYNT 3
	223	#define ST_RINTB 4
	224	#define ST_NFETR 5
	225	#define ST_DMPR 6
31cef89c BJ	226	#define ST_CTIM 7
	227	#define ST_LOCT 8
	228	#define ST_ISTTY 9
	229	#define ST_UNDEF 10
d9a8b75b JF	230
	231	/* sstatus codes */
	232	#define ST_SET 1
	233	#define ST_FEATW 2
	234	#define ST_TOLC 3
	235	#define ST_CORE 4
	236	#define ST_INTB 5
	237	#define ST_NFETW 6
	238	#define ST_DMPW 7
31cef89c BJ	239	#define ST_AUTR 8
	240	#define ST_TRAN 9
	241	#define ST_BCDTR 10
d9a8b75b JF	242
d9a8b75b JF	243
31cef89c BJ	244	/* number of counters for fasl to use in a profiling lisp */
31cef89c BJ	245	#define NMCOUNT 5000
d9a8b75b JF	246
d9a8b75b JF	247	/* hashing things *******************************************************/
31cef89c	248	#define HASHTOP 1024 /* we handle 8-bit characters by dropping top bit */
d9a8b75b JF	249	extern struct atom *hasht[HASHTOP];
	250	extern int hash; /* set by ratom */
	251	extern int atmlen; /* length of atom including final null */
	252
	253
31cef89c BJ	254	/ exception handling *********************************************/
	255	extern int exception; /* if TRUE then an exception is pending, one of */
	256	/* the below */
	257	extern int sigintcnt; /* if > 0 then there is a SIGINT pending */
	258
d9a8b75b JF	259	/* big string buffer for whomever needs it ******************************/
	260	extern char strbuf[STRBLEN];
	261	extern char *endstrb;
	262
	263	/* break and error declarations *****************************************/
31cef89c	264	#define SAVSIZE 44 /* number of bytes saved by setexit */
d9a8b75b JF	265	#define BRRETB 1
	266	#define BRCONT 2
	267	#define BRGOTO 3
	268	#define BRRETN 4
	269	#define INTERRUPT 5
	270	#define THROW 6
	271	extern int depth; /* depth of nested breaks */
	272	extern lispval contval; /* the value being returned up */
	273	extern int retval; /* used by each error/prog call */
31cef89c	274	extern int rsetsw; /* used by rset mode /
d9a8b75b JF	275
	276
	277	/* other stuff **********************************************************/
	278	extern lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */
	279	extern int itemp;
	280	/* for pointer type conversion */
	281	#include "dfuncs.h"
	282
	283	#define NUMBERP 2
	284	#define BCDP 5
	285	#define PORTP 6
	286	#define ARRAYP 7
	287
	288	#define ABSVAL 0
	289	#define MINUS 1
	290	#define ADD1 2
	291	#define SUB1 3
	292	#define NOT 4
	293	#define LNILL 5
	294	#define ZEROP 6
	295	#define ONEP 7
	296	#define PLUS 8
	297	#define TIMES 9
	298	#define DIFFERENCE 10
	299	#define QUOTIENT 11
	300	#define MOD 12
	301	#define LESSP 13
	302	#define GREATERP 14
	303	#define SUM 15
	304	#define PRODUCT 16
	305	#define AND 17
	306	#define OR 18
	307	#define XOR 19
	308
	309	interpt();
31cef89c	310	handler(); extern sigdelay, sigstruck;
d9a8b75b JF	311
	312	/* limit of valid data area **************************************/
	313
	314	extern lispval datalim;
	315
	316	/ macros to push and pop the value of an atom on the stack ****/
	317
	318	#define PUSHDOWN(atom,value)\
31cef89c BJ	319	{bnp->atm=(atom);bnp++->val=(atom)->a.clb;(atom)->a.clb=value;\
31cef89c BJ	320	if(bnp>bnplim) binderr();}
d9a8b75b JF	321
d9a8b75b JF	322	#define POP\
31cef89c	323	{--bnp;bnp->atm->a.clb=bnp->val;}
d9a8b75b JF	324
	325	/ macro for evaluating atoms in eval and interpreter *********/
	326
31cef89c	327	#define EVALATOM(x) vtemp = x->a.clb;\
d9a8b75b	328	if( vtemp == CNIL ) {\
31cef89c	329	printf("%s: ",(x)->a.pname);\
d9a8b75b JF	330	vtemp = error("UNBOUND VARIABLE",TRUE);}
	331
	332	/* having to do with small integers */
	333
	334	#define SMALL(i) ((lispval)(1024 + (i<<2)))
	335	#define P(p) ((lispval) (xports +((p)-_iob)))
31cef89c BJ	336	#define PN(p) ((int) ((p)-_iob))
31cef89c BJ	337	#define okport(arg,default) (vtemp = arg,((TYPE((vtemp))!=PORT)?default:(vtemp)->p))
d9a8b75b	338
31cef89c	339	extern lispval ioname[]; /* names of open files */
d9a8b75b JF	340	/* interpreter globals */
	341
	342	extern int lctrace;
	343
	344	/* register lisp macros for registers */
31cef89c BJ	345
	346	#define saveonly(n) asm("#save n")
	347	#define snpand(n) asm("#protect n")