![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to global.h CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / franz / h|
Return to global.h CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / franz / h |
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.