projects / unix-history / blob
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
BSD 4_4 development
[unix-history] / usr / src / old / lisp / franz / sysat.c
#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);}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.