+/* -[Sun Jun 19 14:42:59 1983 by jkf]-
+ * global.h $Locker: $
+ * main include file
+ *
+ * $Header: global.h,v 1.11 85/03/24 11:06:11 sklower Exp $
+ *
+ * (c) copyright 1982, Regents of the University of California
+ */
+
+
+#include <stdio.h>
+#include "config.h"
+#include "ltypes.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 STRBLEN 512
+#define LBPG 512
+
+
+#define NULL_CHAR 0
+#define LF '\n'
+#define WILDCHR '\0177'
+
+
+/* the numbers per page of the different data objects *******************/
+
+#define NUMSPACES (VECTORI+1)
+
+#define ATOMSPP 25
+#define STRSPP 1
+#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
+#define VECTORSPP 512
+
+/* offset of size info from beginning of vector, in longwords */
+/* these values are not valid when a vector is stored in the free */
+/* list, in which case the chaining is done through the propery field */
+#define VSizeOff -2
+#define VPropOff -1
+
+/* VecTotSize: the total number of longwords for the data segment of
+ * the vector. Takes a byte count and rounds up to nearest long.
+ */
+
+#define VecTotSize(x) (((x)+3) >> 2)
+#define VecTotToByte(x) ((x) * sizeof(long))
+
+/* these vector size macros determine the number of complete objects
+ in the vector
+ */
+#define VecSize(x) ((x) >> 2)
+#define VecWordSize(x) ((x) >> 1)
+#define VecByteSize(x) (x)
+
+/* maximum and minimum fixnums */
+#define MaxINT 0x3fffffff
+#define MinINT (- 0x4000000)
+/*
+ * macros for saving state and restoring state
+ *
+ * Savestack and Restorestack are required at the beginning and end of
+ * functions which modify the stack pointers np and lbot.
+ * The Savestack(n) should appear at the end of the variable declarations
+ * The n refers to the number of register variables declared in this routine.
+ * The information is required for the Vax version only.
+ */
+#ifdef PORTABLE
+extern struct atom nilatom, eofatom;
+#define nil ((lispval) &nilatom)
+#define eofa ((lispval) &eofatom)
+#define Savestack(n) struct argent *OLDlbot = lbot, *OLDnp = np
+#define Restorestack() (lbot = OLDlbot), np = OLDnp
+#else
+#define nil ((lispval) 0)
+#define eofa ((lispval) 20)
+#define Savestack(n) snpand(n)
+#define Restorestack()
+#endif
+
+#ifdef SIXONLY
+#define errorh1 errh1
+#define errorh2 errh2
+#endif
+
+#define CNIL ((lispval) (OFFSET-4))
+#define NOTNIL(a) (nil!=a)
+#define ISNIL(a) (nil==a)
+
+#ifdef SPISFP
+extern long *xsp, xstack[];
+#define sp() xsp
+#define stack(z) (xsp > xstack ? (*--xsp = z): xserr())
+#define unstack() (*xsp++)
+#define Keepxs() long *oxsp = xsp;
+#define Freexs() xsp = oxsp;
+#else
+extern long *sp(), stack(), unstack();
+#define Keepxs() /* */
+#define Freexs() /* */
+#endif
+
+extern char typetable[]; /* the table with types for each page */
+#define ATOX(a1) ((((int)(a1)) - OFFSET) >> 9)
+#define TYPE(a1) ((typetable+1)[ATOX(a1)])
+#define TYPL(a1) ((typetable+1)[ATOX(a1)])
+#define SETTYPE(a1,b,c) {if((itemp = ATOX(a1)) >= fakettsize) \
+ { if(fakettsize >= TTSIZE) \
+ {\
+ printf(" all space exausted, goodbye\n");\
+ exit(1);\
+ }\
+ fakettsize++; badmem(c);\
+ }\
+ (typetable + 1)[itemp] = (b); }
+
+#define HUNKP(a1) ((TYPE(a1) >= 11) & (TYPE(a1) <= 17))
+#define HUNKSIZE(a1) ((TYPE(a1)+5) & 15)
+
+#define UPTR(x) ((unsigned)(((long)(x))-(long)CNIL))
+#define VALID(a) (UPTR(a) <= UPTR(datalim))
+
+#define Popframe() (errp->olderrp)
+
+
+/* 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 (*start)(); /* 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];
+};
+
+struct Vector {
+ lispval vector[1];
+};
+
+/* the vectori types */
+struct Vectorb {
+ char vectorb[1];
+};
+
+struct Vectorw {
+ short vectorw[1];
+};
+
+struct Vectorl {
+ long vectorl[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;
+ struct Vector v;
+ struct Vectorb vb;
+ struct Vectorw vw;
+ struct Vectorl vl;
+};
+
+#ifdef lint
+extern lispval Inewint();
+#define inewint(p) Inewint((long)(p))
+#else
+extern lispval inewint();
+#endif
+
+
+#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 */
+
+#ifndef RTPORTS
+extern FILE *xports[]; /* page of file *'s for lisp */
+#define P(p) ((lispval) (xports +((p)-_iob)))
+#define PN(p) ((int) ((p)-_iob))
+#else
+extern lispval P();
+extern FILE **xports;
+#define PN(p) (((FILE **)P(p))-xports)
+#endif
+
+extern int lineleng ; /* line length desired */
+extern char rbktf; /* logical flag: ] mode */
+extern unsigned 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];
+
+extern lispval Vprintsym;
+
+#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
+#define ST_GCSTR 11
+
+
+/* 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;
+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 lispval lispretval; /* used by non-local go */
+extern int rsetsw; /* used by *rset mode */
+extern int evalhcallsw; /* used by evalhook */
+extern int funhcallsw; /* used by evalhook */
+
+
+/* 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;}
+
+/* PUSHVAL is used to store a specific atom and value on the
+ * bindstack. Currently only used by closure code
+ */
+#define PUSHVAL(atom,value)\
+ {bnp->atm=(atom);bnp++->val=value;\
+ if(bnp>bnplim) binderr();}
+
+/** 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 */
+extern long Fixzero[];
+#define SMALL(i) ((lispval)(Fixzero + i))
+#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")
projects / unix-history / commitdiff