![[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] / 42BSD / ucb / lisp / franz / h|
Return to global.h CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / 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.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.