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