projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 3 development
[unix-history] / usr / src / cmd / lisp / sysat.c
CommitLineData
654e6e2d
JF		 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
15long int tint[18]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
16
17long int tgcthresh = 15;
18int initflag = TRUE; /* starts off TRUE to indicate unsafe to gc */
19
20#define PAGE_LIMIT 3800
21
22extern Iaddstat();
23
24makevals()
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/* */
433lispval
434matom(string)
435char *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
447lispval 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/* */
458lispval 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 }
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.