![[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] / 3BSD / cmd / lisp|
Return to sysat.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2: #include "lfuncs.h"
3: #define MK(x,y,z) mfun(x,y,z)
4: #define FIDDLE(a,b,c,d) a->clb=newdot(); (a->clb->car=newint())->i=b->i; \
5: a->clb->cdr=newdot(); (a->clb->cdr->car=newint())->i=c->i; \
6: a->clb->cdr->cdr=newdot(); (a->clb->cdr->cdr->car=newint())->i=d; \
7: b = a->clb->car; c = a->clb->cdr->car; \
8: copval(a,a->clb); a->clb = nil;
9:
10: #define cforget(x) protect(x); Lforget(); unprot();
11:
12: /* The following array serves as the temporary counters of the items */
13: /* and pages used in each space. */
14:
15: long int tint[18]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
16:
17: long int tgcthresh = 15;
18: int initflag = TRUE; /* starts off TRUE to indicate unsafe to gc */
19:
20: #define PAGE_LIMIT 3800
21:
22: extern Iaddstat();
23:
24: makevals()
25: {
26: lispval temp;
27:
28: /* system list structure and atoms are initialized. */
29:
30: /* Before any lisp data can be created, the space usage */
31: /* counters must be set up, temporarily in array tint. */
32:
33: atom_items = (lispval) &tint[0];
34: atom_pages = (lispval) &tint[1];
35: str_items = (lispval) &tint[2];
36: str_pages = (lispval) &tint[3];
37: int_items = (lispval) &tint[4];
38: int_pages = (lispval) &tint[5];
39: dtpr_items = (lispval) &tint[6];
40: dtpr_pages = (lispval) &tint[7];
41: doub_items = (lispval) &tint[8];
42: doub_pages = (lispval) &tint[9];
43: sdot_items = (lispval) &tint[10];
44: sdot_pages = (lispval) &tint[11];
45: array_items = (lispval) &tint[12];
46: array_pages = (lispval) &tint[13];
47: val_items = (lispval) &tint[14];
48: val_pages = (lispval) &tint[15];
49: funct_items = (lispval) &tint[16];
50: funct_pages = (lispval) &tint[17];
51:
52: /* This also applies to the garbage collection threshhold */
53:
54: gcthresh = (lispval) &tgcthresh;
55:
56: /* Now we commence constructing system lisp structures. */
57:
58: /* nil is a special case, constructed especially at location zero */
59:
60: hasht['n'^'i'^'l'] = (struct atom *)nil;
61:
62:
63: atom_name = matom("symbol");
64: str_name = matom("string");
65: int_name = matom("fixnum");
66: dtpr_name = matom("list");
67: doub_name = matom("flonum");
68: sdot_name = matom("bignum");
69: array_name = matom("array");
70: val_name = matom("value");
71: funct_name = matom("binary");
72:
73:
74: /* set up the name stack as an array of pointers */
75:
76: lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE));
77: nplim = orgnp+NAMESIZE-5;
78: temp = matom("namestack");
79: nstack = temp->fnbnd = newarray();
80: nstack->data = (char *) (np);
81: (nstack->length = newint())->i = NAMESIZE;
82: (nstack->delta = newint())->i = sizeof(struct argent);
83:
84: /* set up the binding stack as an array of dotted pairs */
85:
86: orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE));
87: bnplim = orgbnp+NAMESIZE-5;
88: temp = matom("bindstack");
89: bstack = temp->fnbnd = newarray();
90: bstack->data = (char *) (bnp);
91: (bstack->length = newint())->i = NAMESIZE;
92: (nstack->delta = newint())->i = sizeof(struct nament);
93:
94: /* more atoms */
95:
96: tatom = matom("t");
97: tatom->clb = tatom;
98: lambda = matom("lambda");
99: nlambda = matom("nlambda");
100: macro = matom("macro");
101: ibase = matom("ibase"); /* base for input conversion */
102: ibase->clb = inewint(10);
103: Vpiport = matom("piport");
104: Vpiport->clb = P(piport = stdin); /* standard input */
105: Vpoport = matom("poport");
106: Vpoport->clb = P(poport = stdout); /* stand. output */
107: matom("errport")->clb = (P(errport = stderr));/* stand. err. */
108: (Vreadtable = matom("readtable"))->clb = Imkrtab(0);
109: strtab = Imkrtab(0);
110:
111: /* The following atoms are used as tokens by the reader */
112:
113: perda = matom(".");
114: lpara = matom("(");
115: rpara = matom(")");
116: lbkta = matom("[");
117: rbkta = matom("]");
118: snqta = matom("'");
119: exclpa = matom("!");
120:
121:
122: (Eofa = matom("eof"))->clb = eofa;
123: cara = MK("car",Lcar,lambda);
124: cdra = MK("cdr",Lcdr,lambda);
125:
126: /* The following few atoms have values the reader tokens. */
127: /* Perhaps this is a kludge which should be abandoned. */
128: /* On the other hand, perhaps it is an inspiration. */
129:
130: matom("perd")->clb = perda;
131: matom("lpar")->clb = lpara;
132: matom("rpar")->clb = rpara;
133: matom("lbkt")->clb = lbkta;
134: matom("rbkt")->clb = rbkta;
135:
136: noptop = matom("noptop");
137:
138: /* atoms used in connection with comments. */
139:
140: commta = matom("comment");
141: rcomms = matom("readcomments");
142:
143: /* the following atoms are used for lexprs */
144:
145: lexpr_atom = matom("last lexpr binding\7");
146: lexpr = matom("lexpr");
147:
148: sysa = matom("sys");
149: plima = matom("pagelimit"); /* max number of pages */
150: Veval = MK("eval",Leval,lambda);
151: MK("asin",Lasin,lambda);
152: MK("acos",Lacos,lambda);
153: MK("atan",Latan,lambda);
154: MK("cos",Lcos,lambda);
155: MK("sin",Lsin,lambda);
156: MK("sqrt",Lsqrt,lambda);
157: MK("exp",Lexp,lambda);
158: MK("log",Llog,lambda);
159: MK("random",Lrandom,lambda);
160: MK("atom",Latom,lambda);
161: MK("apply",Lapply,lambda);
162: MK("funcall",Lfuncal,lambda);
163: MK("return",Lreturn,lambda);
164: MK("retbrk",Lretbrk,lambda);
165: MK("cont",Lreturn,lambda);
166: MK("cons",Lcons,lambda);
167: MK("scons",Lscons,lambda);
168: MK("cadr",Lcadr,lambda);
169: MK("caar",Lcaar,lambda);
170: MK("cddr",Lc02r,lambda);
171: MK("caddr",Lc12r,lambda);
172: MK("cdddr",Lc03r,lambda);
173: MK("cadddr",Lc13r,lambda);
174: MK("cddddr",Lc04r,lambda);
175: MK("caddddr",Lc14r,lambda);
176: MK("nthelem",Lnthelem,lambda);
177: MK("eq",Leq,lambda);
178: MK("equal",Lequal,lambda);
179: MK("numberp",Lnumberp,lambda);
180: MK("dtpr",Ldtpr,lambda);
181: MK("bcdp",Lbcdp,lambda);
182: MK("portp",Lportp,lambda);
183: MK("arrayp",Larrayp,lambda);
184: MK("valuep",Lvaluep,lambda);
185: MK("get_pname",Lpname,lambda);
186: MK("arrayref",Larrayref,lambda);
187: MK("marray",Lmarray,lambda);
188: MK("getlength",Lgetl,lambda);
189: MK("putlength",Lputl,lambda);
190: MK("getaccess",Lgeta,lambda);
191: MK("putaccess",Lputa,lambda);
192: MK("getdelta",Lgetdel,lambda);
193: MK("putdelta",Lputdel,lambda);
194: MK("getaux",Lgetaux,lambda);
195: MK("putaux",Lputaux,lambda);
196: MK("mfunction",Lmfunction,lambda);
197: MK("getentry",Lgetentry,lambda);
198: MK("getdisc",Lgetdisc,lambda);
199: MK("segment",Lsegment,lambda);
200: MK("rplaca",Lrplaca,lambda);
201: MK("rplacd",Lrplacd,lambda);
202: MK("set",Lset,lambda);
203: MK("replace",Lreplace,lambda);
204: MK("infile",Linfile,lambda);
205: MK("outfile",Loutfile,lambda);
206: MK("terpr",Lterpr,lambda);
207: MK("print",Lprint,lambda);
208: MK("close",Lclose,lambda);
209: MK("patom",Lpatom,lambda);
210: MK("pntlen",Lpntlen,lambda);
211: MK("read",Lread,lambda);
212: MK("ratom",Lratom,lambda);
213: MK("readc",Lreadc,lambda);
214: MK("implode",Limplode,lambda);
215: MK("maknam",Lmaknam,lambda);
216: MK("concat",Lconcat,lambda);
217: MK("uconcat",Luconcat,lambda);
218: MK("putprop",Lputprop,lambda);
219: MK("get",Lget,lambda);
220: MK("getd",Lgetd,lambda);
221: MK("putd",Lputd,lambda);
222: MK("prog",Nprog,nlambda);
223: quota = MK("quote",Nquote,nlambda);
224: MK("function",Nfunction,nlambda);
225: MK("go",Ngo,nlambda);
226: MK("*catch",Ncatch,nlambda);
227: MK("errset",Nerrset,nlambda);
228: MK("status",Nstatus,nlambda);
229: MK("sstatus",Nsstatus,nlambda);
230: MK("err",Lerr,lambda);
231: MK("*throw",Nthrow,lambda); /* this is a lambda now !! */
232: MK("reset",Nreset,nlambda);
233: MK("break",Nbreak,nlambda);
234: MK("exit",Lexit,lambda);
235: MK("def",Ndef,nlambda);
236: MK("null",Lnull,lambda);
237: MK("and",Nand,nlambda);
238: MK("or",Nor,nlambda);
239: MK("setq",Nsetq,nlambda);
240: MK("cond",Ncond,nlambda);
241: MK("list",Llist,lambda);
242: MK("load",Lload,lambda);
243: MK("nwritn",Lnwritn,lambda);
244: MK("process",Nprocess,nlambda); /* execute a shell command */
245: MK("allocate",Lalloc,lambda); /* allocate a page */
246: MK("sizeof",Lsizeof,lambda); /* size of one item of a data type */
247: MK("dumplisp",Ndumpli,nlambda); /* save the world */
248: MK("top-level",Ntpl,nlambda); /* top level eval-print read loop */
249: startup = matom("startup"); /* used by save and restore */
250: MK("mapcar",Lmapcar,lambda);
251: MK("maplist",Lmaplist,lambda);
252: MK("mapcan",Lmapcan,lambda);
253: MK("mapcon",Lmapcon,lambda);
254: MK("assq",Lassq,lambda);
255: MK("mapc",Lmapc,lambda);
256: MK("map",Lmap,lambda);
257: MK("flatsize",Lflatsi,lambda);
258: MK("alphalessp",Lalfalp,lambda);
259: MK("drain",Ldrain,lambda);
260: MK("killcopy",Lkilcopy,lambda); /* forks aand aborts for adb */
261: MK("opval",Lopval,lambda); /* sets and retrieves system variables */
262: MK("ncons",Lncons,lambda);
263: sysa = matom("sys"); /* sys indicator for system variables */
264: MK("remob",Lforget,lambda); /* function to take atom out of hash table */
265: splice = matom("splicing");
266: MK("not",Lnull,lambda);
267: MK("plus",Ladd,lambda);
268: MK("add",Ladd,lambda);
269: MK("times",Ltimes,lambda);
270: MK("difference",Lsub,lambda);
271: MK("quotient",Lquo,lambda);
272: MK("mod",Lmod,lambda);
273: MK("minus",Lminus,lambda);
274: MK("absval",Labsval,lambda);
275: MK("add1",Ladd1,lambda);
276: MK("sub1",Lsub1,lambda);
277: MK("greaterp",Lgreaterp,lambda);
278: MK("lessp",Llessp,lambda);
279: MK("zerop",Lzerop,lambda);
280: MK("minusp",Lnegp,lambda);
281: MK("onep",Lonep,lambda);
282: MK("sum",Ladd,lambda);
283: MK("product",Ltimes,lambda);
284: MK("do",Ndo,nlambda);
285: MK("progv",Nprogv,nlambda);
286: MK("progn",Nprogn,nlambda);
287: MK("prog2",Nprog2,nlambda);
288: MK("oblist",Loblist,lambda);
289: MK("baktrace",Lbaktra,lambda);
290: MK("tyi",Ltyi,lambda);
291: MK("tyipeek",Ltyipeek,lambda);
292: MK("tyo",Ltyo,lambda);
293: MK("setsyntax",Lsetsyn,lambda);
294: MK("makereadtable",Lmakertbl,lambda);
295: MK("zapline",Lzaplin,lambda);
296: MK("aexplode",Lexplda,lambda);
297: MK("aexplodec",Lexpldc,lambda);
298: MK("aexploden",Lexpldn,lambda);
299: MK("argv",Largv,lambda);
300: MK("arg",Larg,lambda);
301: MK("showstack",Lshostk,lambda);
302: MK("resetio",Nreseti,nlambda);
303: MK("chdir",Lchdir,lambda);
304: MK("ascii",Lascii,lambda);
305: MK("boole",Lboole,lambda);
306: MK("type",Ltype,lambda); /* returns type-name of argument */
307: MK("fix",Lfix,lambda);
308: MK("float",Lfloat,lambda);
309: MK("fact",Lfact,lambda);
310: MK("cpy1",Lcpy1,lambda);
311: MK("Divide",LDivide,lambda);
312: MK("Emuldiv",LEmuldiv,lambda);
313: MK("readlist",Lreadli,lambda);
314: MK("plist",Lplist,lambda); /* gives the plist of an atom */
315: MK("setplist",Lsetpli,lambda); /* get plist of an atom */
316: MK("eval-when",Nevwhen,nlambda);
317: MK("syscall",Nsyscall,nlambda);
318: MK("ptime",Lptime,lambda); /* return process user time */
319: /*
320: MK("fork",Lfork,lambda);
321: MK("wait",Lwait,lambda);
322: MK("pipe",Lpipe,lambda);
323: MK("fdopen",Lfdopen,lambda);
324: MK("exece",Lexece,lambda);
325: */
326: MK("gensym",Lgensym,lambda);
327: MK("remprop",Lremprop,lambda);
328: MK("bcdad",Lbcdad,lambda);
329: MK("symbolp",Lsymbolp,lambda);
330: MK("stringp",Lstringp,lambda);
331: MK("rematom",Lrematom,lambda);
332: MK("prname",Lprname,lambda);
333: MK("getenv",Lgetenv,lambda);
334: MK("makunbound",Lmakunb,lambda);
335: MK("haipart",Lhaipar,lambda);
336: MK("haulong",Lhau,lambda);
337: MK("signal",Lsignal,lambda);
338: MK("fasl",Lfasl,lambda); /* read in compiled file */
339: MK("bind",Lbind,lambda); /* like fasl but for functions
340: loaded in when the lisp system
341: was constructed by ld */
342: MK("boundp",Lboundp,lambda); /* tells if an atom is bound */
343: MK("fake",Lfake,lambda); /* makes a fake lisp pointer */
344: MK("od",Lod,lambda); /* dumps info */
345: MK("what",Lwhat,lambda); /* converts a pointer to an integer */
346: MK("pv%",Lpolyev,lambda); /* polynomial evaluation instruction */
347: odform = matom("odformat"); /* format for printf's used in od */
348: rdrsdot = newsdot(); /* used in io conversions of bignums */
349: rdrint = newint(); /* used as a temporary integer */
350: (nilplist = newdot())->cdr = newdot();
351: /* used as property list for nil,
352: since nil will eventually be put at
353: 0 (consequently in text and not
354: writable) */
355:
356: /* error variables */
357: (Vererr = matom("ER%err"))->clb = nil;
358: (Vertpl = matom("ER%tpl"))->clb = nil;
359: (Verall = matom("ER%all"))->clb = nil;
360: (Vermisc = matom("ER%misc"))->clb = nil;
361: (Vlerall = newdot())->car = Verall; /* list (ER%all) */
362:
363:
364: /* set up the initial status list */
365:
366: stlist = nil; /* initially nil */
367: Iaddstat(matom("features"),ST_READ,ST_NO,nil);
368: Iaddstat(matom("feature"),ST_FEATR,ST_FEATW,nil);
369: Isstatus(matom("feature"),matom("franz"));
370:
371: Iaddstat(matom("nofeature"),ST_NFETR,ST_NFETW,nil);
372: Iaddstat(matom("syntax"),ST_SYNT,ST_NO,nil);
373: Iaddstat(matom("uctolc"),ST_READ,ST_TOLC,nil);
374: Iaddstat(matom("dumpcore"),ST_READ,ST_CORE,nil);
375: Isstatus(matom("dumpcore"),nil); /*set up signals*/
376:
377: Iaddstat(matom("chainatom"),ST_RINTB,ST_INTB,inewint(0));
378: Iaddstat(matom("dumpmode"),ST_DMPR,ST_DMPW,nil);
379: /* garbage collector things */
380:
381: MK("gc",Ngc,nlambda);
382: gcafter = MK("gcafter",Ngcafter,nlambda); /* garbage collection wind-up */
383: gcport = matom("gcport"); /* port for gc dumping */
384: gccheck = matom("gccheck"); /* flag for checking during gc */
385: gcdis = matom("gcdisable"); /* option for disabling the gc */
386: gcload = matom("gcload"); /* option for gc while loading */
387: loading = matom("loading"); /* flag--in loader if = t */
388: noautot = matom("noautotrace"); /* option to inhibit auto-trace */
389: (gcthresh = newint())->i = tgcthresh;
390: gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */
391: gccall1->car = gcafter; /* start constructing a form for eval */
392:
393: arrayst = mstr("ARRAY"); /* array marker in name stack */
394: bcdst = mstr("BINARY"); /* binary function marker */
395: listst = mstr("INTERPRETED"); /* interpreted function marker */
396: macrost = mstr("MACRO"); /* macro marker */
397: protst = mstr("PROTECTED"); /* protection marker */
398: badst = mstr("BADPTR"); /* bad pointer marker */
399: argst = mstr("ARGST"); /* argument marker */
400:
401: /* type names */
402:
403: FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP);
404: FIDDLE(str_name,str_items,str_pages,STRSPP);
405: FIDDLE(int_name,int_items,int_pages,INTSPP);
406: FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP);
407: FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP);
408: FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP);
409: FIDDLE(array_name,array_items,array_pages,ARRAYSPP);
410: FIDDLE(val_name,val_items,val_pages,VALSPP);
411: FIDDLE(funct_name,funct_items,funct_pages,BCDSPP);
412:
413: (plimit = newint())->i = PAGE_LIMIT;
414: copval(plima,plimit); /* default value */
415:
416: /* the following atom is used when reading caar, cdar, etc. */
417:
418: xatom = matom("??");
419:
420: /* now it is OK to collect garbage */
421:
422: initflag = FALSE;
423: }
424:
425: /* matom("name") ******************************************************/
426: /* */
427: /* simulates an atom being read in from the reader and returns a */
428: /* pointer to it. */
429: /* */
430: /* BEWARE: if an atom becomes "truly worthless" and is collected, */
431: /* the pointer becomes obsolete. */
432: /* */
433: lispval
434: matom(string)
435: char *string;
436: {
437: strcpy(strbuf,string);
438: return(getatom());
439: }
440:
441: /* mstr ***************************************************************/
442: /* */
443: /* Makes a string. Uses matom. */
444: /* Not the most efficient but will do until the string from the code */
445: /* itself can be used as a lispval. */
446:
447: lispval mstr(string) char *string;
448: {
449: return((lispval)(inewstr(string)));
450: }
451:
452: /* mfun("name",entry) *************************************************/
453: /* */
454: /* Same as matom, but entry point to c code is associated with */
455: /* "name" as function binding. */
456: /* A pointer to the atom is returned. */
457: /* */
458: lispval mfun(string,entry,discip) char *string; lispval (*entry)(), discip;
459: {
460: lispval v;
461: v = matom(string);
462: v -> fnbnd = newfunct();
463: v->fnbnd->entry = entry;
464: v->fnbnd->discipline = discip;
465: return(v);
466: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.