4.4BSD/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);}