"$Header: sysat.c,v 1.20 85/03/13 17:19:21 sklower Exp $";
/* -[Thu Sep 29 14:05:32 1983 by jkf]-
* startup data structure creation
* (c) copyright 1982, Regents of the University of California
#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 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();
/* 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];
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
beginsweep
= (int *) xsbrk(0);
* patching up info in type and pure tables
* This code is in here because Schriebman made Romberger tend
* more important things for too long for Apple and Fateman to
{extern int dmpmode
; int jj
= ATOX(beginsweep
);
dmpmode
= 407; for(i
=19;i
< jj
; i
++) typetable
[i
] = 0; }
for(i
=ATOX(beginsweep
); i
< ttsize
; i
++) (typetable
+1)[i
] = OTHER
;
purepage
[ATOX(np
)] = 1; /* Mark these as non-gc'd arrays */
* 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");
hunk_name
[i
] = matom(name
);
/* 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
;
lambda
= inewatom("lambda");
nlambda
= inewatom("nlambda");
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");
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);
Vptport
= inewatom("ptport");
Vptport
->a
.clb
= nil
; /* protocal port */
Vcntlw
= inewatom("^w"); /* when non nil, inhibits output to term */
Vldprt
= inewatom("$ldprint");
/* when nil, inhibits printing of fasl/autoload */
/* cfasl messages to term */
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
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 */
(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");
/* the following atoms are used for evalhook hackery */
evalhatom
= inewatom("evalhook");
funhatom
= inewatom("funcallhook");
Vevalframe
= inewatom("evalframe");
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");
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
(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 */
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
));
Isstatus(feature
,inewatom("portable"));
Isstatus(feature
,inewatom("unisoft"));
Isstatus(feature
,inewatom("sun"));
Isstatus(feature
,inewatom("mc500"));
#if os_4_1c | os_4_2 | os_4_3
Isstatus(feature
,inewatom("long-filenames"));
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 */
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 */
(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 */
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. */
#if sun_4_1c ||sun_4_2 || sun_4_2beta
/* now it is OK to collect garbage */
/* matom("name") ******************************************************/
/* simulates an atom being read in from the reader and returns a */
/* BEWARE: if an atom becomes "truly worthless" and is collected, */
/* the pointer becomes obsolete. */
strncat(strbuf
,string
,STRBLEN
-1); /* strcpyn always pads to n */
/* 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
;
v
->a
.fnbnd
->bcd
.start
= start
;
v
->a
.fnbnd
->bcd
.discipline
= discip
;
register struct ftab
*table
;
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
)},
{"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
)},
{"*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
)},
{"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
)},
{"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
)},
{"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
)},
{"gcstat", Lgcstat
, &(lambda
)},
{"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 */
{"*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
)},
{"gcafter", Ngcafter
, &(nlambda
)}, /* garbage collection wind-up */
static dofuns(){mftab(cfuns
);}