4.4BSD/usr/src/old/lisp/franz/h/global.h
/* -[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")