![[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] / 40BSD / cmd / lisp|
Return to sysat.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / lisp |
1.1 ! root 1: static char *sccsid = "@(#)sysat.c 34.13 11/11/80"; ! 2: ! 3: #include "global.h" ! 4: #include "lfuncs.h" ! 5: #define MK(x,y,z) mfun(x,y,z) ! 6: #define FIDDLE(z,b,c,y) z->a.clb=newdot(); (z->a.clb->d.car=newint())->i=b->i; \ ! 7: z->a.clb->d.cdr=newdot(); (z->a.clb->d.cdr->d.car=newint())->i=c->i; \ ! 8: z->a.clb->d.cdr->d.cdr=newdot(); (z->a.clb->d.cdr->d.cdr->d.car=newint())->i=y; \ ! 9: b = z->a.clb->d.car; c = z->a.clb->d.cdr->d.car; \ ! 10: copval(z,z->a.clb); z->a.clb = nil; ! 11: ! 12: #define cforget(x) protect(x); Lforget(); unprot(); ! 13: ! 14: /* The following array serves as the temporary counters of the items */ ! 15: /* and pages used in each space. */ ! 16: ! 17: long int tint[2*NUMSPACES]; ! 18: ! 19: extern int tgcthresh; ! 20: extern int initflag; /* starts off TRUE to indicate unsafe to gc */ ! 21: ! 22: extern int *beginsweep; /* place for garbage collector to begin sweeping */ ! 23: #define PAGE_LIMIT 3800 ! 24: ! 25: extern Iaddstat(); ! 26: ! 27: makevals() ! 28: { ! 29: int i; ! 30: lispval temp; ! 31: ! 32: /* system list structure and atoms are initialized. */ ! 33: ! 34: /* Before any lisp data can be created, the space usage */ ! 35: /* counters must be set up, temporarily in array tint. */ ! 36: ! 37: atom_items = (lispval) &tint[0]; ! 38: atom_pages = (lispval) &tint[1]; ! 39: str_items = (lispval) &tint[2]; ! 40: str_pages = (lispval) &tint[3]; ! 41: int_items = (lispval) &tint[4]; ! 42: int_pages = (lispval) &tint[5]; ! 43: dtpr_items = (lispval) &tint[6]; ! 44: dtpr_pages = (lispval) &tint[7]; ! 45: doub_items = (lispval) &tint[8]; ! 46: doub_pages = (lispval) &tint[9]; ! 47: sdot_items = (lispval) &tint[10]; ! 48: sdot_pages = (lispval) &tint[11]; ! 49: array_items = (lispval) &tint[12]; ! 50: array_pages = (lispval) &tint[13]; ! 51: val_items = (lispval) &tint[14]; ! 52: val_pages = (lispval) &tint[15]; ! 53: funct_items = (lispval) &tint[16]; ! 54: funct_pages = (lispval) &tint[17]; ! 55: ! 56: for (i=0; i < 8; i++) ! 57: { ! 58: hunk_pages[i] = (lispval) &tint[18+i*2]; ! 59: hunk_items[i] = (lispval) &tint[19+i*2]; ! 60: } ! 61: ! 62: /* This also applies to the garbage collection threshhold */ ! 63: ! 64: gcthresh = (lispval) &tgcthresh; ! 65: ! 66: /* Now we commence constructing system lisp structures. */ ! 67: ! 68: /* nil is a special case, constructed especially at location zero */ ! 69: ! 70: hasht[hashfcn("nil")] = (struct atom *)nil; ! 71: ! 72: /* ! 73: * Names of various spaces and things ! 74: */ ! 75: ! 76: atom_name = matom("symbol"); ! 77: str_name = matom("string"); ! 78: int_name = matom("fixnum"); ! 79: dtpr_name = matom("list"); ! 80: doub_name = matom("flonum"); ! 81: sdot_name = matom("bignum"); ! 82: array_name = matom("array"); ! 83: val_name = matom("value"); ! 84: funct_name = matom("binary"); ! 85: port_name = matom("port"); /* not really a space */ ! 86: ! 87: { ! 88: char name[6]; ! 89: ! 90: strcpy(name, "hunk0"); ! 91: for (i=0; i< 8; i++) { ! 92: hunk_name[i] = matom(name); ! 93: name[4]++; ! 94: } ! 95: } ! 96: ! 97: /* allocate space for namestack and bindstack first ! 98: * then set up beginsweep variable so that the sweeper will ! 99: * ignore these `always in use' pages ! 100: */ ! 101: ! 102: lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE,FALSE)); ! 103: orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE,FALSE)); ! 104: beginsweep = (int *) sbrk(0); ! 105: ! 106: /* set up the name stack as an array of pointers */ ! 107: nplim = orgnp+NAMESIZE-6*NAMINC; ! 108: temp = matom("namestack"); ! 109: nstack = temp->a.fnbnd = newarray(); ! 110: nstack->ar.data = (char *) (np); ! 111: (nstack->ar.length = newint())->i = NAMESIZE; ! 112: (nstack->ar.delta = newint())->i = sizeof(struct argent); ! 113: Vnogbar = matom("unmarked_array"); ! 114: /* marking of the namestack will be done explicitly in gc1 */ ! 115: (nstack->ar.aux = newdot())->d.car = Vnogbar; ! 116: ! 117: ! 118: /* set up the binding stack as an array of dotted pairs */ ! 119: ! 120: bnplim = orgbnp+NAMESIZE-5; ! 121: temp = matom("bindstack"); ! 122: bstack = temp->a.fnbnd = newarray(); ! 123: bstack->ar.data = (char *) (bnp); ! 124: (bstack->ar.length = newint())->i = NAMESIZE; ! 125: (bstack->ar.delta = newint())->i = sizeof(struct nament); ! 126: /* marking of the bindstack will be done explicitly in gc1 */ ! 127: (bstack->ar.aux = newdot())->d.car = Vnogbar; ! 128: ! 129: /* more atoms */ ! 130: ! 131: tatom = matom("t"); ! 132: tatom->a.clb = tatom; ! 133: lambda = matom("lambda"); ! 134: nlambda = matom("nlambda"); ! 135: macro = matom("macro"); ! 136: ibase = matom("ibase"); /* base for input conversion */ ! 137: ibase->a.clb = inewint(10); ! 138: rsetatom = matom("*rset"); ! 139: rsetatom->a.clb = nil; ! 140: Vsubrou = matom("subroutine"); ! 141: Vpiport = matom("piport"); ! 142: Vpiport->a.clb = P(piport = stdin); /* standard input */ ! 143: Vpoport = matom("poport"); ! 144: Vpoport->a.clb = P(poport = stdout); /* stand. output */ ! 145: matom("errport")->a.clb = (P(errport = stderr));/* stand. err. */ ! 146: ioname[PN(stdin)] = (lispval) inewstr("$stdin"); ! 147: ioname[PN(stdout)] = (lispval) inewstr("$stdout"); ! 148: ioname[PN(stderr)] = (lispval) inewstr("$stderr"); ! 149: (Vreadtable = matom("readtable"))->a.clb = Imkrtab(0); ! 150: strtab = Imkrtab(0); ! 151: Vptport = matom("ptport"); ! 152: Vptport->a.clb = nil; /* protocal port */ ! 153: ! 154: Vcntlw = matom("^w"); /* when non nil, inhibits output to term */ ! 155: Vcntlw->a.clb = nil; ! 156: ! 157: Vprinlevel = matom("prinlevel"); /* printer recursion count */ ! 158: Vprinlevel->a.clb = nil; /* infinite recursion */ ! 159: ! 160: Vprinlength = matom("prinlength"); /* printer element count */ ! 161: Vprinlength->a.clb = nil; /* infinite elements */ ! 162: /* The following atoms are used as tokens by the reader */ ! 163: ! 164: perda = matom("."); ! 165: lpara = matom("("); ! 166: rpara = matom(")"); ! 167: lbkta = matom("["); ! 168: rbkta = matom("]"); ! 169: snqta = matom("'"); ! 170: exclpa = matom("!"); ! 171: ! 172: ! 173: (Eofa = matom("eof"))->a.clb = eofa; ! 174: cara = MK("car",Lcar,lambda); ! 175: cdra = MK("cdr",Lcdr,lambda); ! 176: ! 177: /* The following few atoms have values the reader tokens. */ ! 178: /* Perhaps this is a kludge which should be abandoned. */ ! 179: /* On the other hand, perhaps it is an inspiration. */ ! 180: ! 181: matom("perd")->a.clb = perda; ! 182: matom("lpar")->a.clb = lpara; ! 183: matom("rpar")->a.clb = rpara; ! 184: matom("lbkt")->a.clb = lbkta; ! 185: matom("rbkt")->a.clb = rbkta; ! 186: ! 187: noptop = matom("noptop"); ! 188: ! 189: /* atoms used in connection with comments. */ ! 190: ! 191: commta = matom("comment"); ! 192: rcomms = matom("readcomments"); ! 193: ! 194: /* the following atoms are used for lexprs */ ! 195: ! 196: lexpr_atom = matom("last lexpr binding\7"); ! 197: lexpr = matom("lexpr"); ! 198: ! 199: /* the following atom is used to reference the bind stack for eval */ ! 200: bptr_atom = matom("eval1 binding pointer\7"); ! 201: bptr_atom->a.clb = nil; ! 202: ! 203: /* the following atoms are used for evalhook hackery */ ! 204: evalhatom = matom("evalhook"); ! 205: evalhatom->a.clb = nil; ! 206: evalhcall = matom("evalhook call flag\7"); ! 207: ! 208: sysa = matom("sys"); ! 209: plima = matom("pagelimit"); /* max number of pages */ ! 210: Veval = MK("eval",Leval1,lambda); ! 211: MK("asin",Lasin,lambda); ! 212: MK("acos",Lacos,lambda); ! 213: MK("atan",Latan,lambda); ! 214: MK("cos",Lcos,lambda); ! 215: MK("sin",Lsin,lambda); ! 216: MK("sqrt",Lsqrt,lambda); ! 217: MK("exp",Lexp,lambda); ! 218: MK("log",Llog,lambda); ! 219: MK("lsh",Llsh,lambda); ! 220: MK("rot",Lrot,lambda); ! 221: MK("random",Lrandom,lambda); ! 222: MK("atom",Latom,lambda); ! 223: MK("apply",Lapply,lambda); ! 224: MK("funcall",Lfuncal,lambda); ! 225: MK("return",Lreturn,lambda); ! 226: MK("retbrk",Lretbrk,lambda); ! 227: /* MK("cont",Lreturn,lambda); */ ! 228: MK("cons",Lcons,lambda); ! 229: MK("scons",Lscons,lambda); ! 230: MK("cadr",Lcadr,lambda); ! 231: MK("caar",Lcaar,lambda); ! 232: MK("cddr",Lc02r,lambda); ! 233: MK("caddr",Lc12r,lambda); ! 234: MK("cdddr",Lc03r,lambda); ! 235: MK("cadddr",Lc13r,lambda); ! 236: MK("cddddr",Lc04r,lambda); ! 237: MK("caddddr",Lc14r,lambda); ! 238: MK("nthelem",Lnthelem,lambda); ! 239: MK("eq",Leq,lambda); ! 240: MK("equal",Lequal,lambda); ! 241: MK("zqual",Zequal,lambda); ! 242: MK("numberp",Lnumberp,lambda); ! 243: MK("dtpr",Ldtpr,lambda); ! 244: MK("bcdp",Lbcdp,lambda); ! 245: MK("portp",Lportp,lambda); ! 246: MK("arrayp",Larrayp,lambda); ! 247: MK("valuep",Lvaluep,lambda); ! 248: MK("get_pname",Lpname,lambda); ! 249: MK("ptr",Lptr,lambda); ! 250: MK("arrayref",Larrayref,lambda); ! 251: MK("marray",Lmarray,lambda); ! 252: MK("getlength",Lgetl,lambda); ! 253: MK("putlength",Lputl,lambda); ! 254: MK("getaccess",Lgeta,lambda); ! 255: MK("putaccess",Lputa,lambda); ! 256: MK("getdelta",Lgetdel,lambda); ! 257: MK("putdelta",Lputdel,lambda); ! 258: MK("getaux",Lgetaux,lambda); ! 259: MK("putaux",Lputaux,lambda); ! 260: MK("getdata",Lgetdata,lambda); ! 261: MK("putdata",Lputdata,lambda); ! 262: MK("mfunction",Lmfunction,lambda); ! 263: MK("getentry",Lgetentry,lambda); ! 264: MK("getdisc",Lgetdisc,lambda); ! 265: MK("putdisc",Lputdisc,lambda); ! 266: MK("segment",Lsegment,lambda); ! 267: MK("rplaca",Lrplaca,lambda); ! 268: MK("rplacd",Lrplacd,lambda); ! 269: MK("set",Lset,lambda); ! 270: MK("replace",Lreplace,lambda); ! 271: MK("infile",Linfile,lambda); ! 272: MK("outfile",Loutfile,lambda); ! 273: MK("terpr",Lterpr,lambda); ! 274: MK("print",Lprint,lambda); ! 275: MK("close",Lclose,lambda); ! 276: MK("patom",Lpatom,lambda); ! 277: MK("pntlen",Lpntlen,lambda); ! 278: MK("read",Lread,lambda); ! 279: MK("ratom",Lratom,lambda); ! 280: MK("readc",Lreadc,lambda); ! 281: MK("implode",Limplode,lambda); ! 282: MK("maknam",Lmaknam,lambda); ! 283: MK("concat",Lconcat,lambda); ! 284: MK("uconcat",Luconcat,lambda); ! 285: MK("putprop",Lputprop,lambda); ! 286: MK("monitor",Lmonitor,lambda); ! 287: MK("get",Lget,lambda); ! 288: MK("getd",Lgetd,lambda); ! 289: MK("putd",Lputd,lambda); ! 290: MK("prog",Nprog,nlambda); ! 291: quota = MK("quote",Nquote,nlambda); ! 292: MK("function",Nfunction,nlambda); ! 293: MK("go",Ngo,nlambda); ! 294: MK("*catch",Ncatch,nlambda); ! 295: MK("errset",Nerrset,nlambda); ! 296: MK("status",Nstatus,nlambda); ! 297: MK("sstatus",Nsstatus,nlambda); ! 298: MK("err",Lerr,lambda); ! 299: MK("*throw",Nthrow,lambda); /* this is a lambda now !! */ ! 300: reseta = MK("reset",Nreset,nlambda); ! 301: MK("break",Nbreak,nlambda); ! 302: MK("exit",Lexit,lambda); ! 303: MK("def",Ndef,nlambda); ! 304: MK("null",Lnull,lambda); ! 305: MK("and",Nand,nlambda); ! 306: MK("or",Nor,nlambda); ! 307: MK("setq",Nsetq,nlambda); ! 308: MK("cond",Ncond,nlambda); ! 309: MK("list",Llist,lambda); ! 310: MK("load",Lload,lambda); ! 311: MK("nwritn",Lnwritn,lambda); ! 312: MK("process",Nprocess,nlambda); /* execute a shell command */ ! 313: MK("allocate",Lalloc,lambda); /* allocate a page */ ! 314: MK("sizeof",Lsizeof,lambda); /* size of one item of a data type */ ! 315: MK("odumplisp",Ndumplisp,nlambda); /* OLD save the world */ ! 316: MK("dumplisp",Nndumplisp,nlambda); /* NEW save the world */ ! 317: #ifdef VMS ! 318: MK("savelisp",Lsavelsp,lambda); /* save lisp data */ ! 319: MK("restorelisp",Lrestlsp,lambda); ! 320: #endif ! 321: MK("top-level",Ntpl,nlambda); /* top level eval-print read loop */ ! 322: startup = matom("startup"); /* used by save and restore */ ! 323: MK("mapcar",Lmapcar,lambda); ! 324: MK("maplist",Lmaplist,lambda); ! 325: MK("mapcan",Lmapcan,lambda); ! 326: MK("mapcon",Lmapcon,lambda); ! 327: MK("assq",Lassq,lambda); ! 328: MK("mapc",Lmapc,lambda); ! 329: MK("map",Lmap,lambda); ! 330: MK("flatc",Lflatsi,lambda); ! 331: MK("alphalessp",Lalfalp,lambda); ! 332: MK("drain",Ldrain,lambda); ! 333: MK("killcopy",Lkilcopy,lambda); /* forks aand aborts for adb */ ! 334: MK("opval",Lopval,lambda); /* sets and retrieves system variables */ ! 335: MK("ncons",Lncons,lambda); ! 336: sysa = matom("sys"); /* sys indicator for system variables */ ! 337: MK("remob",Lforget,lambda); /* function to take atom out of hash table */ ! 338: splice = matom("splicing"); ! 339: MK("not",Lnull,lambda); ! 340: MK("plus",Ladd,lambda); ! 341: MK("add",Ladd,lambda); ! 342: MK("times",Ltimes,lambda); ! 343: MK("difference",Lsub,lambda); ! 344: MK("quotient",Lquo,lambda); ! 345: MK("mod",Lmod,lambda); ! 346: MK("minus",Lminus,lambda); ! 347: MK("absval",Labsval,lambda); ! 348: MK("add1",Ladd1,lambda); ! 349: MK("sub1",Lsub1,lambda); ! 350: MK("greaterp",Lgreaterp,lambda); ! 351: MK("lessp",Llessp,lambda); ! 352: MK("any-zerop",Lzerop,lambda); /* used when bignum arg possible */ ! 353: MK("zerop",Lzerop,lambda); ! 354: MK("minusp",Lnegp,lambda); ! 355: MK("onep",Lonep,lambda); ! 356: MK("sum",Ladd,lambda); ! 357: MK("product",Ltimes,lambda); ! 358: MK("do",Ndo,nlambda); ! 359: MK("progv",Nprogv,nlambda); ! 360: MK("progn",Nprogn,nlambda); ! 361: MK("prog2",Nprog2,nlambda); ! 362: MK("oblist",Loblist,lambda); ! 363: MK("baktrace",Lbaktrace,lambda); ! 364: MK("tyi",Ltyi,lambda); ! 365: MK("tyipeek",Ltyipeek,lambda); ! 366: MK("tyo",Ltyo,lambda); ! 367: MK("setsyntax",Lsetsyn,lambda); ! 368: MK("makereadtable",Lmakertbl,lambda); ! 369: MK("zapline",Lzapline,lambda); ! 370: MK("aexplode",Lexplda,lambda); ! 371: MK("aexplodec",Lexpldc,lambda); ! 372: MK("aexploden",Lexpldn,lambda); ! 373: MK("hashtabstat",Lhashst,lambda); ! 374: #ifdef METER ! 375: MK("gcstat",Lgcstat,lambda); ! 376: #endif ! 377: MK("argv",Largv,lambda); ! 378: MK("arg",Larg,lambda); ! 379: MK("setarg",Lsetarg,lambda); ! 380: MK("showstack",Lshostk,lambda); ! 381: MK("freturn",Lfretn,lambda); ! 382: MK("*rset",Lrset,lambda); ! 383: MK("eval1",Leval1,lambda); ! 384: MK("evalframe",Levalf,lambda); ! 385: MK("evalhook",Levalhook,lambda); ! 386: MK("resetio",Nresetio,nlambda); ! 387: MK("chdir",Lchdir,lambda); ! 388: MK("ascii",Lascii,lambda); ! 389: MK("boole",Lboole,lambda); ! 390: MK("type",Ltype,lambda); /* returns type-name of argument */ ! 391: MK("fix",Lfix,lambda); ! 392: MK("float",Lfloat,lambda); ! 393: MK("fact",Lfact,lambda); ! 394: MK("cpy1",Lcpy1,lambda); ! 395: MK("Divide",LDivide,lambda); ! 396: MK("Emuldiv",LEmuldiv,lambda); ! 397: MK("readlist",Lreadli,lambda); ! 398: MK("plist",Lplist,lambda); /* gives the plist of an atom */ ! 399: MK("setplist",Lsetpli,lambda); /* get plist of an atom */ ! 400: MK("eval-when",Nevwhen,nlambda); ! 401: MK("syscall",Lsyscall,lambda); ! 402: MK("intern",Lintern,lambda); ! 403: MK("ptime",Lptime,lambda); /* return process user time */ ! 404: /* ! 405: MK("fork",Lfork,lambda); ! 406: MK("wait",Lwait,lambda); ! 407: MK("pipe",Lpipe,lambda); ! 408: MK("fdopen",Lfdopen,lambda); ! 409: */ ! 410: MK("exece",Lexece,lambda); ! 411: MK("gensym",Lgensym,lambda); ! 412: MK("remprop",Lremprop,lambda); ! 413: MK("bcdad",Lbcdad,lambda); ! 414: MK("symbolp",Lsymbolp,lambda); ! 415: MK("stringp",Lstringp,lambda); ! 416: MK("rematom",Lrematom,lambda); ! 417: MK("prname",Lprname,lambda); ! 418: MK("getenv",Lgetenv,lambda); ! 419: MK("I-throw-err",Lctcherr,lambda); /* directly force a throw or error */ ! 420: MK("makunbound",Lmakunb,lambda); ! 421: MK("haipart",Lhaipar,lambda); ! 422: MK("haulong",Lhau,lambda); ! 423: MK("signal",Lsignal,lambda); ! 424: MK("fasl",Lnfasl,lambda); /* NEW - new fasl loader */ ! 425: MK("cfasl",Lcfasl,lambda); /* read in compiled C file */ ! 426: MK("getaddress",Lgetaddress,lambda); ! 427: /* bind symbols without doing cfasl */ ! 428: MK("boundp",Lboundp,lambda); /* tells if an atom is bound */ ! 429: MK("fake",Lfake,lambda); /* makes a fake lisp pointer */ ! 430: MK("od",Lod,lambda); /* dumps info */ ! 431: MK("maknum",Lmaknum,lambda); /* converts a pointer to an integer */ ! 432: MK("*mod",LstarMod,lambda); /* return fixnum modulus */ ! 433: ! 434: MK("fseek",Lfseek,lambda); /* seek to a specific byte in a file */ ! 435: MK("fileopen", Lfileopen, lambda); ! 436: /* open a file for read/write/append */ ! 437: ! 438: MK("pv%",Lpolyev,lambda); /* polynomial evaluation instruction */ ! 439: MK("cprintf",Lcprintf,lambda); /* formatted print */ ! 440: MK("copyint*",Lcopyint,lambda); /* copyint* */ ! 441: ! 442: /* ! 443: * Hunk stuff ! 444: */ ! 445: ! 446: MK("*makhunk",LMakhunk,lambda); /* special hunk creater */ ! 447: MK("hunkp",Lhunkp,lambda); /* test a hunk */ ! 448: MK("cxr",Lcxr,lambda); /* cxr of a hunk */ ! 449: MK("rplacx",Lrplacx,lambda); /* replace element of a hunk */ ! 450: MK("*rplacx",Lstarrpx,lambda); /* rplacx used by hunk */ ! 451: MK("hunksize",Lhunksize,lambda); /* size of a hunk */ ! 452: ! 453: MK("probef",Lprobef,lambda); /* test file existance */ ! 454: MK("substring",Lsubstring,lambda); ! 455: MK("substringn",Lsubstringn,lambda); ! 456: odform = matom("odformat"); /* format for printf's used in od */ ! 457: rdrsdot = newsdot(); /* used in io conversions of bignums */ ! 458: rdrsdot2 = newsdot(); /* used in io conversions of bignums */ ! 459: rdrint = newint(); /* used as a temporary integer */ ! 460: (nilplist = newdot())->d.cdr = newdot(); ! 461: /* used as property list for nil, ! 462: since nil will eventually be put at ! 463: 0 (consequently in text and not ! 464: writable) */ ! 465: ! 466: /* error variables */ ! 467: (Vererr = matom("ER%err"))->a.clb = nil; ! 468: (Vertpl = matom("ER%tpl"))->a.clb = nil; ! 469: (Verall = matom("ER%all"))->a.clb = nil; ! 470: (Vermisc = matom("ER%misc"))->a.clb = nil; ! 471: (Verbrk = matom("ER%brk"))->a.clb = nil; ! 472: (Verundef = matom("ER%undef"))->a.clb = nil; ! 473: (Vlerall = newdot())->d.car = Verall; /* list (ER%all) */ ! 474: (Veruwpt = matom("ER%unwind-protect"))->a.clb = nil; ! 475: (Verrset = matom("errset"))->a.clb = nil; ! 476: ! 477: ! 478: /* set up the initial status list */ ! 479: ! 480: stlist = nil; /* initially nil */ ! 481: Iaddstat(matom("features"),ST_READ,ST_NO,nil); ! 482: Iaddstat(matom("feature"),ST_FEATR,ST_FEATW,nil); ! 483: Isstatus(matom("feature"),matom("franz")); ! 484: Isstatus(matom("feature"),matom(OS)); ! 485: Isstatus(matom("feature"),matom("string")); ! 486: Isstatus(matom("feature"),matom(MACHINE)); ! 487: Isstatus(matom("feature"),matom(SITE)); ! 488: ! 489: Iaddstat(matom("nofeature"),ST_NFETR,ST_NFETW,nil); ! 490: Iaddstat(matom("syntax"),ST_SYNT,ST_NO,nil); ! 491: Iaddstat(matom("uctolc"),ST_READ,ST_TOLC,nil); ! 492: Iaddstat(matom("dumpcore"),ST_READ,ST_CORE,nil); ! 493: Isstatus(matom("dumpcore"),nil); /*set up signals*/ ! 494: ! 495: Iaddstat(matom("chainatom"),ST_RINTB,ST_INTB,inewint(0)); ! 496: Iaddstat(matom("dumpmode"),ST_DMPR,ST_DMPW,nil); ! 497: Iaddstat(matom("appendmap"),ST_READ,ST_SET,nil); /* used by fasl */ ! 498: Iaddstat(matom("debugging"),ST_READ,ST_SET,nil); ! 499: Iaddstat(matom("evalhook"),ST_RINTB,ST_INTB,inewint(3)); ! 500: Isstatus(matom("evalhook"),nil); /*evalhook switch off */ ! 501: Iaddstat(matom("bcdtrace"),ST_READ,ST_BCDTR,nil); ! 502: Iaddstat(matom("ctime"),ST_CTIM,ST_NO,nil); ! 503: Iaddstat(matom("localtime"),ST_LOCT,ST_NO,nil); ! 504: Iaddstat(matom("isatty"),ST_ISTTY,ST_NO,nil); ! 505: Iaddstat(matom("ignoreeof"),ST_READ,ST_SET,nil); ! 506: Iaddstat(matom("version"),ST_READ,ST_NO,mstr("Franz Lisp, Opus 34")); ! 507: Iaddstat(matom("automatic-reset"),ST_READ,ST_AUTR,nil); ! 508: Iaddstat(matom("translink"),ST_READ,ST_TRAN,nil); ! 509: Isstatus(matom("translink"),tatom); /* turn on tran links */ ! 510: Iaddstat(matom("undeffunc"),ST_UNDEF,ST_NO,nil); /* list undef funcs */ ! 511: ! 512: /* garbage collector things */ ! 513: ! 514: MK("gc",Ngc,nlambda); ! 515: gcafter = MK("gcafter",Ngcafter,nlambda); /* garbage collection wind-up */ ! 516: gcport = matom("gcport"); /* port for gc dumping */ ! 517: gccheck = matom("gccheck"); /* flag for checking during gc */ ! 518: gcdis = matom("gcdisable"); /* variable for disabling the gc */ ! 519: gcdis->a.clb = nil; ! 520: gcload = matom("gcload"); /* option for gc while loading */ ! 521: loading = matom("loading"); /* flag--in loader if = t */ ! 522: noautot = matom("noautotrace"); /* option to inhibit auto-trace */ ! 523: (gcthresh = newint())->i = tgcthresh; ! 524: gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */ ! 525: gccall1->d.car = gcafter; /* start constructing a form for eval */ ! 526: ! 527: arrayst = mstr("ARRAY"); /* array marker in name stack */ ! 528: bcdst = mstr("BINARY"); /* binary function marker */ ! 529: listst = mstr("INTERPRETED"); /* interpreted function marker */ ! 530: macrost = mstr("MACRO"); /* macro marker */ ! 531: protst = mstr("PROTECTED"); /* protection marker */ ! 532: badst = mstr("BADPTR"); /* bad pointer marker */ ! 533: argst = mstr("ARGST"); /* argument marker */ ! 534: hunkfree = mstr("EMPTY"); /* empty hunk cell value */ ! 535: ! 536: /* type names */ ! 537: ! 538: FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP); ! 539: FIDDLE(str_name,str_items,str_pages,STRSPP); ! 540: FIDDLE(int_name,int_items,int_pages,INTSPP); ! 541: FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP); ! 542: FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP); ! 543: FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP); ! 544: FIDDLE(array_name,array_items,array_pages,ARRAYSPP); ! 545: FIDDLE(val_name,val_items,val_pages,VALSPP); ! 546: FIDDLE(funct_name,funct_items,funct_pages,BCDSPP); ! 547: ! 548: FIDDLE(hunk_name[0], hunk_items[0], hunk_pages[0], HUNK2SPP); ! 549: FIDDLE(hunk_name[1], hunk_items[1], hunk_pages[1], HUNK4SPP); ! 550: FIDDLE(hunk_name[2], hunk_items[2], hunk_pages[2], HUNK8SPP); ! 551: FIDDLE(hunk_name[3], hunk_items[3], hunk_pages[3], HUNK16SPP); ! 552: FIDDLE(hunk_name[4], hunk_items[4], hunk_pages[4], HUNK32SPP); ! 553: FIDDLE(hunk_name[5], hunk_items[5], hunk_pages[5], HUNK64SPP); ! 554: FIDDLE(hunk_name[6], hunk_items[6], hunk_pages[6], HUNK128SPP); ! 555: ! 556: (plimit = newint())->i = PAGE_LIMIT; ! 557: copval(plima,plimit); /* default value */ ! 558: ! 559: /* the following atom is used when reading caar, cdar, etc. */ ! 560: ! 561: xatom = matom("??"); ! 562: ! 563: /* now it is OK to collect garbage */ ! 564: ! 565: initflag = FALSE; ! 566: } ! 567: ! 568: /* matom("name") ******************************************************/ ! 569: /* */ ! 570: /* simulates an atom being read in from the reader and returns a */ ! 571: /* pointer to it. */ ! 572: /* */ ! 573: /* BEWARE: if an atom becomes "truly worthless" and is collected, */ ! 574: /* the pointer becomes obsolete. */ ! 575: /* */ ! 576: lispval ! 577: matom(string) ! 578: char *string; ! 579: { ! 580: strbuf[0] = 0; ! 581: strcatn(strbuf,string,STRBLEN); ! 582: return(getatom()); ! 583: } ! 584: ! 585: /* mstr ***************************************************************/ ! 586: /* */ ! 587: /* Makes a string. Uses matom. */ ! 588: /* Not the most efficient but will do until the string from the code */ ! 589: /* itself can be used as a lispval. */ ! 590: ! 591: lispval mstr(string) char *string; ! 592: { ! 593: return((lispval)(inewstr(string))); ! 594: } ! 595: ! 596: /* mfun("name",entry) *************************************************/ ! 597: /* */ ! 598: /* Same as matom, but entry point to c code is associated with */ ! 599: /* "name" as function binding. */ ! 600: /* A pointer to the atom is returned. */ ! 601: /* */ ! 602: lispval mfun(string,entry,discip) char *string; lispval (*entry)(), discip; ! 603: { ! 604: lispval v; ! 605: v = matom(string); ! 606: v->a.fnbnd = newfunct(); ! 607: v->a.fnbnd->bcd.entry = entry; ! 608: v->a.fnbnd->bcd.discipline = discip; ! 609: return(v); ! 610: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.