Annotation of 42BSD/ucb/lisp/franz/h/global.h, revision 1.1

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")

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.