![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sysat.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz|
Return to sysat.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz |
1.1 ! root 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);}
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.