![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sysat.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to sysat.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1: static char *sccsid = "@(#)sysat.c 34.13 11/11/80";
2:
3: #include "global.h"
4: #include "lfuncs.h"
5: #define MK(x,y,z) mfun(x,y,z)
6: #define FIDDLE(z,b,c,y) z->a.clb=newdot(); (z->a.clb->d.car=newint())->i=b->i; \
7: z->a.clb->d.cdr=newdot(); (z->a.clb->d.cdr->d.car=newint())->i=c->i; \
8: z->a.clb->d.cdr->d.cdr=newdot(); (z->a.clb->d.cdr->d.cdr->d.car=newint())->i=y; \
9: b = z->a.clb->d.car; c = z->a.clb->d.cdr->d.car; \
10: copval(z,z->a.clb); z->a.clb = nil;
11:
12: #define cforget(x) protect(x); Lforget(); unprot();
13:
14: /* The following array serves as the temporary counters of the items */
15: /* and pages used in each space. */
16:
17: long int tint[2*NUMSPACES];
18:
19: extern int tgcthresh;
20: extern int initflag; /* starts off TRUE to indicate unsafe to gc */
21:
22: extern int *beginsweep; /* place for garbage collector to begin sweeping */
23: #define PAGE_LIMIT 3800
24:
25: extern Iaddstat();
26:
27: makevals()
28: {
29: int i;
30: lispval temp;
31:
32: /* system list structure and atoms are initialized. */
33:
34: /* Before any lisp data can be created, the space usage */
35: /* counters must be set up, temporarily in array tint. */
36:
37: atom_items = (lispval) &tint[0];
38: atom_pages = (lispval) &tint[1];
39: str_items = (lispval) &tint[2];
40: str_pages = (lispval) &tint[3];
41: int_items = (lispval) &tint[4];
42: int_pages = (lispval) &tint[5];
43: dtpr_items = (lispval) &tint[6];
44: dtpr_pages = (lispval) &tint[7];
45: doub_items = (lispval) &tint[8];
46: doub_pages = (lispval) &tint[9];
47: sdot_items = (lispval) &tint[10];
48: sdot_pages = (lispval) &tint[11];
49: array_items = (lispval) &tint[12];
50: array_pages = (lispval) &tint[13];
51: val_items = (lispval) &tint[14];
52: val_pages = (lispval) &tint[15];
53: funct_items = (lispval) &tint[16];
54: funct_pages = (lispval) &tint[17];
55:
56: for (i=0; i < 8; i++)
57: {
58: hunk_pages[i] = (lispval) &tint[18+i*2];
59: hunk_items[i] = (lispval) &tint[19+i*2];
60: }
61:
62: /* This also applies to the garbage collection threshhold */
63:
64: gcthresh = (lispval) &tgcthresh;
65:
66: /* Now we commence constructing system lisp structures. */
67:
68: /* nil is a special case, constructed especially at location zero */
69:
70: hasht[hashfcn("nil")] = (struct atom *)nil;
71:
72: /*
73: * Names of various spaces and things
74: */
75:
76: atom_name = matom("symbol");
77: str_name = matom("string");
78: int_name = matom("fixnum");
79: dtpr_name = matom("list");
80: doub_name = matom("flonum");
81: sdot_name = matom("bignum");
82: array_name = matom("array");
83: val_name = matom("value");
84: funct_name = matom("binary");
85: port_name = matom("port"); /* not really a space */
86:
87: {
88: char name[6];
89:
90: strcpy(name, "hunk0");
91: for (i=0; i< 8; i++) {
92: hunk_name[i] = matom(name);
93: name[4]++;
94: }
95: }
96:
97: /* allocate space for namestack and bindstack first
98: * then set up beginsweep variable so that the sweeper will
99: * ignore these `always in use' pages
100: */
101:
102: lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE,FALSE));
103: orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE,FALSE));
104: beginsweep = (int *) sbrk(0);
105:
106: /* set up the name stack as an array of pointers */
107: nplim = orgnp+NAMESIZE-6*NAMINC;
108: temp = matom("namestack");
109: nstack = temp->a.fnbnd = newarray();
110: nstack->ar.data = (char *) (np);
111: (nstack->ar.length = newint())->i = NAMESIZE;
112: (nstack->ar.delta = newint())->i = sizeof(struct argent);
113: Vnogbar = matom("unmarked_array");
114: /* marking of the namestack will be done explicitly in gc1 */
115: (nstack->ar.aux = newdot())->d.car = Vnogbar;
116:
117:
118: /* set up the binding stack as an array of dotted pairs */
119:
120: bnplim = orgbnp+NAMESIZE-5;
121: temp = matom("bindstack");
122: bstack = temp->a.fnbnd = newarray();
123: bstack->ar.data = (char *) (bnp);
124: (bstack->ar.length = newint())->i = NAMESIZE;
125: (bstack->ar.delta = newint())->i = sizeof(struct nament);
126: /* marking of the bindstack will be done explicitly in gc1 */
127: (bstack->ar.aux = newdot())->d.car = Vnogbar;
128:
129: /* more atoms */
130:
131: tatom = matom("t");
132: tatom->a.clb = tatom;
133: lambda = matom("lambda");
134: nlambda = matom("nlambda");
135: macro = matom("macro");
136: ibase = matom("ibase"); /* base for input conversion */
137: ibase->a.clb = inewint(10);
138: rsetatom = matom("*rset");
139: rsetatom->a.clb = nil;
140: Vsubrou = matom("subroutine");
141: Vpiport = matom("piport");
142: Vpiport->a.clb = P(piport = stdin); /* standard input */
143: Vpoport = matom("poport");
144: Vpoport->a.clb = P(poport = stdout); /* stand. output */
145: matom("errport")->a.clb = (P(errport = stderr));/* stand. err. */
146: ioname[PN(stdin)] = (lispval) inewstr("$stdin");
147: ioname[PN(stdout)] = (lispval) inewstr("$stdout");
148: ioname[PN(stderr)] = (lispval) inewstr("$stderr");
149: (Vreadtable = matom("readtable"))->a.clb = Imkrtab(0);
150: strtab = Imkrtab(0);
151: Vptport = matom("ptport");
152: Vptport->a.clb = nil; /* protocal port */
153:
154: Vcntlw = matom("^w"); /* when non nil, inhibits output to term */
155: Vcntlw->a.clb = nil;
156:
157: Vprinlevel = matom("prinlevel"); /* printer recursion count */
158: Vprinlevel->a.clb = nil; /* infinite recursion */
159:
160: Vprinlength = matom("prinlength"); /* printer element count */
161: Vprinlength->a.clb = nil; /* infinite elements */
162: /* The following atoms are used as tokens by the reader */
163:
164: perda = matom(".");
165: lpara = matom("(");
166: rpara = matom(")");
167: lbkta = matom("[");
168: rbkta = matom("]");
169: snqta = matom("'");
170: exclpa = matom("!");
171:
172:
173: (Eofa = matom("eof"))->a.clb = eofa;
174: cara = MK("car",Lcar,lambda);
175: cdra = MK("cdr",Lcdr,lambda);
176:
177: /* The following few atoms have values the reader tokens. */
178: /* Perhaps this is a kludge which should be abandoned. */
179: /* On the other hand, perhaps it is an inspiration. */
180:
181: matom("perd")->a.clb = perda;
182: matom("lpar")->a.clb = lpara;
183: matom("rpar")->a.clb = rpara;
184: matom("lbkt")->a.clb = lbkta;
185: matom("rbkt")->a.clb = rbkta;
186:
187: noptop = matom("noptop");
188:
189: /* atoms used in connection with comments. */
190:
191: commta = matom("comment");
192: rcomms = matom("readcomments");
193:
194: /* the following atoms are used for lexprs */
195:
196: lexpr_atom = matom("last lexpr binding\7");
197: lexpr = matom("lexpr");
198:
199: /* the following atom is used to reference the bind stack for eval */
200: bptr_atom = matom("eval1 binding pointer\7");
201: bptr_atom->a.clb = nil;
202:
203: /* the following atoms are used for evalhook hackery */
204: evalhatom = matom("evalhook");
205: evalhatom->a.clb = nil;
206: evalhcall = matom("evalhook call flag\7");
207:
208: sysa = matom("sys");
209: plima = matom("pagelimit"); /* max number of pages */
210: Veval = MK("eval",Leval1,lambda);
211: MK("asin",Lasin,lambda);
212: MK("acos",Lacos,lambda);
213: MK("atan",Latan,lambda);
214: MK("cos",Lcos,lambda);
215: MK("sin",Lsin,lambda);
216: MK("sqrt",Lsqrt,lambda);
217: MK("exp",Lexp,lambda);
218: MK("log",Llog,lambda);
219: MK("lsh",Llsh,lambda);
220: MK("rot",Lrot,lambda);
221: MK("random",Lrandom,lambda);
222: MK("atom",Latom,lambda);
223: MK("apply",Lapply,lambda);
224: MK("funcall",Lfuncal,lambda);
225: MK("return",Lreturn,lambda);
226: MK("retbrk",Lretbrk,lambda);
227: /* MK("cont",Lreturn,lambda); */
228: MK("cons",Lcons,lambda);
229: MK("scons",Lscons,lambda);
230: MK("cadr",Lcadr,lambda);
231: MK("caar",Lcaar,lambda);
232: MK("cddr",Lc02r,lambda);
233: MK("caddr",Lc12r,lambda);
234: MK("cdddr",Lc03r,lambda);
235: MK("cadddr",Lc13r,lambda);
236: MK("cddddr",Lc04r,lambda);
237: MK("caddddr",Lc14r,lambda);
238: MK("nthelem",Lnthelem,lambda);
239: MK("eq",Leq,lambda);
240: MK("equal",Lequal,lambda);
241: MK("zqual",Zequal,lambda);
242: MK("numberp",Lnumberp,lambda);
243: MK("dtpr",Ldtpr,lambda);
244: MK("bcdp",Lbcdp,lambda);
245: MK("portp",Lportp,lambda);
246: MK("arrayp",Larrayp,lambda);
247: MK("valuep",Lvaluep,lambda);
248: MK("get_pname",Lpname,lambda);
249: MK("ptr",Lptr,lambda);
250: MK("arrayref",Larrayref,lambda);
251: MK("marray",Lmarray,lambda);
252: MK("getlength",Lgetl,lambda);
253: MK("putlength",Lputl,lambda);
254: MK("getaccess",Lgeta,lambda);
255: MK("putaccess",Lputa,lambda);
256: MK("getdelta",Lgetdel,lambda);
257: MK("putdelta",Lputdel,lambda);
258: MK("getaux",Lgetaux,lambda);
259: MK("putaux",Lputaux,lambda);
260: MK("getdata",Lgetdata,lambda);
261: MK("putdata",Lputdata,lambda);
262: MK("mfunction",Lmfunction,lambda);
263: MK("getentry",Lgetentry,lambda);
264: MK("getdisc",Lgetdisc,lambda);
265: MK("putdisc",Lputdisc,lambda);
266: MK("segment",Lsegment,lambda);
267: MK("rplaca",Lrplaca,lambda);
268: MK("rplacd",Lrplacd,lambda);
269: MK("set",Lset,lambda);
270: MK("replace",Lreplace,lambda);
271: MK("infile",Linfile,lambda);
272: MK("outfile",Loutfile,lambda);
273: MK("terpr",Lterpr,lambda);
274: MK("print",Lprint,lambda);
275: MK("close",Lclose,lambda);
276: MK("patom",Lpatom,lambda);
277: MK("pntlen",Lpntlen,lambda);
278: MK("read",Lread,lambda);
279: MK("ratom",Lratom,lambda);
280: MK("readc",Lreadc,lambda);
281: MK("implode",Limplode,lambda);
282: MK("maknam",Lmaknam,lambda);
283: MK("concat",Lconcat,lambda);
284: MK("uconcat",Luconcat,lambda);
285: MK("putprop",Lputprop,lambda);
286: MK("monitor",Lmonitor,lambda);
287: MK("get",Lget,lambda);
288: MK("getd",Lgetd,lambda);
289: MK("putd",Lputd,lambda);
290: MK("prog",Nprog,nlambda);
291: quota = MK("quote",Nquote,nlambda);
292: MK("function",Nfunction,nlambda);
293: MK("go",Ngo,nlambda);
294: MK("*catch",Ncatch,nlambda);
295: MK("errset",Nerrset,nlambda);
296: MK("status",Nstatus,nlambda);
297: MK("sstatus",Nsstatus,nlambda);
298: MK("err",Lerr,lambda);
299: MK("*throw",Nthrow,lambda); /* this is a lambda now !! */
300: reseta = MK("reset",Nreset,nlambda);
301: MK("break",Nbreak,nlambda);
302: MK("exit",Lexit,lambda);
303: MK("def",Ndef,nlambda);
304: MK("null",Lnull,lambda);
305: MK("and",Nand,nlambda);
306: MK("or",Nor,nlambda);
307: MK("setq",Nsetq,nlambda);
308: MK("cond",Ncond,nlambda);
309: MK("list",Llist,lambda);
310: MK("load",Lload,lambda);
311: MK("nwritn",Lnwritn,lambda);
312: MK("process",Nprocess,nlambda); /* execute a shell command */
313: MK("allocate",Lalloc,lambda); /* allocate a page */
314: MK("sizeof",Lsizeof,lambda); /* size of one item of a data type */
315: MK("odumplisp",Ndumplisp,nlambda); /* OLD save the world */
316: MK("dumplisp",Nndumplisp,nlambda); /* NEW save the world */
317: #ifdef VMS
318: MK("savelisp",Lsavelsp,lambda); /* save lisp data */
319: MK("restorelisp",Lrestlsp,lambda);
320: #endif
321: MK("top-level",Ntpl,nlambda); /* top level eval-print read loop */
322: startup = matom("startup"); /* used by save and restore */
323: MK("mapcar",Lmapcar,lambda);
324: MK("maplist",Lmaplist,lambda);
325: MK("mapcan",Lmapcan,lambda);
326: MK("mapcon",Lmapcon,lambda);
327: MK("assq",Lassq,lambda);
328: MK("mapc",Lmapc,lambda);
329: MK("map",Lmap,lambda);
330: MK("flatc",Lflatsi,lambda);
331: MK("alphalessp",Lalfalp,lambda);
332: MK("drain",Ldrain,lambda);
333: MK("killcopy",Lkilcopy,lambda); /* forks aand aborts for adb */
334: MK("opval",Lopval,lambda); /* sets and retrieves system variables */
335: MK("ncons",Lncons,lambda);
336: sysa = matom("sys"); /* sys indicator for system variables */
337: MK("remob",Lforget,lambda); /* function to take atom out of hash table */
338: splice = matom("splicing");
339: MK("not",Lnull,lambda);
340: MK("plus",Ladd,lambda);
341: MK("add",Ladd,lambda);
342: MK("times",Ltimes,lambda);
343: MK("difference",Lsub,lambda);
344: MK("quotient",Lquo,lambda);
345: MK("mod",Lmod,lambda);
346: MK("minus",Lminus,lambda);
347: MK("absval",Labsval,lambda);
348: MK("add1",Ladd1,lambda);
349: MK("sub1",Lsub1,lambda);
350: MK("greaterp",Lgreaterp,lambda);
351: MK("lessp",Llessp,lambda);
352: MK("any-zerop",Lzerop,lambda); /* used when bignum arg possible */
353: MK("zerop",Lzerop,lambda);
354: MK("minusp",Lnegp,lambda);
355: MK("onep",Lonep,lambda);
356: MK("sum",Ladd,lambda);
357: MK("product",Ltimes,lambda);
358: MK("do",Ndo,nlambda);
359: MK("progv",Nprogv,nlambda);
360: MK("progn",Nprogn,nlambda);
361: MK("prog2",Nprog2,nlambda);
362: MK("oblist",Loblist,lambda);
363: MK("baktrace",Lbaktrace,lambda);
364: MK("tyi",Ltyi,lambda);
365: MK("tyipeek",Ltyipeek,lambda);
366: MK("tyo",Ltyo,lambda);
367: MK("setsyntax",Lsetsyn,lambda);
368: MK("makereadtable",Lmakertbl,lambda);
369: MK("zapline",Lzapline,lambda);
370: MK("aexplode",Lexplda,lambda);
371: MK("aexplodec",Lexpldc,lambda);
372: MK("aexploden",Lexpldn,lambda);
373: MK("hashtabstat",Lhashst,lambda);
374: #ifdef METER
375: MK("gcstat",Lgcstat,lambda);
376: #endif
377: MK("argv",Largv,lambda);
378: MK("arg",Larg,lambda);
379: MK("setarg",Lsetarg,lambda);
380: MK("showstack",Lshostk,lambda);
381: MK("freturn",Lfretn,lambda);
382: MK("*rset",Lrset,lambda);
383: MK("eval1",Leval1,lambda);
384: MK("evalframe",Levalf,lambda);
385: MK("evalhook",Levalhook,lambda);
386: MK("resetio",Nresetio,nlambda);
387: MK("chdir",Lchdir,lambda);
388: MK("ascii",Lascii,lambda);
389: MK("boole",Lboole,lambda);
390: MK("type",Ltype,lambda); /* returns type-name of argument */
391: MK("fix",Lfix,lambda);
392: MK("float",Lfloat,lambda);
393: MK("fact",Lfact,lambda);
394: MK("cpy1",Lcpy1,lambda);
395: MK("Divide",LDivide,lambda);
396: MK("Emuldiv",LEmuldiv,lambda);
397: MK("readlist",Lreadli,lambda);
398: MK("plist",Lplist,lambda); /* gives the plist of an atom */
399: MK("setplist",Lsetpli,lambda); /* get plist of an atom */
400: MK("eval-when",Nevwhen,nlambda);
401: MK("syscall",Lsyscall,lambda);
402: MK("intern",Lintern,lambda);
403: MK("ptime",Lptime,lambda); /* return process user time */
404: /*
405: MK("fork",Lfork,lambda);
406: MK("wait",Lwait,lambda);
407: MK("pipe",Lpipe,lambda);
408: MK("fdopen",Lfdopen,lambda);
409: */
410: MK("exece",Lexece,lambda);
411: MK("gensym",Lgensym,lambda);
412: MK("remprop",Lremprop,lambda);
413: MK("bcdad",Lbcdad,lambda);
414: MK("symbolp",Lsymbolp,lambda);
415: MK("stringp",Lstringp,lambda);
416: MK("rematom",Lrematom,lambda);
417: MK("prname",Lprname,lambda);
418: MK("getenv",Lgetenv,lambda);
419: MK("I-throw-err",Lctcherr,lambda); /* directly force a throw or error */
420: MK("makunbound",Lmakunb,lambda);
421: MK("haipart",Lhaipar,lambda);
422: MK("haulong",Lhau,lambda);
423: MK("signal",Lsignal,lambda);
424: MK("fasl",Lnfasl,lambda); /* NEW - new fasl loader */
425: MK("cfasl",Lcfasl,lambda); /* read in compiled C file */
426: MK("getaddress",Lgetaddress,lambda);
427: /* bind symbols without doing cfasl */
428: MK("boundp",Lboundp,lambda); /* tells if an atom is bound */
429: MK("fake",Lfake,lambda); /* makes a fake lisp pointer */
430: MK("od",Lod,lambda); /* dumps info */
431: MK("maknum",Lmaknum,lambda); /* converts a pointer to an integer */
432: MK("*mod",LstarMod,lambda); /* return fixnum modulus */
433:
434: MK("fseek",Lfseek,lambda); /* seek to a specific byte in a file */
435: MK("fileopen", Lfileopen, lambda);
436: /* open a file for read/write/append */
437:
438: MK("pv%",Lpolyev,lambda); /* polynomial evaluation instruction */
439: MK("cprintf",Lcprintf,lambda); /* formatted print */
440: MK("copyint*",Lcopyint,lambda); /* copyint* */
441:
442: /*
443: * Hunk stuff
444: */
445:
446: MK("*makhunk",LMakhunk,lambda); /* special hunk creater */
447: MK("hunkp",Lhunkp,lambda); /* test a hunk */
448: MK("cxr",Lcxr,lambda); /* cxr of a hunk */
449: MK("rplacx",Lrplacx,lambda); /* replace element of a hunk */
450: MK("*rplacx",Lstarrpx,lambda); /* rplacx used by hunk */
451: MK("hunksize",Lhunksize,lambda); /* size of a hunk */
452:
453: MK("probef",Lprobef,lambda); /* test file existance */
454: MK("substring",Lsubstring,lambda);
455: MK("substringn",Lsubstringn,lambda);
456: odform = matom("odformat"); /* format for printf's used in od */
457: rdrsdot = newsdot(); /* used in io conversions of bignums */
458: rdrsdot2 = newsdot(); /* used in io conversions of bignums */
459: rdrint = newint(); /* used as a temporary integer */
460: (nilplist = newdot())->d.cdr = newdot();
461: /* used as property list for nil,
462: since nil will eventually be put at
463: 0 (consequently in text and not
464: writable) */
465:
466: /* error variables */
467: (Vererr = matom("ER%err"))->a.clb = nil;
468: (Vertpl = matom("ER%tpl"))->a.clb = nil;
469: (Verall = matom("ER%all"))->a.clb = nil;
470: (Vermisc = matom("ER%misc"))->a.clb = nil;
471: (Verbrk = matom("ER%brk"))->a.clb = nil;
472: (Verundef = matom("ER%undef"))->a.clb = nil;
473: (Vlerall = newdot())->d.car = Verall; /* list (ER%all) */
474: (Veruwpt = matom("ER%unwind-protect"))->a.clb = nil;
475: (Verrset = matom("errset"))->a.clb = nil;
476:
477:
478: /* set up the initial status list */
479:
480: stlist = nil; /* initially nil */
481: Iaddstat(matom("features"),ST_READ,ST_NO,nil);
482: Iaddstat(matom("feature"),ST_FEATR,ST_FEATW,nil);
483: Isstatus(matom("feature"),matom("franz"));
484: Isstatus(matom("feature"),matom(OS));
485: Isstatus(matom("feature"),matom("string"));
486: Isstatus(matom("feature"),matom(MACHINE));
487: Isstatus(matom("feature"),matom(SITE));
488:
489: Iaddstat(matom("nofeature"),ST_NFETR,ST_NFETW,nil);
490: Iaddstat(matom("syntax"),ST_SYNT,ST_NO,nil);
491: Iaddstat(matom("uctolc"),ST_READ,ST_TOLC,nil);
492: Iaddstat(matom("dumpcore"),ST_READ,ST_CORE,nil);
493: Isstatus(matom("dumpcore"),nil); /*set up signals*/
494:
495: Iaddstat(matom("chainatom"),ST_RINTB,ST_INTB,inewint(0));
496: Iaddstat(matom("dumpmode"),ST_DMPR,ST_DMPW,nil);
497: Iaddstat(matom("appendmap"),ST_READ,ST_SET,nil); /* used by fasl */
498: Iaddstat(matom("debugging"),ST_READ,ST_SET,nil);
499: Iaddstat(matom("evalhook"),ST_RINTB,ST_INTB,inewint(3));
500: Isstatus(matom("evalhook"),nil); /*evalhook switch off */
501: Iaddstat(matom("bcdtrace"),ST_READ,ST_BCDTR,nil);
502: Iaddstat(matom("ctime"),ST_CTIM,ST_NO,nil);
503: Iaddstat(matom("localtime"),ST_LOCT,ST_NO,nil);
504: Iaddstat(matom("isatty"),ST_ISTTY,ST_NO,nil);
505: Iaddstat(matom("ignoreeof"),ST_READ,ST_SET,nil);
506: Iaddstat(matom("version"),ST_READ,ST_NO,mstr("Franz Lisp, Opus 34"));
507: Iaddstat(matom("automatic-reset"),ST_READ,ST_AUTR,nil);
508: Iaddstat(matom("translink"),ST_READ,ST_TRAN,nil);
509: Isstatus(matom("translink"),tatom); /* turn on tran links */
510: Iaddstat(matom("undeffunc"),ST_UNDEF,ST_NO,nil); /* list undef funcs */
511:
512: /* garbage collector things */
513:
514: MK("gc",Ngc,nlambda);
515: gcafter = MK("gcafter",Ngcafter,nlambda); /* garbage collection wind-up */
516: gcport = matom("gcport"); /* port for gc dumping */
517: gccheck = matom("gccheck"); /* flag for checking during gc */
518: gcdis = matom("gcdisable"); /* variable for disabling the gc */
519: gcdis->a.clb = nil;
520: gcload = matom("gcload"); /* option for gc while loading */
521: loading = matom("loading"); /* flag--in loader if = t */
522: noautot = matom("noautotrace"); /* option to inhibit auto-trace */
523: (gcthresh = newint())->i = tgcthresh;
524: gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */
525: gccall1->d.car = gcafter; /* start constructing a form for eval */
526:
527: arrayst = mstr("ARRAY"); /* array marker in name stack */
528: bcdst = mstr("BINARY"); /* binary function marker */
529: listst = mstr("INTERPRETED"); /* interpreted function marker */
530: macrost = mstr("MACRO"); /* macro marker */
531: protst = mstr("PROTECTED"); /* protection marker */
532: badst = mstr("BADPTR"); /* bad pointer marker */
533: argst = mstr("ARGST"); /* argument marker */
534: hunkfree = mstr("EMPTY"); /* empty hunk cell value */
535:
536: /* type names */
537:
538: FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP);
539: FIDDLE(str_name,str_items,str_pages,STRSPP);
540: FIDDLE(int_name,int_items,int_pages,INTSPP);
541: FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP);
542: FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP);
543: FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP);
544: FIDDLE(array_name,array_items,array_pages,ARRAYSPP);
545: FIDDLE(val_name,val_items,val_pages,VALSPP);
546: FIDDLE(funct_name,funct_items,funct_pages,BCDSPP);
547:
548: FIDDLE(hunk_name[0], hunk_items[0], hunk_pages[0], HUNK2SPP);
549: FIDDLE(hunk_name[1], hunk_items[1], hunk_pages[1], HUNK4SPP);
550: FIDDLE(hunk_name[2], hunk_items[2], hunk_pages[2], HUNK8SPP);
551: FIDDLE(hunk_name[3], hunk_items[3], hunk_pages[3], HUNK16SPP);
552: FIDDLE(hunk_name[4], hunk_items[4], hunk_pages[4], HUNK32SPP);
553: FIDDLE(hunk_name[5], hunk_items[5], hunk_pages[5], HUNK64SPP);
554: FIDDLE(hunk_name[6], hunk_items[6], hunk_pages[6], HUNK128SPP);
555:
556: (plimit = newint())->i = PAGE_LIMIT;
557: copval(plima,plimit); /* default value */
558:
559: /* the following atom is used when reading caar, cdar, etc. */
560:
561: xatom = matom("??");
562:
563: /* now it is OK to collect garbage */
564:
565: initflag = FALSE;
566: }
567:
568: /* matom("name") ******************************************************/
569: /* */
570: /* simulates an atom being read in from the reader and returns a */
571: /* pointer to it. */
572: /* */
573: /* BEWARE: if an atom becomes "truly worthless" and is collected, */
574: /* the pointer becomes obsolete. */
575: /* */
576: lispval
577: matom(string)
578: char *string;
579: {
580: strbuf[0] = 0;
581: strcatn(strbuf,string,STRBLEN);
582: return(getatom());
583: }
584:
585: /* mstr ***************************************************************/
586: /* */
587: /* Makes a string. Uses matom. */
588: /* Not the most efficient but will do until the string from the code */
589: /* itself can be used as a lispval. */
590:
591: lispval mstr(string) char *string;
592: {
593: return((lispval)(inewstr(string)));
594: }
595:
596: /* mfun("name",entry) *************************************************/
597: /* */
598: /* Same as matom, but entry point to c code is associated with */
599: /* "name" as function binding. */
600: /* A pointer to the atom is returned. */
601: /* */
602: lispval mfun(string,entry,discip) char *string; lispval (*entry)(), discip;
603: {
604: lispval v;
605: v = matom(string);
606: v->a.fnbnd = newfunct();
607: v->a.fnbnd->bcd.entry = entry;
608: v->a.fnbnd->bcd.discipline = discip;
609: return(v);
610: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.