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