+#ifndef lint
+static char *rcsid =
+ "$Header: sysat.c,v 1.20 85/03/13 17:19:21 sklower Exp $";
+#endif
+
+/* -[Thu Sep 29 14:05:32 1983 by jkf]-
+ * sysat.c $Locker: $
+ * startup data structure creation
+ *
+ * (c) copyright 1982, Regents of the University of California
+ */
+
+#include "global.h"
+#include "lfuncs.h"
+#define FIDDLE(z,b,c,y) z->a.clb=newdot(); (z->a.clb->d.car=newint())->i=b->i; \
+ z->a.clb->d.cdr=newdot(); (z->a.clb->d.cdr->d.car=newint())->i=c->i; \
+ z->a.clb->d.cdr->d.cdr=newdot(); (z->a.clb->d.cdr->d.cdr->d.car=newint())->i=y; \
+ b = z->a.clb->d.car; c = z->a.clb->d.cdr->d.car; \
+ copval(z,z->a.clb); z->a.clb = nil;
+
+#define cforget(x) protect(x); Lforget(); unprot();
+
+/* The following array serves as the temporary counters of the items */
+/* and pages used in each space. */
+
+long int tint[2*NUMSPACES];
+
+extern int tgcthresh;
+extern int initflag; /* starts off TRUE to indicate unsafe to gc */
+
+extern int *beginsweep; /* place for garbage collector to begin sweeping */
+extern int page_limit; /* begin warning messages about running out of space */
+extern char purepage[]; /* which pages should not be swept by gc */
+extern int ttsize; /* need to know how much of pagetable to set to other */
+
+extern lispval Iaddstat(), Isstatus();
+lispval inewatom();
+
+makevals()
+ {
+ int i;
+ lispval temp;
+
+ /* system list structure and atoms are initialized. */
+
+ /* Before any lisp data can be created, the space usage */
+ /* counters must be set up, temporarily in array tint. */
+
+ atom_items = (lispval) &tint[0];
+ atom_pages = (lispval) &tint[1];
+ str_items = (lispval) &tint[2];
+ str_pages = (lispval) &tint[3];
+ int_items = (lispval) &tint[4];
+ int_pages = (lispval) &tint[5];
+ dtpr_items = (lispval) &tint[6];
+ dtpr_pages = (lispval) &tint[7];
+ doub_items = (lispval) &tint[8];
+ doub_pages = (lispval) &tint[9];
+ sdot_items = (lispval) &tint[10];
+ sdot_pages = (lispval) &tint[11];
+ array_items = (lispval) &tint[12];
+ array_pages = (lispval) &tint[13];
+ val_items = (lispval) &tint[14];
+ val_pages = (lispval) &tint[15];
+ funct_items = (lispval) &tint[16];
+ funct_pages = (lispval) &tint[17];
+
+ for (i=0; i < 7; i++)
+ {
+ hunk_pages[i] = (lispval) &tint[18+i*2];
+ hunk_items[i] = (lispval) &tint[19+i*2];
+ }
+
+ vect_items = (lispval) &tint[34];
+ vecti_items = (lispval) &tint[35];
+ vect_pages = (lispval) &tint[36];
+ vecti_pages = (lispval) &tint[37];
+ other_items = (lispval) &tint[38];
+ other_pages = (lispval) &tint[39];
+
+ /* This also applies to the garbage collection threshhold */
+
+ gcthresh = (lispval) &tgcthresh;
+
+ /* Now we commence constructing system lisp structures. */
+
+ /* nil is a special case, constructed especially at location zero */
+
+ hasht[hashfcn("nil")] = (struct atom *)nil;
+
+
+ /* allocate space for namestack and bindstack first
+ * then set up beginsweep variable so that the sweeper will
+ * ignore these `always in use' pages
+ */
+
+ lbot = orgnp = np = ((struct argent *)csegment(VALUE,NAMESIZE,FALSE));
+ orgbnp = bnp = ((struct nament *)csegment(DTPR,NAMESIZE,FALSE));
+ /* since these dtpr pages will not be swept, we don't want them
+ * to show up in count of dtpr pages allocated or it will confuse
+ * gcafter when it tries to determine how much space is free
+ */
+ dtpr_pages->i = 0;
+ beginsweep = (int *) xsbrk(0);
+
+ /*
+ * patching up info in type and pure tables
+ */
+#if unisys3botch
+ /*
+ * This code is in here because Schriebman made Romberger tend
+ * more important things for too long for Apple and Fateman to
+ * wait
+ */
+ {extern int dmpmode; int jj = ATOX(beginsweep);
+ dmpmode = 407; for(i=19;i < jj; i++) typetable[i] = 0; }
+#endif
+ for(i=ATOX(beginsweep); i < ttsize; i++) (typetable+1)[i] = OTHER;
+ purepage[ATOX(np)] = 1; /* Mark these as non-gc'd arrays */
+ purepage[ATOX(bnp)] = 1;
+
+ /*
+ * Names of various spaces and things
+ */
+
+ atom_name = inewatom("symbol");
+ str_name = inewatom("string");
+ int_name = inewatom("fixnum");
+ dtpr_name = inewatom("list");
+ doub_name = inewatom("flonum");
+ sdot_name = inewatom("bignum");
+ array_name = inewatom("array");
+ val_name = inewatom("value");
+ funct_name = inewatom("binary");
+ port_name = inewatom("port"); /* not really a space */
+ vect_name = inewatom("vector");
+ vecti_name = inewatom("vectori");
+ other_name = inewatom("other");
+
+ {
+ char name[6], *strcpy();
+
+ strcpy(name, "hunk0");
+ for (i=0; i< 7; i++) {
+ hunk_name[i] = matom(name);
+ name[4]++;
+ }
+ }
+
+ /* set up the name stack as an array of pointers */
+ nplim = orgnp+NAMESIZE-6*NAMINC;
+ temp = inewatom("namestack");
+ nstack = temp->a.fnbnd = newarray();
+ nstack->ar.data = (char *) (np);
+ (nstack->ar.length = newint())->i = NAMESIZE;
+ (nstack->ar.delta = newint())->i = sizeof(struct argent);
+ Vnogbar = inewatom("unmarked_array");
+ /* marking of the namestack will be done explicitly in gc1 */
+ (nstack->ar.aux = newdot())->d.car = Vnogbar;
+
+
+ /* set up the binding stack as an array of dotted pairs */
+
+ bnplim = orgbnp+NAMESIZE-5;
+ temp = inewatom("bindstack");
+ bstack = temp->a.fnbnd = newarray();
+ bstack->ar.data = (char *) (bnp);
+ (bstack->ar.length = newint())->i = NAMESIZE;
+ (bstack->ar.delta = newint())->i = sizeof(struct nament);
+ /* marking of the bindstack will be done explicitly in gc1 */
+ (bstack->ar.aux = newdot())->d.car = Vnogbar;
+
+ /* more atoms */
+
+ tatom = inewatom("t");
+ tatom->a.clb = tatom;
+ lambda = inewatom("lambda");
+ nlambda = inewatom("nlambda");
+ cara = inewatom("car");
+ cdra = inewatom("cdr");
+ Veval = inewatom("eval");
+ quota = inewatom("quote");
+ reseta = inewatom("reset");
+ gcafter = inewatom("gcafter"); /* garbage collection wind-up */
+ macro = inewatom("macro");
+ ibase = inewatom("ibase"); /* base for input conversion */
+ ibase->a.clb = inewint(10);
+ (inewatom("base"))->a.clb = ibase->a.clb;
+ fclosure = inewatom("fclosure");
+ clos_marker = inewatom("int:closure-marker");
+ Vpbv = inewatom("value-structure-argument");
+ rsetatom = inewatom("*rset");
+ rsetatom->a.clb = nil;
+ Vsubrou = inewatom("subroutine");
+ Vpiport = inewatom("piport");
+ Vpiport->a.clb = P(piport = stdin); /* standard input */
+ Vpoport = inewatom("poport");
+ Vpoport->a.clb = P(poport = stdout); /* stand. output */
+ inewatom("errport")->a.clb = (P(errport = stderr));/* stand. err. */
+ ioname[PN(stdin)] = (lispval) pinewstr("$stdin");
+ ioname[PN(stdout)] = (lispval) pinewstr("$stdout");
+ ioname[PN(stderr)] = (lispval) pinewstr("$stderr");
+ inewatom("Standard-Input")->a.clb = Vpiport->a.clb;
+ inewatom("Standard-Output")->a.clb = Vpoport->a.clb;
+ inewatom("Standard-Error")->a.clb = P(errport);
+ (Vreadtable = inewatom("readtable"))->a.clb = Imkrtab(0);
+ strtab = Imkrtab(0);
+ Vptport = inewatom("ptport");
+ Vptport->a.clb = nil; /* protocal port */
+
+ Vcntlw = inewatom("^w"); /* when non nil, inhibits output to term */
+ Vcntlw->a.clb = nil;
+
+ Vldprt = inewatom("$ldprint");
+ /* when nil, inhibits printing of fasl/autoload */
+ /* cfasl messages to term */
+ Vldprt->a.clb = tatom;
+
+ Vprinlevel = inewatom("prinlevel"); /* printer recursion count */
+ Vprinlevel->a.clb = nil; /* infinite recursion */
+
+ Vprinlength = inewatom("prinlength"); /* printer element count */
+ Vprinlength->a.clb = nil; /* infinite elements */
+
+ Vfloatformat = inewatom("float-format");
+ Vfloatformat->a.clb = (lispval) pinewstr("%.16g");
+
+ Verdepth = inewatom("Error-Depth");
+ Verdepth->a.clb = inewint(0); /* depth of error */
+
+ Vpurcopylits = inewatom("$purcopylits");
+ Vpurcopylits->a.clb = tatom; /* tells fasl to purcopy
+ * literals it reads
+ */
+ Vdisplacemacros = inewatom("displace-macros");
+ Vdisplacemacros->a.clb = nil; /* replace macros calls
+ * with their expanded forms
+ */
+
+ Vprintsym = inewatom("print");
+
+ atom_buffer = (lispval) strbuf;
+ Vlibdir = inewatom("lisp-library-directory");
+ Vlibdir->a.clb = inewatom("/usr/lib/lisp");
+ /* The following atoms are used as tokens by the reader */
+
+ perda = inewatom(".");
+ lpara = inewatom("(");
+ rpara = inewatom(")");
+ lbkta = inewatom("[");
+ rbkta = inewatom("]");
+ snqta = inewatom("'");
+ exclpa = inewatom("!");
+
+
+ (Eofa = inewatom("eof"))->a.clb = eofa;
+
+ /* The following few atoms have values the reader tokens. */
+ /* Perhaps this is a kludge which should be abandoned. */
+ /* On the other hand, perhaps it is an inspiration. */
+
+ inewatom("perd")->a.clb = perda;
+ inewatom("lpar")->a.clb = lpara;
+ inewatom("rpar")->a.clb = rpara;
+ inewatom("lbkt")->a.clb = lbkta;
+ inewatom("rbkt")->a.clb = rbkta;
+
+ noptop = inewatom("noptop");
+
+ /* atoms used in connection with comments. */
+
+ commta = inewatom("comment");
+ rcomms = inewatom("readcomments");
+
+ /* the following atoms are used for lexprs */
+
+ lexpr_atom = inewatom("last lexpr binding\7");
+ lexpr = inewatom("lexpr");
+
+ /* the following atom is used to reference the bind stack for eval */
+ bptr_atom = inewatom("eval1 binding pointer\7");
+ bptr_atom->a.clb = nil;
+
+ /* the following atoms are used for evalhook hackery */
+ evalhatom = inewatom("evalhook");
+ evalhatom->a.clb = nil;
+ evalhcallsw = FALSE;
+
+ funhatom = inewatom("funcallhook");
+ funhatom->a.clb = nil;
+ funhcallsw = FALSE;
+
+ Vevalframe = inewatom("evalframe");
+
+ sysa = inewatom("sys");
+ plima = inewatom("pagelimit"); /* max number of pages */
+
+
+ startup = inewatom("startup"); /* used by save and restore */
+ sysa = inewatom("sys"); /* sys indicator for system variables */
+ splice = inewatom("splicing");
+
+
+
+ /* vector stuff */
+
+ odform = inewatom("odformat"); /* format for printf's used in od */
+ rdrsdot = newsdot(); /* used in io conversions of bignums */
+ rdrsdot2 = newsdot(); /* used in io conversions of bignums */
+ rdrint = newint(); /* used as a temporary integer */
+ (nilplist = newdot())->d.cdr = newdot();
+ /* used as property list for nil,
+ since nil will eventually be put at
+ 0 (consequently in text and not
+ writable) */
+
+ /* error variables */
+ (Vererr = inewatom("ER%err"))->a.clb = nil;
+ (Vertpl = inewatom("ER%tpl"))->a.clb = nil;
+ (Verall = inewatom("ER%all"))->a.clb = nil;
+ (Vermisc = inewatom("ER%misc"))->a.clb = nil;
+ (Verbrk = inewatom("ER%brk"))->a.clb = nil;
+ (Verundef = inewatom("ER%undef"))->a.clb = nil;
+ (Vlerall = newdot())->d.car = Verall; /* list (ER%all) */
+ (Veruwpt = inewatom("ER%unwind-protect"))->a.clb = nil;
+ (Verrset = inewatom("errset"))->a.clb = nil;
+
+
+ /* set up the initial status list */
+
+ stlist = nil; /* initially nil */
+ {
+ lispval feature, dom;
+ Iaddstat(inewatom("features"),ST_READ,ST_NO,nil);
+ Iaddstat(feature = inewatom("feature"),ST_FEATR,ST_FEATW,nil);
+ Isstatus(feature,inewatom("franz"));
+ Isstatus(feature,inewatom("Franz"));
+ Isstatus(feature,inewatom(OS));
+ Isstatus(feature,inewatom("string"));
+ Isstatus(feature,dom = inewatom(DOMAIN));
+ Iaddstat(inewatom("domain"),ST_READ,ST_NO,dom);
+ Isstatus(feature,inewatom(MACHINE));
+#ifdef PORTABLE
+ Isstatus(feature,inewatom("portable"));
+#endif
+#ifdef unisoft
+ Isstatus(feature,inewatom("unisoft"));
+#endif
+#ifdef sun
+ Isstatus(feature,inewatom("sun"));
+#endif
+#ifdef os_masscomp
+ Isstatus(feature,inewatom("mc500"));
+#endif
+#if os_4_1c | os_4_2 | os_4_3
+ Isstatus(feature,inewatom("long-filenames"));
+#endif
+ }
+ Iaddstat(inewatom("nofeature"),ST_NFETR,ST_NFETW,nil);
+ Iaddstat(inewatom("syntax"),ST_SYNT,ST_NO,nil);
+ Iaddstat(inewatom("uctolc"),ST_READ,ST_TOLC,nil);
+ Iaddstat(inewatom("dumpcore"),ST_READ,ST_CORE,nil);
+ Isstatus(inewatom("dumpcore"),nil); /*set up signals*/
+
+ Iaddstat(inewatom("chainatom"),ST_RINTB,ST_INTB,inewint(0));
+ Iaddstat(inewatom("dumpmode"),ST_DMPR,ST_DMPW,nil);
+ Iaddstat(inewatom("appendmap"),ST_READ,ST_SET,nil); /* used by fasl */
+ Iaddstat(inewatom("debugging"),ST_READ,ST_SET,nil);
+ Iaddstat(inewatom("evalhook"),ST_RINTB,ST_INTB,inewint(3));
+ Isstatus(inewatom("evalhook"),nil); /*evalhook switch off */
+ Iaddstat(inewatom("bcdtrace"),ST_READ,ST_BCDTR,nil);
+ Iaddstat(inewatom("ctime"),ST_CTIM,ST_NO,nil);
+ Iaddstat(inewatom("localtime"),ST_LOCT,ST_NO,nil);
+ Iaddstat(inewatom("isatty"),ST_ISTTY,ST_NO,nil);
+ Iaddstat(inewatom("ignoreeof"),ST_READ,ST_SET,nil);
+ Iaddstat(inewatom("version"),ST_READ,ST_NO,mstr("Franz Lisp, Opus 38"));
+ Iaddstat(inewatom("automatic-reset"),ST_READ,ST_AUTR,nil);
+ Iaddstat(inewatom("translink"),ST_READ,ST_TRAN,nil);
+ Isstatus(inewatom("translink"),nil); /* turn off tran links */
+ Iaddstat(inewatom("undeffunc"),ST_UNDEF,ST_NO,nil); /* list undef funcs */
+ Iaddstat(inewatom("gcstrings"),ST_READ,ST_GCSTR,nil); /* gc strings */
+
+ /* garbage collector things */
+
+ gcport = inewatom("gcport"); /* port for gc dumping */
+ gccheck = inewatom("gccheck"); /* flag for checking during gc */
+ gcdis = inewatom("gcdisable"); /* variable for disabling the gc */
+ gcdis->a.clb = nil;
+ gcload = inewatom("gcload"); /* option for gc while loading */
+ loading = inewatom("loading"); /* flag--in loader if = t */
+ noautot = inewatom("noautotrace"); /* option to inhibit auto-trace */
+ Vgcprint = inewatom("$gcprint"); /* if t then pring gc messages */
+ Vgcprint->a.clb = nil;
+
+ (gcthresh = newint())->i = tgcthresh;
+ gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */
+ gccall1->d.car = gcafter; /* start constructing a form for eval */
+
+ arrayst = mstr("ARRAY"); /* array marker in name stack */
+ bcdst = mstr("BINARY"); /* binary function marker */
+ listst = mstr("INTERPRETED"); /* interpreted function marker */
+ macrost = mstr("MACRO"); /* macro marker */
+ protst = mstr("PROTECTED"); /* protection marker */
+ badst = mstr("BADPTR"); /* bad pointer marker */
+ argst = mstr("ARGST"); /* argument marker */
+ hunkfree = mstr("EMPTY"); /* empty hunk cell value */
+
+ /* type names */
+
+ FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP);
+ FIDDLE(str_name,str_items,str_pages,STRSPP);
+ FIDDLE(other_name,other_items,other_pages,STRSPP);
+ FIDDLE(int_name,int_items,int_pages,INTSPP);
+ FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP);
+ FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP);
+ FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP);
+ FIDDLE(array_name,array_items,array_pages,ARRAYSPP);
+ FIDDLE(val_name,val_items,val_pages,VALSPP);
+ FIDDLE(funct_name,funct_items,funct_pages,BCDSPP);
+
+ FIDDLE(hunk_name[0], hunk_items[0], hunk_pages[0], HUNK2SPP);
+ FIDDLE(hunk_name[1], hunk_items[1], hunk_pages[1], HUNK4SPP);
+ FIDDLE(hunk_name[2], hunk_items[2], hunk_pages[2], HUNK8SPP);
+ FIDDLE(hunk_name[3], hunk_items[3], hunk_pages[3], HUNK16SPP);
+ FIDDLE(hunk_name[4], hunk_items[4], hunk_pages[4], HUNK32SPP);
+ FIDDLE(hunk_name[5], hunk_items[5], hunk_pages[5], HUNK64SPP);
+ FIDDLE(hunk_name[6], hunk_items[6], hunk_pages[6], HUNK128SPP);
+
+ FIDDLE(vect_name, vect_items, vect_pages, VECTORSPP)
+ FIDDLE(vecti_name, vecti_items, vecti_pages, VECTORSPP)
+
+ (plimit = newint())->i = page_limit;
+ copval(plima,plimit); /* default value */
+
+ /* the following atom is used when reading caar, cdar, etc. */
+
+ xatom = inewatom("??");
+ dofuns();
+#if sun_4_1c ||sun_4_2 || sun_4_2beta
+ hookupcore();
+#endif
+ /* now it is OK to collect garbage */
+
+ initflag = FALSE;
+ }
+
+/* matom("name") ******************************************************/
+/* */
+/* simulates an atom being read in from the reader and returns a */
+/* pointer to it. */
+/* */
+/* BEWARE: if an atom becomes "truly worthless" and is collected, */
+/* the pointer becomes obsolete. */
+/* */
+lispval
+matom(string)
+char *string;
+ {
+ strbuf[0] = 0;
+ strncat(strbuf,string,STRBLEN-1); /* strcpyn always pads to n */
+ strbuf[STRBLEN-1] = 0;
+ return(getatom(TRUE));
+ }
+
+/* mstr ***************************************************************/
+/* */
+/* Makes a string. Uses matom. */
+/* Not the most efficient but will do until the string from the code */
+/* itself can be used as a lispval. */
+
+lispval mstr(string) char *string;
+ {
+ return((lispval)(pinewstr(string)));
+ }
+
+/* mfun("name",start) *************************************************/
+/* */
+/* Same as matom, but entry point to c code is associated with */
+/* "name" as function binding. */
+/* A pointer to the atom is returned. */
+/* */
+lispval mfun(string,start,discip) char *string; lispval (*start)(), discip;
+ {
+ lispval v;
+ v = inewatom(string);
+ v->a.fnbnd = newfunct();
+ v->a.fnbnd->bcd.start = start;
+ v->a.fnbnd->bcd.discipline = discip;
+ return(v);
+ }
+
+struct ftab {
+ char *string;
+ lispval (*start)();
+ lispval *discip;
+};
+
+lispval
+mftab(table)
+register struct ftab *table;
+{
+ register lispval v;
+ for(;table->string;table++) {
+ v = inewatom(table->string);
+ v = v->a.fnbnd = newfunct();
+ v->bcd.start = table->start;
+ v->bcd.discipline = *table->discip;
+ }
+}
+
+static struct ftab cfuns[] = {
+ {"car", Lcar, &(lambda)},
+ {"cdr", Lcdr, &(lambda)},
+ {"eval", Leval1, &(lambda)},
+ {"asin", Lasin, &(lambda)},
+ {"acos", Lacos, &(lambda)},
+ {"atan", Latan, &(lambda)},
+ {"cos", Lcos, &(lambda)},
+ {"sin", Lsin, &(lambda)},
+ {"sqrt", Lsqrt, &(lambda)},
+ {"exp", Lexp, &(lambda)},
+ {"log", Llog, &(lambda)},
+ {"lsh", Llsh, &(lambda)},
+ {"bignum-leftshift", Lbiglsh, &(lambda)},
+ {"sticky-bignum-leftshift", Lsbiglsh, &(lambda)},
+ {"frexp", Lfrexp, &(lambda)},
+ {"rot", Lrot, &(lambda)},
+ {"random", Lrandom, &(lambda)},
+ {"atom", Latom, &(lambda)},
+ {"apply", Lapply, &(lambda)},
+ {"funcall", Lfuncal, &(lambda)},
+ {"lexpr-funcall", Llexfun, &(lambda)},
+ {"return", Lreturn, &(lambda)},
+/* MK("cont",Lreturn,lambda), */
+ {"cons", Lcons, &(lambda)},
+ {"scons", Lscons, &(lambda)},
+ {"bignum-to-list", Lbigtol, &(lambda)},
+ {"cadr", Lcadr, &(lambda)},
+ {"caar", Lcaar, &(lambda)},
+ {"cddr", Lc02r, &(lambda)},
+ {"caddr", Lc12r, &(lambda)},
+ {"cdddr", Lc03r, &(lambda)},
+ {"cadddr", Lc13r, &(lambda)},
+ {"cddddr", Lc04r, &(lambda)},
+ {"caddddr", Lc14r, &(lambda)},
+ {"nthelem", Lnthelem, &(lambda)},
+ {"eq", Leq, &(lambda)},
+ {"equal", Lequal, &(lambda)},
+/** MK("zqual",Zequal,lambda), */
+ {"numberp", Lnumberp, &(lambda)},
+ {"dtpr", Ldtpr, &(lambda)},
+ {"bcdp", Lbcdp, &(lambda)},
+ {"portp", Lportp, &(lambda)},
+ {"arrayp", Larrayp, &(lambda)},
+ {"valuep", Lvaluep, &(lambda)},
+ {"get_pname", Lpname, &(lambda)},
+ {"ptr", Lptr, &(lambda)},
+ {"arrayref", Larayref, &(lambda)},
+ {"marray", Lmarray, &(lambda)},
+ {"getlength", Lgetl, &(lambda)},
+ {"putlength", Lputl, &(lambda)},
+ {"getaccess", Lgeta, &(lambda)},
+ {"putaccess", Lputa, &(lambda)},
+ {"getdelta", Lgetdel, &(lambda)},
+ {"putdelta", Lputdel, &(lambda)},
+ {"getaux", Lgetaux, &(lambda)},
+ {"putaux", Lputaux, &(lambda)},
+ {"getdata", Lgetdata, &(lambda)},
+ {"putdata", Lputdata, &(lambda)},
+ {"mfunction", Lmfunction, &(lambda)},
+ {"getentry", Lgtentry, &(lambda)},
+ {"getdisc", Lgetdisc, &(lambda)},
+ {"putdisc", Lputdisc, &(lambda)},
+ {"segment", Lsegment, &(lambda)},
+ {"rplaca", Lrplca, &(lambda)},
+ {"rplacd", Lrplcd, &(lambda)},
+ {"set", Lset, &(lambda)},
+ {"replace", Lreplace, &(lambda)},
+ {"infile", Linfile, &(lambda)},
+ {"outfile", Loutfile, &(lambda)},
+ {"terpr", Lterpr, &(lambda)},
+ {"print", Lprint, &(lambda)},
+ {"close", Lclose, &(lambda)},
+ {"patom", Lpatom, &(lambda)},
+ {"pntlen", Lpntlen, &(lambda)},
+ {"read", Lread, &(lambda)},
+ {"ratom", Lratom, &(lambda)},
+ {"readc", Lreadc, &(lambda)},
+ {"truename", Ltruename, &(lambda)},
+ {"implode", Limplode, &(lambda)},
+ {"maknam", Lmaknam, &(lambda)},
+ {"deref", Lderef, &(lambda)},
+ {"concat", Lconcat, &(lambda)},
+ {"uconcat", Luconcat, &(lambda)},
+ {"putprop", Lputprop, &(lambda)},
+ {"monitor", Lmonitor, &(lambda)},
+ {"get", Lget, &(lambda)},
+ {"getd", Lgetd, &(lambda)},
+ {"putd", Lputd, &(lambda)},
+ {"prog", Nprog, &(nlambda)},
+ {"quote", Nquote, &(nlambda)},
+ {"function", Nfunction, &(nlambda)},
+ {"go", Ngo, &(nlambda)},
+ {"*catch", Ncatch, &(nlambda)},
+ {"errset", Nerrset, &(nlambda)},
+ {"status", Nstatus, &(nlambda)},
+ {"sstatus", Nsstatus, &(nlambda)},
+ {"err-with-message", Lerr, &(lambda)},
+ {"*throw", Nthrow, &(lambda)}, /* this is a lambda now !! */
+ {"reset", Nreset, &(nlambda)},
+ {"break", Nbreak, &(nlambda)},
+ {"exit", Lexit, &(lambda)},
+ {"def", Ndef, &(nlambda)},
+ {"null", Lnull, &(lambda)},
+ /*{"framedump", Lframedump, &(lambda)},*/
+ {"and", Nand, &(nlambda)},
+ {"or", Nor, &(nlambda)},
+ {"setq", Nsetq, &(nlambda)},
+ {"cond", Ncond, &(nlambda)},
+ {"list", Llist, &(lambda)},
+ {"load", Lload, &(lambda)},
+ {"nwritn", Lnwritn, &(lambda)},
+ {"*process", Lprocess, &(lambda)}, /* execute a shell command */
+ {"allocate", Lalloc, &(lambda)}, /* allocate a page */
+ {"sizeof", Lsizeof, &(lambda)}, /* size of one item of a data type */
+ {"dumplisp", Ndumplisp, &(nlambda)}, /* NEW save the world */
+ {"top-level", Ntpl, &(nlambda)}, /* top level eval-print read loop */
+ {"mapcar", Lmpcar, &(lambda)},
+ {"maplist", Lmaplist, &(lambda)},
+ {"mapcan", Lmapcan, &(lambda)},
+ {"mapcon", Lmapcon, &(lambda)},
+ {"assq", Lassq, &(lambda)},
+ {"mapc", Lmapc, &(lambda)},
+ {"map", Lmap, &(lambda)},
+ {"flatc", Lflatsi, &(lambda)},
+ {"alphalessp", Lalfalp, &(lambda)},
+ {"drain", Ldrain, &(lambda)},
+ {"killcopy", Lkilcopy, &(lambda)}, /* forks aand aborts for adb */
+ {"opval", Lopval, &(lambda)}, /* sets and retrieves system variables */
+ {"ncons", Lncons, &(lambda)},
+ {"remob", Lforget, &(lambda)}, /* function to take atom out of hash table */
+ {"not", Lnull, &(lambda)},
+ {"plus", Ladd, &(lambda)},
+ {"add", Ladd, &(lambda)},
+ {"times", Ltimes, &(lambda)},
+ {"difference", Lsub, &(lambda)},
+ {"quotient", Lquo, &(lambda)},
+ {"+", Lfp, &(lambda)},
+ {"-", Lfm, &(lambda)},
+ {"*", Lft, &(lambda)},
+ {"/", Lfd, &(lambda)},
+ {"1+", Lfadd1, &(lambda)},
+ {"1-", Lfsub1, &(lambda)},
+ {"^", Lfexpt, &(lambda)},
+ {"double-to-float", Ldbtofl, &(lambda)},
+ {"float-to-double", Lfltodb, &(lambda)},
+ {"<", Lflessp, &(lambda)},
+ {"mod", Lmod, &(lambda)},
+ {"minus", Lminus, &(lambda)},
+ {"absval", Labsval, &(lambda)},
+ {"add1", Ladd1, &(lambda)},
+ {"sub1", Lsub1, &(lambda)},
+ {"greaterp", Lgreaterp, &(lambda)},
+ {"lessp", Llessp, &(lambda)},
+ {"any-zerop", Lzerop, &(lambda)}, /* used when bignum arg possible */
+ {"zerop", Lzerop, &(lambda)},
+ {"minusp", Lnegp, &(lambda)},
+ {"onep", Lonep, &(lambda)},
+ {"sum", Ladd, &(lambda)},
+ {"product", Ltimes, &(lambda)},
+ {"do", Ndo, &(nlambda)},
+ {"progv", Nprogv, &(nlambda)},
+ {"progn", Nprogn, &(nlambda)},
+ {"prog2", Nprog2, &(nlambda)},
+ {"oblist", Loblist, &(lambda)},
+ {"baktrace", Lbaktrace, &(lambda)},
+ {"tyi", Ltyi, &(lambda)},
+ {"tyipeek", Ltyipeek, &(lambda)},
+ {"untyi", Luntyi, &(lambda)},
+ {"tyo", Ltyo, &(lambda)},
+ {"termcapinit", Ltci, &(lambda)},
+ {"termcapexe", Ltcx, &(lambda)},
+ {"int:setsyntax", Lsetsyn, &(lambda)}, /* an internal function */
+ {"int:getsyntax", Lgetsyntax, &(lambda)},
+ {"int:showstack", LIshowstack, &(lambda)},
+ {"int:franz-call", LIfranzcall, &(lambda)},
+ {"makereadtable", Lmakertbl, &(lambda)},
+ {"zapline", Lzapline, &(lambda)},
+ {"aexplode", Lxplda, &(lambda)},
+ {"aexplodec", Lxpldc, &(lambda)},
+ {"aexploden", Lxpldn, &(lambda)},
+ {"hashtabstat", Lhashst, &(lambda)},
+#ifdef METER
+ {"gcstat", Lgcstat, &(lambda)},
+#endif
+ {"argv", Largv, &(lambda)},
+ {"arg", Larg, &(lambda)},
+ {"setarg", Lsetarg, &(lambda)},
+ {"showstack", Lshostk, &(lambda)},
+ {"freturn", Lfretn, &(lambda)},
+ {"*rset", Lrset, &(lambda)},
+ {"eval1", Leval1, &(lambda)},
+ {"evalframe", Levalf, &(lambda)},
+ {"evalhook", Levalhook, &(lambda)},
+ {"funcallhook", Lfunhook, &(lambda)},
+ {"int:fclosure-stack-stuff", LIfss, &(lambda)},
+ {"resetio", Nioreset, &(nlambda)},
+ {"chdir", Lchdir, &(lambda)},
+ {"ascii", Lascii, &(lambda)},
+ {"boole", Lboole, &(lambda)},
+ {"type", Ltype, &(lambda)}, /* returns type-name of argument */
+ {"fix", Lfix, &(lambda)},
+ {"float", Lfloat, &(lambda)},
+ {"fact", Lfact, &(lambda)},
+ {"cpy1", Lcpy1, &(lambda)},
+ {"Divide", LDivide, &(lambda)},
+ {"Emuldiv", LEmuldiv, &(lambda)},
+ {"readlist", Lreadli, &(lambda)},
+ {"plist", Lplist, &(lambda)}, /* gives the plist of an atom */
+ {"setplist", Lsetpli, &(lambda)}, /* get plist of an atom */
+ {"eval-when", Nevwhen, &(nlambda)},
+ {"syscall", Lsyscall, &(lambda)},
+ {"intern", Lntern, &(lambda)},
+ {"ptime", Lptime, &(lambda)}, /* return process user time */
+ {"fork", Lfork, &(lambda)}, /* turn on fork and wait */
+ {"wait", Lwait, &(lambda)},
+/* MK("pipe",Lpipe,lambda), */
+/* MK("fdopen",Lfdopen,lambda), */
+ {"exece", Lexece, &(lambda)},
+ {"gensym", Lgensym, &(lambda)},
+ {"remprop", Lremprop, &(lambda)},
+ {"bcdad", Lbcdad, &(lambda)},
+ {"symbolp", Lsymbolp, &(lambda)},
+ {"stringp", Lstringp, &(lambda)},
+ {"rematom", Lrematom, &(lambda)},
+/** MK("prname",Lprname,lambda), */
+ {"getenv", Lgetenv, &(lambda)},
+ {"I-throw-err", Lctcherr, &(lambda)}, /* directly force a throw or error */
+ {"makunbound", Lmakunb, &(lambda)},
+ {"haipart", Lhaipar, &(lambda)},
+ {"haulong", Lhau, &(lambda)},
+ {"signal", Lsignal, &(lambda)},
+ {"fasl", Lfasl, &(lambda)}, /* NEW - new fasl loader */
+ {"cfasl", Lcfasl, &(lambda)}, /* read in compiled C file */
+ {"getaddress", Lgetaddress, &(lambda)},
+ {"removeaddress", Lrmadd, &(lambda)}, /* unbind symbols */
+ {"make-c-thunk", Lmkcth, &(lambda)}, /* make wrappers */
+ {"boundp", Lboundp, &(lambda)}, /* tells if an atom is bound */
+ {"fake", Lfake, &(lambda)}, /* makes a fake lisp pointer */
+/*** MK("od",Lod,lambda), /* dumps info */
+ {"maknum", Lmaknum, &(lambda)}, /* converts a pointer to an integer */
+ {"*mod", LstarMod, &(lambda)}, /* return fixnum modulus */
+ {"*invmod", Lstarinvmod, &(lambda)}, /* return fixnum modulus ^-1 */
+ {"fseek", Lfseek, &(lambda)}, /* seek to a specific byte in a file */
+ {"fileopen", Lfileopen, &( lambda)},
+ {"pv%", Lpolyev, &(lambda)}, /* polynomial evaluation instruction*/
+ {"cprintf", Lcprintf, &(lambda)}, /* formatted print */
+ {"sprintf", Lsprintf, &(lambda)}, /* formatted print to string */
+ {"copyint*", Lcopyint, &(lambda)}, /* copyint* */
+ {"purcopy", Lpurcopy, &(lambda)}, /* pure copy */
+ {"purep", Lpurep, &(lambda)}, /* check if pure */
+ {"int:memreport", LImemory, &(lambda)}, /* dump memory stats */
+/*
+ * Hunk stuff
+ */
+ {"*makhunk", LMakhunk, &(lambda)}, /* special hunk creater */
+ {"hunkp", Lhunkp, &(lambda)}, /* test a hunk */
+ {"cxr", Lcxr, &(lambda)}, /* cxr of a hunk */
+ {"rplacx", Lrplcx, &(lambda)}, /* replace element of a hunk */
+ {"*rplacx", Lstarrpx, &(lambda)}, /* rplacx used by hunk */
+ {"hunksize", Lhunksize, &(lambda)}, /* size of a hunk */
+ {"hunk-to-list", Lhtol, &(lambda)}, /* hunk to list */
+ {"new-vector", Lnvec, &(lambda)},
+ {"new-vectori-byte", Lnvecb, &(lambda)},
+ {"new-vectori-word", Lnvecw, &(lambda)},
+ {"new-vectori-long", Lnvecl, &(lambda)},
+ {"vectorp", Lvectorp, &(lambda)},
+ {"vectorip", Lpvp, &(lambda)},
+ {"int:vref", LIvref, &(lambda)},
+ {"int:vset", LIvset, &(lambda)},
+ {"int:vsize", LIvsize, &(lambda)},
+ {"vsetprop", Lvsp, &(lambda)},
+ {"vprop", Lvprop, &(lambda)},
+ {"probef", Lprobef, &(lambda)}, /* test file existance */
+ {"substring", Lsubstring, &(lambda)},
+ {"substringn", Lsstrn, &(lambda)},
+ {"character-index", Lcharindex, &(lambda)}, /* index of char in string */
+ {"time-string", Ltymestr, &(lambda)},
+ {"gc", Ngc, &(nlambda)},
+ {"gcafter", Ngcafter, &(nlambda)}, /* garbage collection wind-up */
+ {0}
+};
+static dofuns(){mftab(cfuns);}
projects / unix-history / commitdiff