|
|
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.11 85/03/24 11:06:11 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: #ifdef SIXONLY ! 104: #define errorh1 errh1 ! 105: #define errorh2 errh2 ! 106: #endif ! 107: ! 108: #define CNIL ((lispval) (OFFSET-4)) ! 109: #define NOTNIL(a) (nil!=a) ! 110: #define ISNIL(a) (nil==a) ! 111: ! 112: #ifdef SPISFP ! 113: extern long *xsp, xstack[]; ! 114: #define sp() xsp ! 115: #define stack(z) (xsp > xstack ? (*--xsp = z): xserr()) ! 116: #define unstack() (*xsp++) ! 117: #define Keepxs() long *oxsp = xsp; ! 118: #define Freexs() xsp = oxsp; ! 119: #else ! 120: extern long *sp(), stack(), unstack(); ! 121: #define Keepxs() /* */ ! 122: #define Freexs() /* */ ! 123: #endif ! 124: ! 125: extern char typetable[]; /* the table with types for each page */ ! 126: #define ATOX(a1) ((((int)(a1)) - OFFSET) >> 9) ! 127: #define TYPE(a1) ((typetable+1)[ATOX(a1)]) ! 128: #define TYPL(a1) ((typetable+1)[ATOX(a1)]) ! 129: #define SETTYPE(a1,b,c) {if((itemp = ATOX(a1)) >= fakettsize) \ ! 130: { if(fakettsize >= TTSIZE) \ ! 131: {\ ! 132: printf(" all space exausted, goodbye\n");\ ! 133: exit(1);\ ! 134: }\ ! 135: fakettsize++; badmem(c);\ ! 136: }\ ! 137: (typetable + 1)[itemp] = (b); } ! 138: ! 139: #define HUNKP(a1) ((TYPE(a1) >= 11) & (TYPE(a1) <= 17)) ! 140: #define HUNKSIZE(a1) ((TYPE(a1)+5) & 15) ! 141: ! 142: #define UPTR(x) ((unsigned)(((long)(x))-(long)CNIL)) ! 143: #define VALID(a) (UPTR(a) <= UPTR(datalim)) ! 144: ! 145: #define Popframe() (errp->olderrp) ! 146: ! 147: ! 148: /* some types ***********************************************************/ ! 149: #define lispint long ! 150: #define MAX10LNG 200000000 /* max long divided by 10 */ ! 151: ! 152: ! 153: typedef union lispobj *lispval ; ! 154: ! 155: struct dtpr { ! 156: lispval cdr, car; ! 157: }; ! 158: ! 159: struct sdot { ! 160: int I; ! 161: lispval CDR; ! 162: }; ! 163: ! 164: ! 165: struct atom { ! 166: lispval clb; /* current level binding*/ ! 167: lispval plist; /* pointer to prop list */ ! 168: #ifndef WILD ! 169: lispval fnbnd; /* function binding */ ! 170: #endif ! 171: struct atom *hshlnk; /* hash link to next */ ! 172: char *pname; /* print name */ ! 173: }; ! 174: #ifdef WILD ! 175: #define fnbnd clb ! 176: #endif ! 177: ! 178: struct array { ! 179: lispval accfun, /* access function--may be anything */ ! 180: aux; /* slot for dimensions or auxilliary data */ ! 181: char *data; /* pointer to first byte of array */ ! 182: lispval length, delta; /* length in items and length of one item */ ! 183: }; ! 184: ! 185: struct bfun { ! 186: lispval (*start)(); /* entry point to routine */ ! 187: lispval discipline, /* argument-passing discipline */ ! 188: language, /* language coded in */ ! 189: params, /* parameter list if relevant */ ! 190: loctab; /* local table */ ! 191: }; ! 192: ! 193: struct Hunk { ! 194: lispval hunk[1]; ! 195: }; ! 196: ! 197: struct Vector { ! 198: lispval vector[1]; ! 199: }; ! 200: ! 201: /* the vectori types */ ! 202: struct Vectorb { ! 203: char vectorb[1]; ! 204: }; ! 205: ! 206: struct Vectorw { ! 207: short vectorw[1]; ! 208: }; ! 209: ! 210: struct Vectorl { ! 211: long vectorl[1]; ! 212: }; ! 213: ! 214: union lispobj { ! 215: struct atom a; ! 216: FILE *p; ! 217: struct dtpr d; ! 218: long int i; ! 219: long int *j; ! 220: double r; ! 221: lispval (*f)(); ! 222: struct array ar; ! 223: struct sdot s; ! 224: char c; ! 225: lispval l; ! 226: struct bfun bcd; ! 227: struct Hunk h; ! 228: struct Vector v; ! 229: struct Vectorb vb; ! 230: struct Vectorw vw; ! 231: struct Vectorl vl; ! 232: }; ! 233: ! 234: #ifdef lint ! 235: extern lispval Inewint(); ! 236: #define inewint(p) Inewint((long)(p)) ! 237: #else ! 238: extern lispval inewint(); ! 239: #endif ! 240: ! 241: ! 242: #include "sigtab.h" /* table of all pointers to lisp data */ ! 243: ! 244: /* Port definitions *****************************************************/ ! 245: extern FILE *piport, /* standard input port */ ! 246: *poport, /* standard output port */ ! 247: *errport, /* port for error messages */ ! 248: *rdrport; /* temporary port for readr */ ! 249: ! 250: #ifndef RTPORTS ! 251: extern FILE *xports[]; /* page of file *'s for lisp */ ! 252: #define P(p) ((lispval) (xports +((p)-_iob))) ! 253: #define PN(p) ((int) ((p)-_iob)) ! 254: #else ! 255: extern lispval P(); ! 256: extern FILE **xports; ! 257: #define PN(p) (((FILE **)P(p))-xports) ! 258: #endif ! 259: ! 260: extern int lineleng ; /* line length desired */ ! 261: extern char rbktf; /* logical flag: ] mode */ ! 262: extern unsigned char *ctable; /* Character table in current use */ ! 263: #define Xdqc ctable[131] ! 264: #define Xesc ctable[130] ! 265: #define Xsdc ctable[129] ! 266: ! 267: /* name stack ***********************************************************/ ! 268: ! 269: #define NAMESIZE 3072 ! 270: ! 271: /* the name stack limit is raised by NAMINC every namestack overflow to allow ! 272: a user function to handle the error ! 273: */ ! 274: #define NAMINC 25 ! 275: ! 276: extern struct nament { ! 277: lispval val, ! 278: atm; ! 279: } *bnp, /* first free bind entry*/ ! 280: *bnplim; /* limit of bindstack */ ! 281: ! 282: struct argent { ! 283: lispval val; ! 284: }; ! 285: extern struct argent *lbot, *np, *namptr; ! 286: extern struct nament *bnp; /* first free bind entry*/ ! 287: extern struct argent *nplim; /* don't have this = np */ ! 288: extern struct argent *orgnp; /* used by top level to reset to start */ ! 289: extern struct nament *orgbnp; /* used by top level to reset to start */ ! 290: extern struct nament *bnplim; /* limit of bindstack */ ! 291: extern struct argent *np, /* top entry on stack */ ! 292: *lbot, /* bottom of cur frame */ ! 293: *namptr; /* temporary pointer */ ! 294: extern lispval sigacts[16]; ! 295: extern lispval hunk_pages[7], hunk_items[7], hunk_name[7]; ! 296: ! 297: extern lispval Vprintsym; ! 298: ! 299: #define TNP if(np >= nplim) namerr(); ! 300: ! 301: #define TNP if(np >= nplim) namerr(); ! 302: #define INRNP if (np++ >= nplim) namerr(); ! 303: #define protect(p) (np++->val = (p)) ! 304: #define chkarg(p,x); if((p)!=np-lbot) argerr(x); ! 305: ! 306: ! 307: /** status codes **********************************************/ ! 308: /* */ ! 309: /* these define how status and sstatus should service probes */ ! 310: /* into the lisp data base */ ! 311: ! 312: /* common status codes */ ! 313: #define ST_NO 0 ! 314: ! 315: /* status codes */ ! 316: #define ST_READ 1 ! 317: #define ST_FEATR 2 ! 318: #define ST_SYNT 3 ! 319: #define ST_RINTB 4 ! 320: #define ST_NFETR 5 ! 321: #define ST_DMPR 6 ! 322: #define ST_CTIM 7 ! 323: #define ST_LOCT 8 ! 324: #define ST_ISTTY 9 ! 325: #define ST_UNDEF 10 ! 326: ! 327: /* sstatus codes */ ! 328: #define ST_SET 1 ! 329: #define ST_FEATW 2 ! 330: #define ST_TOLC 3 ! 331: #define ST_CORE 4 ! 332: #define ST_INTB 5 ! 333: #define ST_NFETW 6 ! 334: #define ST_DMPW 7 ! 335: #define ST_AUTR 8 ! 336: #define ST_TRAN 9 ! 337: #define ST_BCDTR 10 ! 338: #define ST_GCSTR 11 ! 339: ! 340: ! 341: /* number of counters for fasl to use in a profiling lisp */ ! 342: #define NMCOUNT 5000 ! 343: ! 344: /* hashing things *******************************************************/ ! 345: #define HASHTOP 1024 /* we handle 8-bit characters by dropping top bit */ ! 346: extern struct atom *hasht[HASHTOP]; ! 347: extern int hash; /* set by ratom */ ! 348: extern int atmlen; /* length of atom including final null */ ! 349: ! 350: ! 351: /** exception handling ***********************************************/ ! 352: extern int exception; /* if TRUE then an exception is pending, one of */ ! 353: /* the below */ ! 354: extern int sigintcnt; /* if > 0 then there is a SIGINT pending */ ! 355: ! 356: /* big string buffer for whomever needs it ******************************/ ! 357: extern char *strbuf; ! 358: extern char *endstrb; ! 359: ! 360: /* break and error declarations *****************************************/ ! 361: #define SAVSIZE 44 /* number of bytes saved by setexit */ ! 362: #define BRRETB 1 ! 363: #define BRCONT 2 ! 364: #define BRGOTO 3 ! 365: #define BRRETN 4 ! 366: #define INTERRUPT 5 ! 367: #define THROW 6 ! 368: extern int depth; /* depth of nested breaks */ ! 369: extern lispval contval; /* the value being returned up */ ! 370: extern int retval; /* used by each error/prog call */ ! 371: extern lispval lispretval; /* used by non-local go */ ! 372: extern int rsetsw; /* used by *rset mode */ ! 373: extern int evalhcallsw; /* used by evalhook */ ! 374: extern int funhcallsw; /* used by evalhook */ ! 375: ! 376: ! 377: /* other stuff **********************************************************/ ! 378: extern lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */ ! 379: extern int itemp; ! 380: /* for pointer type conversion */ ! 381: #include "dfuncs.h" ! 382: ! 383: #define NUMBERP 2 ! 384: #define BCDP 5 ! 385: #define PORTP 6 ! 386: #define ARRAYP 7 ! 387: ! 388: #define ABSVAL 0 ! 389: #define MINUS 1 ! 390: #define ADD1 2 ! 391: #define SUB1 3 ! 392: #define NOT 4 ! 393: #define LNILL 5 ! 394: #define ZEROP 6 ! 395: #define ONEP 7 ! 396: #define PLUS 8 ! 397: #define TIMES 9 ! 398: #define DIFFERENCE 10 ! 399: #define QUOTIENT 11 ! 400: #define MOD 12 ! 401: #define LESSP 13 ! 402: #define GREATERP 14 ! 403: #define SUM 15 ! 404: #define PRODUCT 16 ! 405: #define AND 17 ! 406: #define OR 18 ! 407: #define XOR 19 ! 408: ! 409: interpt(); ! 410: handler(); extern sigdelay, sigstruck; ! 411: ! 412: /* limit of valid data area **************************************/ ! 413: ! 414: extern lispval datalim; ! 415: ! 416: /** macros to push and pop the value of an atom on the stack ******/ ! 417: ! 418: #define PUSHDOWN(atom,value)\ ! 419: {bnp->atm=(atom);bnp++->val=(atom)->a.clb;(atom)->a.clb=value;\ ! 420: if(bnp>bnplim) binderr();} ! 421: ! 422: #define POP\ ! 423: {--bnp;bnp->atm->a.clb=bnp->val;} ! 424: ! 425: /* PUSHVAL is used to store a specific atom and value on the ! 426: * bindstack. Currently only used by closure code ! 427: */ ! 428: #define PUSHVAL(atom,value)\ ! 429: {bnp->atm=(atom);bnp++->val=value;\ ! 430: if(bnp>bnplim) binderr();} ! 431: ! 432: /** macro for evaluating atoms in eval and interpreter ***********/ ! 433: ! 434: #define EVALATOM(x) vtemp = x->a.clb;\ ! 435: if( vtemp == CNIL ) {\ ! 436: printf("%s: ",(x)->a.pname);\ ! 437: vtemp = error("UNBOUND VARIABLE",TRUE);} ! 438: ! 439: /* having to do with small integers */ ! 440: extern long Fixzero[]; ! 441: #define SMALL(i) ((lispval)(Fixzero + i)) ! 442: #define okport(arg,default) (vtemp = arg,((TYPE((vtemp))!=PORT)?default:(vtemp)->p)) ! 443: ! 444: extern lispval ioname[]; /* names of open files */ ! 445: /* interpreter globals */ ! 446: ! 447: extern int lctrace; ! 448: ! 449: /* register lisp macros for registers */ ! 450: ! 451: #define saveonly(n) asm("#save n") ! 452: #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.