4.3BSD - /usr/src/ucb/lisp/franz/sysat.c

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

Defined functions

Defined variables

Defined struct's

Defined macros