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