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