|
|
1.1 ! root 1: /* -[Sun Jun 19 14:42:59 1983 by jkf]- ! 2: * global.h $Locker: $ ! 3: * main include file ! 4: * ! 5: * $Header: global.h,v 1.9 83/09/12 15:27:22 sklower Exp $ ! 6: * ! 7: * (c) copyright 1982, Regents of the University of California ! 8: */ ! 9: ! 10: ! 11: #include <stdio.h> ! 12: #include "config.h" ! 13: #include "ltypes.h" ! 14: #ifdef UNIXTS ! 15: #include "tsfix.h" ! 16: #endif ! 17: ! 18: #define AD 0 ! 19: ! 20: #define peekc(p) (p->_cnt>0? *(p)->_ptr&0377:_filbuf(p)==-1?-1:((p)->_cnt++,*--(p)->_ptr&0377)) ! 21: ! 22: #define FALSE 0 ! 23: #define TRUE 1 ! 24: #define EVER ;; ! 25: #define STRBLEN 512 ! 26: #define LBPG 512 ! 27: ! 28: ! 29: #define NULL_CHAR 0 ! 30: #define LF '\n' ! 31: #define WILDCHR '\0177' ! 32: ! 33: ! 34: /* the numbers per page of the different data objects *******************/ ! 35: ! 36: #define NUMSPACES (VECTORI+1) ! 37: ! 38: #define ATOMSPP 25 ! 39: #define STRSPP 1 ! 40: #define INTSPP 128 ! 41: #define DTPRSPP 64 ! 42: #define DOUBSPP 64 ! 43: #define ARRAYSPP 25 ! 44: #define SDOTSPP 64 ! 45: #define VALSPP 128 ! 46: #define BCDSPP 64 ! 47: ! 48: ! 49: #define HUNK2SPP 64 /* hunk page sizes */ ! 50: #define HUNK4SPP 32 ! 51: #define HUNK8SPP 16 ! 52: #define HUNK16SPP 8 ! 53: #define HUNK32SPP 4 ! 54: #define HUNK64SPP 2 ! 55: #define HUNK128SPP 1 ! 56: #define VECTORSPP 512 ! 57: ! 58: /* offset of size info from beginning of vector, in longwords */ ! 59: /* these values are not valid when a vector is stored in the free */ ! 60: /* list, in which case the chaining is done through the propery field */ ! 61: #define VSizeOff -2 ! 62: #define VPropOff -1 ! 63: ! 64: /* VecTotSize: the total number of longwords for the data segment of ! 65: * the vector. Takes a byte count and rounds up to nearest long. ! 66: */ ! 67: ! 68: #define VecTotSize(x) (((x)+3) >> 2) ! 69: #define VecTotToByte(x) ((x) * sizeof(long)) ! 70: ! 71: /* these vector size macros determine the number of complete objects ! 72: in the vector ! 73: */ ! 74: #define VecSize(x) ((x) >> 2) ! 75: #define VecWordSize(x) ((x) >> 1) ! 76: #define VecByteSize(x) (x) ! 77: ! 78: /* maximum and minimum fixnums */ ! 79: #define MaxINT 0x3fffffff ! 80: #define MinINT (- 0x4000000) ! 81: /* ! 82: * macros for saving state and restoring state ! 83: * ! 84: * Savestack and Restorestack are required at the beginning and end of ! 85: * functions which modify the stack pointers np and lbot. ! 86: * The Savestack(n) should appear at the end of the variable declarations ! 87: * The n refers to the number of register variables declared in this routine. ! 88: * The information is required for the Vax version only. ! 89: */ ! 90: #ifdef PORTABLE ! 91: extern struct atom nilatom, eofatom; ! 92: #define nil ((lispval) &nilatom) ! 93: #define eofa ((lispval) &eofatom) ! 94: #define Savestack(n) struct argent *OLDlbot = lbot, *OLDnp = np ! 95: #define Restorestack() (lbot = OLDlbot), np = OLDnp ! 96: #else ! 97: #define nil ((lispval) 0) ! 98: #define eofa ((lispval) 20) ! 99: #define Savestack(n) snpand(n) ! 100: #define Restorestack() ! 101: #endif ! 102: ! 103: #define CNIL ((lispval) (OFFSET-4)) ! 104: #define NOTNIL(a) (nil!=a) ! 105: #define ISNIL(a) (nil==a) ! 106: ! 107: #ifdef SPISFP ! 108: extern long *xsp, xstack[]; ! 109: #define sp() xsp ! 110: #define stack(z) (xsp > xstack ? (*--xsp = z): xserr()) ! 111: #define unstack() (*xsp++) ! 112: #define Keepxs() long *oxsp = xsp; ! 113: #define Freexs() xsp = oxsp; ! 114: #else ! 115: extern long *sp(), stack(), unstack(); ! 116: #define Keepxs() /* */ ! 117: #define Freexs() /* */ ! 118: #endif ! 119: ! 120: extern char typetable[]; /* the table with types for each page */ ! 121: #define ATOX(a1) ((((int)(a1)) - OFFSET) >> 9) ! 122: #define TYPE(a1) ((typetable+1)[ATOX(a1)]) ! 123: #define TYPL(a1) ((typetable+1)[ATOX(a1)]) ! 124: #define SETTYPE(a1,b,c) {if((itemp = ATOX(a1)) >= fakettsize) \ ! 125: { if(fakettsize >= TTSIZE) \ ! 126: {\ ! 127: printf(" all space exausted, goodbye\n");\ ! 128: exit(1);\ ! 129: }\ ! 130: fakettsize++; badmem(c);\ ! 131: }\ ! 132: (typetable + 1)[itemp] = (b); } ! 133: ! 134: #define HUNKP(a1) ((TYPE(a1) >= 11) & (TYPE(a1) <= 17)) ! 135: #define HUNKSIZE(a1) ((TYPE(a1)+5) & 15) ! 136: ! 137: #define VALID(a) (a >= CNIL && a < datalim) ! 138: ! 139: #define Popframe() (errp->olderrp) ! 140: ! 141: ! 142: /* some types ***********************************************************/ ! 143: #define lispint long ! 144: #define MAX10LNG 200000000 /* max long divided by 10 */ ! 145: ! 146: ! 147: typedef union lispobj *lispval ; ! 148: ! 149: struct dtpr { ! 150: lispval cdr, car; ! 151: }; ! 152: ! 153: struct sdot { ! 154: int I; ! 155: lispval CDR; ! 156: }; ! 157: ! 158: ! 159: struct atom { ! 160: lispval clb; /* current level binding*/ ! 161: lispval plist; /* pointer to prop list */ ! 162: #ifndef WILD ! 163: lispval fnbnd; /* function binding */ ! 164: #endif ! 165: struct atom *hshlnk; /* hash link to next */ ! 166: char *pname; /* print name */ ! 167: }; ! 168: #ifdef WILD ! 169: #define fnbnd clb ! 170: #endif ! 171: ! 172: struct array { ! 173: lispval accfun, /* access function--may be anything */ ! 174: aux; /* slot for dimensions or auxilliary data */ ! 175: char *data; /* pointer to first byte of array */ ! 176: lispval length, delta; /* length in items and length of one item */ ! 177: }; ! 178: ! 179: struct bfun { ! 180: lispval (*start)(); /* entry point to routine */ ! 181: lispval discipline, /* argument-passing discipline */ ! 182: language, /* language coded in */ ! 183: params, /* parameter list if relevant */ ! 184: loctab; /* local table */ ! 185: }; ! 186: ! 187: struct Hunk { ! 188: lispval hunk[1]; ! 189: }; ! 190: ! 191: struct Vector { ! 192: lispval vector[1]; ! 193: }; ! 194: ! 195: /* the vectori types */ ! 196: struct Vectorb { ! 197: char vectorb[1]; ! 198: }; ! 199: ! 200: struct Vectorw { ! 201: short vectorw[1]; ! 202: }; ! 203: ! 204: struct Vectorl { ! 205: long vectorl[1]; ! 206: }; ! 207: ! 208: union lispobj { ! 209: struct atom a; ! 210: FILE *p; ! 211: struct dtpr d; ! 212: long int i; ! 213: long int *j; ! 214: double r; ! 215: lispval (*f)(); ! 216: struct array ar; ! 217: struct sdot s; ! 218: char c; ! 219: lispval l; ! 220: struct bfun bcd; ! 221: struct Hunk h; ! 222: struct Vector v; ! 223: struct Vectorb vb; ! 224: struct Vectorw vw; ! 225: struct Vectorl vl; ! 226: }; ! 227: ! 228: #ifdef lint ! 229: extern lispval Inewint(); ! 230: #define inewint(p) Inewint((long)(p)) ! 231: #else ! 232: extern lispval inewint(); ! 233: #endif ! 234: ! 235: ! 236: #include "sigtab.h" /* table of all pointers to lisp data */ ! 237: ! 238: /* Port definitions *****************************************************/ ! 239: extern FILE *piport, /* standard input port */ ! 240: *poport, /* standard output port */ ! 241: *errport, /* port for error messages */ ! 242: *rdrport; /* temporary port for readr */ ! 243: extern FILE *xports[]; /* page of file *'s for lisp */ ! 244: extern int lineleng ; /* line length desired */ ! 245: extern char rbktf; /* logical flag: ] mode */ ! 246: extern unsigned char *ctable; /* Character table in current use */ ! 247: #define Xdqc ctable[131] ! 248: #define Xesc ctable[130] ! 249: #define Xsdc ctable[129] ! 250: ! 251: /* name stack ***********************************************************/ ! 252: ! 253: #define NAMESIZE 3072 ! 254: ! 255: /* the name stack limit is raised by NAMINC every namestack overflow to allow ! 256: a user function to handle the error ! 257: */ ! 258: #define NAMINC 25 ! 259: ! 260: extern struct nament { ! 261: lispval val, ! 262: atm; ! 263: } *bnp, /* first free bind entry*/ ! 264: *bnplim; /* limit of bindstack */ ! 265: ! 266: struct argent { ! 267: lispval val; ! 268: }; ! 269: extern struct argent *lbot, *np, *namptr; ! 270: extern struct nament *bnp; /* first free bind entry*/ ! 271: extern struct argent *nplim; /* don't have this = np */ ! 272: extern struct argent *orgnp; /* used by top level to reset to start */ ! 273: extern struct nament *orgbnp; /* used by top level to reset to start */ ! 274: extern struct nament *bnplim; /* limit of bindstack */ ! 275: extern struct argent *np, /* top entry on stack */ ! 276: *lbot, /* bottom of cur frame */ ! 277: *namptr; /* temporary pointer */ ! 278: extern lispval sigacts[16]; ! 279: extern lispval hunk_pages[7], hunk_items[7], hunk_name[7]; ! 280: ! 281: extern lispval Vprintsym; ! 282: ! 283: #define TNP if(np >= nplim) namerr(); ! 284: ! 285: #define TNP if(np >= nplim) namerr(); ! 286: #define INRNP if (np++ >= nplim) namerr(); ! 287: #define protect(p) (np++->val = (p)) ! 288: #define chkarg(p,x); if((p)!=np-lbot) argerr(x); ! 289: ! 290: ! 291: /** status codes **********************************************/ ! 292: /* */ ! 293: /* these define how status and sstatus should service probes */ ! 294: /* into the lisp data base */ ! 295: ! 296: /* common status codes */ ! 297: #define ST_NO 0 ! 298: ! 299: /* status codes */ ! 300: #define ST_READ 1 ! 301: #define ST_FEATR 2 ! 302: #define ST_SYNT 3 ! 303: #define ST_RINTB 4 ! 304: #define ST_NFETR 5 ! 305: #define ST_DMPR 6 ! 306: #define ST_CTIM 7 ! 307: #define ST_LOCT 8 ! 308: #define ST_ISTTY 9 ! 309: #define ST_UNDEF 10 ! 310: ! 311: /* sstatus codes */ ! 312: #define ST_SET 1 ! 313: #define ST_FEATW 2 ! 314: #define ST_TOLC 3 ! 315: #define ST_CORE 4 ! 316: #define ST_INTB 5 ! 317: #define ST_NFETW 6 ! 318: #define ST_DMPW 7 ! 319: #define ST_AUTR 8 ! 320: #define ST_TRAN 9 ! 321: #define ST_BCDTR 10 ! 322: #define ST_GCSTR 11 ! 323: ! 324: ! 325: /* number of counters for fasl to use in a profiling lisp */ ! 326: #define NMCOUNT 5000 ! 327: ! 328: /* hashing things *******************************************************/ ! 329: #define HASHTOP 1024 /* we handle 8-bit characters by dropping top bit */ ! 330: extern struct atom *hasht[HASHTOP]; ! 331: extern int hash; /* set by ratom */ ! 332: extern int atmlen; /* length of atom including final null */ ! 333: ! 334: ! 335: /** exception handling ***********************************************/ ! 336: extern int exception; /* if TRUE then an exception is pending, one of */ ! 337: /* the below */ ! 338: extern int sigintcnt; /* if > 0 then there is a SIGINT pending */ ! 339: ! 340: /* big string buffer for whomever needs it ******************************/ ! 341: extern char *strbuf; ! 342: extern char *endstrb; ! 343: extern int strbsize; ! 344: ! 345: /* break and error declarations *****************************************/ ! 346: #define SAVSIZE 44 /* number of bytes saved by setexit */ ! 347: #define BRRETB 1 ! 348: #define BRCONT 2 ! 349: #define BRGOTO 3 ! 350: #define BRRETN 4 ! 351: #define INTERRUPT 5 ! 352: #define THROW 6 ! 353: extern int depth; /* depth of nested breaks */ ! 354: extern lispval contval; /* the value being returned up */ ! 355: extern int retval; /* used by each error/prog call */ ! 356: extern lispval lispretval; /* used by non-local go */ ! 357: extern int rsetsw; /* used by *rset mode */ ! 358: extern int evalhcallsw; /* used by evalhook */ ! 359: extern int funhcallsw; /* used by evalhook */ ! 360: ! 361: ! 362: /* other stuff **********************************************************/ ! 363: extern lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */ ! 364: extern int itemp; ! 365: /* for pointer type conversion */ ! 366: #include "dfuncs.h" ! 367: ! 368: #define NUMBERP 2 ! 369: #define BCDP 5 ! 370: #define PORTP 6 ! 371: #define ARRAYP 7 ! 372: ! 373: #define ABSVAL 0 ! 374: #define MINUS 1 ! 375: #define ADD1 2 ! 376: #define SUB1 3 ! 377: #define NOT 4 ! 378: #define LNILL 5 ! 379: #define ZEROP 6 ! 380: #define ONEP 7 ! 381: #define PLUS 8 ! 382: #define TIMES 9 ! 383: #define DIFFERENCE 10 ! 384: #define QUOTIENT 11 ! 385: #define MOD 12 ! 386: #define LESSP 13 ! 387: #define GREATERP 14 ! 388: #define SUM 15 ! 389: #define PRODUCT 16 ! 390: #define AND 17 ! 391: #define OR 18 ! 392: #define XOR 19 ! 393: ! 394: interpt(); ! 395: handler(); extern sigdelay, sigstruck; ! 396: ! 397: /* limit of valid data area **************************************/ ! 398: ! 399: extern lispval datalim; ! 400: ! 401: /** macros to push and pop the value of an atom on the stack ******/ ! 402: ! 403: #define PUSHDOWN(atom,value)\ ! 404: {bnp->atm=(atom);bnp++->val=(atom)->a.clb;(atom)->a.clb=value;\ ! 405: if(bnp>bnplim) binderr();} ! 406: ! 407: #define POP\ ! 408: {--bnp;bnp->atm->a.clb=bnp->val;} ! 409: ! 410: /* PUSHVAL is used to store a specific atom and value on the ! 411: * bindstack. Currently only used by closure code ! 412: */ ! 413: #define PUSHVAL(atom,value)\ ! 414: {bnp->atm=(atom);bnp++->val=value;\ ! 415: if(bnp>bnplim) binderr();} ! 416: ! 417: /** macro for evaluating atoms in eval and interpreter ***********/ ! 418: ! 419: #define EVALATOM(x) vtemp = x->a.clb;\ ! 420: if( vtemp == CNIL ) {\ ! 421: printf("%s: ",(x)->a.pname);\ ! 422: vtemp = error("UNBOUND VARIABLE",TRUE);} ! 423: ! 424: /* having to do with small integers */ ! 425: extern long Fixzero[]; ! 426: #define SMALL(i) ((lispval)(Fixzero + i)) ! 427: #define P(p) ((lispval) (xports +((p)-_iob))) ! 428: #define PN(p) ((int) ((p)-_iob)) ! 429: #define okport(arg,default) (vtemp = arg,((TYPE((vtemp))!=PORT)?default:(vtemp)->p)) ! 430: ! 431: extern lispval ioname[]; /* names of open files */ ! 432: /* interpreter globals */ ! 433: ! 434: extern int lctrace; ! 435: ! 436: /* register lisp macros for registers */ ! 437: ! 438: #define saveonly(n) asm("#save n") ! 439: #define snpand(n) asm("#protect n")
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.