![[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] / 3BSD / cmd / lisp|
Return to sysat.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 ! root 1: #include "global.h" ! 2: #include "lfuncs.h" ! 3: #define MK(x,y,z) mfun(x,y,z) ! 4: #define FIDDLE(a,b,c,d) a->clb=newdot(); (a->clb->car=newint())->i=b->i; \ ! 5: a->clb->cdr=newdot(); (a->clb->cdr->car=newint())->i=c->i; \ ! 6: a->clb->cdr->cdr=newdot(); (a->clb->cdr->cdr->car=newint())->i=d; \ ! 7: b = a->clb->car; c = a->clb->cdr->car; \ ! 8: copval(a,a->clb); a->clb = nil; ! 9: ! 10: #define cforget(x) protect(x); Lforget(); unprot(); ! 11: ! 12: /* The following array serves as the temporary counters of the items */ ! 13: /* and pages used in each space. */ ! 14: ! 15: long int tint[18]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; ! 16: ! 17: long int tgcthresh = 15; ! 18: int initflag = TRUE; /* starts off TRUE to indicate unsafe to gc */ ! 19: ! 20: #define PAGE_LIMIT 3800 ! 21: ! 22: extern Iaddstat(); ! 23: ! 24: makevals() ! 25: { ! 26: lispval temp; ! 27: ! 28: /* system list structure and atoms are initialized. */ ! 29: ! 30: /* Before any lisp data can be created, the space usage */ ! 31: /* counters must be set up, temporarily in array tint. */ ! 32: ! 33: atom_items = (lispval) &tint[0]; ! 34: atom_pages = (lispval) &tint[1]; ! 35: str_items = (lispval) &tint[2]; ! 36: str_pages = (lispval) &tint[3]; ! 37: int_items = (lispval) &tint[4]; ! 38: int_pages = (lispval) &tint[5]; ! 39: dtpr_items = (lispval) &tint[6]; ! 40: dtpr_pages = (lispval) &tint[7]; ! 41: doub_items = (lispval) &tint[8]; ! 42: doub_pages = (lispval) &tint[9]; ! 43: sdot_items = (lispval) &tint[10]; ! 44: sdot_pages = (lispval) &tint[11]; ! 45: array_items = (lispval) &tint[12]; ! 46: array_pages = (lispval) &tint[13]; ! 47: val_items = (lispval) &tint[14]; ! 48: val_pages = (lispval) &tint[15]; ! 49: funct_items = (lispval) &tint[16]; ! 50: funct_pages = (lispval) &tint[17]; ! 51: ! 52: /* This also applies to the garbage collection threshhold */ ! 53: ! 54: gcthresh = (lispval) &tgcthresh; ! 55: ! 56: /* Now we commence constructing system lisp structures. */ ! 57: ! 58: /* nil is a special case, constructed especially at location zero */ ! 59: ! 60: hasht['n'^'i'^'l'] = (struct atom *)nil; ! 61: ! 62: ! 63: atom_name = matom("symbol"); ! 64: str_name = matom("string"); ! 65: int_name = matom("fixnum"); ! 66: dtpr_name = matom("list"); ! 67: doub_name = matom("flonum"); ! 68: sdot_name = matom("bignum"); ! 69: array_name = matom("array"); ! 70: val_name = matom("value"); ! 71: funct_name = matom("binary"); ! 72: ! 73: ! 74: /* set up the name stack as an array of pointers */ ! 75: ! 76: lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE)); ! 77: nplim = orgnp+NAMESIZE-5; ! 78: temp = matom("namestack"); ! 79: nstack = temp->fnbnd = newarray(); ! 80: nstack->data = (char *) (np); ! 81: (nstack->length = newint())->i = NAMESIZE; ! 82: (nstack->delta = newint())->i = sizeof(struct argent); ! 83: ! 84: /* set up the binding stack as an array of dotted pairs */ ! 85: ! 86: orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE)); ! 87: bnplim = orgbnp+NAMESIZE-5; ! 88: temp = matom("bindstack"); ! 89: bstack = temp->fnbnd = newarray(); ! 90: bstack->data = (char *) (bnp); ! 91: (bstack->length = newint())->i = NAMESIZE; ! 92: (nstack->delta = newint())->i = sizeof(struct nament); ! 93: ! 94: /* more atoms */ ! 95: ! 96: tatom = matom("t"); ! 97: tatom->clb = tatom; ! 98: lambda = matom("lambda"); ! 99: nlambda = matom("nlambda"); ! 100: macro = matom("macro"); ! 101: ibase = matom("ibase"); /* base for input conversion */ ! 102: ibase->clb = inewint(10); ! 103: Vpiport = matom("piport"); ! 104: Vpiport->clb = P(piport = stdin); /* standard input */ ! 105: Vpoport = matom("poport"); ! 106: Vpoport->clb = P(poport = stdout); /* stand. output */ ! 107: matom("errport")->clb = (P(errport = stderr));/* stand. err. */ ! 108: (Vreadtable = matom("readtable"))->clb = Imkrtab(0); ! 109: strtab = Imkrtab(0); ! 110: ! 111: /* The following atoms are used as tokens by the reader */ ! 112: ! 113: perda = matom("."); ! 114: lpara = matom("("); ! 115: rpara = matom(")"); ! 116: lbkta = matom("["); ! 117: rbkta = matom("]"); ! 118: snqta = matom("'"); ! 119: exclpa = matom("!"); ! 120: ! 121: ! 122: (Eofa = matom("eof"))->clb = eofa; ! 123: cara = MK("car",Lcar,lambda); ! 124: cdra = MK("cdr",Lcdr,lambda); ! 125: ! 126: /* The following few atoms have values the reader tokens. */ ! 127: /* Perhaps this is a kludge which should be abandoned. */ ! 128: /* On the other hand, perhaps it is an inspiration. */ ! 129: ! 130: matom("perd")->clb = perda; ! 131: matom("lpar")->clb = lpara; ! 132: matom("rpar")->clb = rpara; ! 133: matom("lbkt")->clb = lbkta; ! 134: matom("rbkt")->clb = rbkta; ! 135: ! 136: noptop = matom("noptop"); ! 137: ! 138: /* atoms used in connection with comments. */ ! 139: ! 140: commta = matom("comment"); ! 141: rcomms = matom("readcomments"); ! 142: ! 143: /* the following atoms are used for lexprs */ ! 144: ! 145: lexpr_atom = matom("last lexpr binding\7"); ! 146: lexpr = matom("lexpr"); ! 147: ! 148: sysa = matom("sys"); ! 149: plima = matom("pagelimit"); /* max number of pages */ ! 150: Veval = MK("eval",Leval,lambda); ! 151: MK("asin",Lasin,lambda); ! 152: MK("acos",Lacos,lambda); ! 153: MK("atan",Latan,lambda); ! 154: MK("cos",Lcos,lambda); ! 155: MK("sin",Lsin,lambda); ! 156: MK("sqrt",Lsqrt,lambda); ! 157: MK("exp",Lexp,lambda); ! 158: MK("log",Llog,lambda); ! 159: MK("random",Lrandom,lambda); ! 160: MK("atom",Latom,lambda); ! 161: MK("apply",Lapply,lambda); ! 162: MK("funcall",Lfuncal,lambda); ! 163: MK("return",Lreturn,lambda); ! 164: MK("retbrk",Lretbrk,lambda); ! 165: MK("cont",Lreturn,lambda); ! 166: MK("cons",Lcons,lambda); ! 167: MK("scons",Lscons,lambda); ! 168: MK("cadr",Lcadr,lambda); ! 169: MK("caar",Lcaar,lambda); ! 170: MK("cddr",Lc02r,lambda); ! 171: MK("caddr",Lc12r,lambda); ! 172: MK("cdddr",Lc03r,lambda); ! 173: MK("cadddr",Lc13r,lambda); ! 174: MK("cddddr",Lc04r,lambda); ! 175: MK("caddddr",Lc14r,lambda); ! 176: MK("nthelem",Lnthelem,lambda); ! 177: MK("eq",Leq,lambda); ! 178: MK("equal",Lequal,lambda); ! 179: MK("numberp",Lnumberp,lambda); ! 180: MK("dtpr",Ldtpr,lambda); ! 181: MK("bcdp",Lbcdp,lambda); ! 182: MK("portp",Lportp,lambda); ! 183: MK("arrayp",Larrayp,lambda); ! 184: MK("valuep",Lvaluep,lambda); ! 185: MK("get_pname",Lpname,lambda); ! 186: MK("arrayref",Larrayref,lambda); ! 187: MK("marray",Lmarray,lambda); ! 188: MK("getlength",Lgetl,lambda); ! 189: MK("putlength",Lputl,lambda); ! 190: MK("getaccess",Lgeta,lambda); ! 191: MK("putaccess",Lputa,lambda); ! 192: MK("getdelta",Lgetdel,lambda); ! 193: MK("putdelta",Lputdel,lambda); ! 194: MK("getaux",Lgetaux,lambda); ! 195: MK("putaux",Lputaux,lambda); ! 196: MK("mfunction",Lmfunction,lambda); ! 197: MK("getentry",Lgetentry,lambda); ! 198: MK("getdisc",Lgetdisc,lambda); ! 199: MK("segment",Lsegment,lambda); ! 200: MK("rplaca",Lrplaca,lambda); ! 201: MK("rplacd",Lrplacd,lambda); ! 202: MK("set",Lset,lambda); ! 203: MK("replace",Lreplace,lambda); ! 204: MK("infile",Linfile,lambda); ! 205: MK("outfile",Loutfile,lambda); ! 206: MK("terpr",Lterpr,lambda); ! 207: MK("print",Lprint,lambda); ! 208: MK("close",Lclose,lambda); ! 209: MK("patom",Lpatom,lambda); ! 210: MK("pntlen",Lpntlen,lambda); ! 211: MK("read",Lread,lambda); ! 212: MK("ratom",Lratom,lambda); ! 213: MK("readc",Lreadc,lambda); ! 214: MK("implode",Limplode,lambda); ! 215: MK("maknam",Lmaknam,lambda); ! 216: MK("concat",Lconcat,lambda); ! 217: MK("uconcat",Luconcat,lambda); ! 218: MK("putprop",Lputprop,lambda); ! 219: MK("get",Lget,lambda); ! 220: MK("getd",Lgetd,lambda); ! 221: MK("putd",Lputd,lambda); ! 222: MK("prog",Nprog,nlambda); ! 223: quota = MK("quote",Nquote,nlambda); ! 224: MK("function",Nfunction,nlambda); ! 225: MK("go",Ngo,nlambda); ! 226: MK("*catch",Ncatch,nlambda); ! 227: MK("errset",Nerrset,nlambda); ! 228: MK("status",Nstatus,nlambda); ! 229: MK("sstatus",Nsstatus,nlambda); ! 230: MK("err",Lerr,lambda); ! 231: MK("*throw",Nthrow,lambda); /* this is a lambda now !! */ ! 232: MK("reset",Nreset,nlambda); ! 233: MK("break",Nbreak,nlambda); ! 234: MK("exit",Lexit,lambda); ! 235: MK("def",Ndef,nlambda); ! 236: MK("null",Lnull,lambda); ! 237: MK("and",Nand,nlambda); ! 238: MK("or",Nor,nlambda); ! 239: MK("setq",Nsetq,nlambda); ! 240: MK("cond",Ncond,nlambda); ! 241: MK("list",Llist,lambda); ! 242: MK("load",Lload,lambda); ! 243: MK("nwritn",Lnwritn,lambda); ! 244: MK("process",Nprocess,nlambda); /* execute a shell command */ ! 245: MK("allocate",Lalloc,lambda); /* allocate a page */ ! 246: MK("sizeof",Lsizeof,lambda); /* size of one item of a data type */ ! 247: MK("dumplisp",Ndumpli,nlambda); /* save the world */ ! 248: MK("top-level",Ntpl,nlambda); /* top level eval-print read loop */ ! 249: startup = matom("startup"); /* used by save and restore */ ! 250: MK("mapcar",Lmapcar,lambda); ! 251: MK("maplist",Lmaplist,lambda); ! 252: MK("mapcan",Lmapcan,lambda); ! 253: MK("mapcon",Lmapcon,lambda); ! 254: MK("assq",Lassq,lambda); ! 255: MK("mapc",Lmapc,lambda); ! 256: MK("map",Lmap,lambda); ! 257: MK("flatsize",Lflatsi,lambda); ! 258: MK("alphalessp",Lalfalp,lambda); ! 259: MK("drain",Ldrain,lambda); ! 260: MK("killcopy",Lkilcopy,lambda); /* forks aand aborts for adb */ ! 261: MK("opval",Lopval,lambda); /* sets and retrieves system variables */ ! 262: MK("ncons",Lncons,lambda); ! 263: sysa = matom("sys"); /* sys indicator for system variables */ ! 264: MK("remob",Lforget,lambda); /* function to take atom out of hash table */ ! 265: splice = matom("splicing"); ! 266: MK("not",Lnull,lambda); ! 267: MK("plus",Ladd,lambda); ! 268: MK("add",Ladd,lambda); ! 269: MK("times",Ltimes,lambda); ! 270: MK("difference",Lsub,lambda); ! 271: MK("quotient",Lquo,lambda); ! 272: MK("mod",Lmod,lambda); ! 273: MK("minus",Lminus,lambda); ! 274: MK("absval",Labsval,lambda); ! 275: MK("add1",Ladd1,lambda); ! 276: MK("sub1",Lsub1,lambda); ! 277: MK("greaterp",Lgreaterp,lambda); ! 278: MK("lessp",Llessp,lambda); ! 279: MK("zerop",Lzerop,lambda); ! 280: MK("minusp",Lnegp,lambda); ! 281: MK("onep",Lonep,lambda); ! 282: MK("sum",Ladd,lambda); ! 283: MK("product",Ltimes,lambda); ! 284: MK("do",Ndo,nlambda); ! 285: MK("progv",Nprogv,nlambda); ! 286: MK("progn",Nprogn,nlambda); ! 287: MK("prog2",Nprog2,nlambda); ! 288: MK("oblist",Loblist,lambda); ! 289: MK("baktrace",Lbaktra,lambda); ! 290: MK("tyi",Ltyi,lambda); ! 291: MK("tyipeek",Ltyipeek,lambda); ! 292: MK("tyo",Ltyo,lambda); ! 293: MK("setsyntax",Lsetsyn,lambda); ! 294: MK("makereadtable",Lmakertbl,lambda); ! 295: MK("zapline",Lzaplin,lambda); ! 296: MK("aexplode",Lexplda,lambda); ! 297: MK("aexplodec",Lexpldc,lambda); ! 298: MK("aexploden",Lexpldn,lambda); ! 299: MK("argv",Largv,lambda); ! 300: MK("arg",Larg,lambda); ! 301: MK("showstack",Lshostk,lambda); ! 302: MK("resetio",Nreseti,nlambda); ! 303: MK("chdir",Lchdir,lambda); ! 304: MK("ascii",Lascii,lambda); ! 305: MK("boole",Lboole,lambda); ! 306: MK("type",Ltype,lambda); /* returns type-name of argument */ ! 307: MK("fix",Lfix,lambda); ! 308: MK("float",Lfloat,lambda); ! 309: MK("fact",Lfact,lambda); ! 310: MK("cpy1",Lcpy1,lambda); ! 311: MK("Divide",LDivide,lambda); ! 312: MK("Emuldiv",LEmuldiv,lambda); ! 313: MK("readlist",Lreadli,lambda); ! 314: MK("plist",Lplist,lambda); /* gives the plist of an atom */ ! 315: MK("setplist",Lsetpli,lambda); /* get plist of an atom */ ! 316: MK("eval-when",Nevwhen,nlambda); ! 317: MK("syscall",Nsyscall,nlambda); ! 318: MK("ptime",Lptime,lambda); /* return process user time */ ! 319: /* ! 320: MK("fork",Lfork,lambda); ! 321: MK("wait",Lwait,lambda); ! 322: MK("pipe",Lpipe,lambda); ! 323: MK("fdopen",Lfdopen,lambda); ! 324: MK("exece",Lexece,lambda); ! 325: */ ! 326: MK("gensym",Lgensym,lambda); ! 327: MK("remprop",Lremprop,lambda); ! 328: MK("bcdad",Lbcdad,lambda); ! 329: MK("symbolp",Lsymbolp,lambda); ! 330: MK("stringp",Lstringp,lambda); ! 331: MK("rematom",Lrematom,lambda); ! 332: MK("prname",Lprname,lambda); ! 333: MK("getenv",Lgetenv,lambda); ! 334: MK("makunbound",Lmakunb,lambda); ! 335: MK("haipart",Lhaipar,lambda); ! 336: MK("haulong",Lhau,lambda); ! 337: MK("signal",Lsignal,lambda); ! 338: MK("fasl",Lfasl,lambda); /* read in compiled file */ ! 339: MK("bind",Lbind,lambda); /* like fasl but for functions ! 340: loaded in when the lisp system ! 341: was constructed by ld */ ! 342: MK("boundp",Lboundp,lambda); /* tells if an atom is bound */ ! 343: MK("fake",Lfake,lambda); /* makes a fake lisp pointer */ ! 344: MK("od",Lod,lambda); /* dumps info */ ! 345: MK("what",Lwhat,lambda); /* converts a pointer to an integer */ ! 346: MK("pv%",Lpolyev,lambda); /* polynomial evaluation instruction */ ! 347: odform = matom("odformat"); /* format for printf's used in od */ ! 348: rdrsdot = newsdot(); /* used in io conversions of bignums */ ! 349: rdrint = newint(); /* used as a temporary integer */ ! 350: (nilplist = newdot())->cdr = newdot(); ! 351: /* used as property list for nil, ! 352: since nil will eventually be put at ! 353: 0 (consequently in text and not ! 354: writable) */ ! 355: ! 356: /* error variables */ ! 357: (Vererr = matom("ER%err"))->clb = nil; ! 358: (Vertpl = matom("ER%tpl"))->clb = nil; ! 359: (Verall = matom("ER%all"))->clb = nil; ! 360: (Vermisc = matom("ER%misc"))->clb = nil; ! 361: (Vlerall = newdot())->car = Verall; /* list (ER%all) */ ! 362: ! 363: ! 364: /* set up the initial status list */ ! 365: ! 366: stlist = nil; /* initially nil */ ! 367: Iaddstat(matom("features"),ST_READ,ST_NO,nil); ! 368: Iaddstat(matom("feature"),ST_FEATR,ST_FEATW,nil); ! 369: Isstatus(matom("feature"),matom("franz")); ! 370: ! 371: Iaddstat(matom("nofeature"),ST_NFETR,ST_NFETW,nil); ! 372: Iaddstat(matom("syntax"),ST_SYNT,ST_NO,nil); ! 373: Iaddstat(matom("uctolc"),ST_READ,ST_TOLC,nil); ! 374: Iaddstat(matom("dumpcore"),ST_READ,ST_CORE,nil); ! 375: Isstatus(matom("dumpcore"),nil); /*set up signals*/ ! 376: ! 377: Iaddstat(matom("chainatom"),ST_RINTB,ST_INTB,inewint(0)); ! 378: Iaddstat(matom("dumpmode"),ST_DMPR,ST_DMPW,nil); ! 379: /* garbage collector things */ ! 380: ! 381: MK("gc",Ngc,nlambda); ! 382: gcafter = MK("gcafter",Ngcafter,nlambda); /* garbage collection wind-up */ ! 383: gcport = matom("gcport"); /* port for gc dumping */ ! 384: gccheck = matom("gccheck"); /* flag for checking during gc */ ! 385: gcdis = matom("gcdisable"); /* option for disabling the gc */ ! 386: gcload = matom("gcload"); /* option for gc while loading */ ! 387: loading = matom("loading"); /* flag--in loader if = t */ ! 388: noautot = matom("noautotrace"); /* option to inhibit auto-trace */ ! 389: (gcthresh = newint())->i = tgcthresh; ! 390: gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */ ! 391: gccall1->car = gcafter; /* start constructing a form for eval */ ! 392: ! 393: arrayst = mstr("ARRAY"); /* array marker in name stack */ ! 394: bcdst = mstr("BINARY"); /* binary function marker */ ! 395: listst = mstr("INTERPRETED"); /* interpreted function marker */ ! 396: macrost = mstr("MACRO"); /* macro marker */ ! 397: protst = mstr("PROTECTED"); /* protection marker */ ! 398: badst = mstr("BADPTR"); /* bad pointer marker */ ! 399: argst = mstr("ARGST"); /* argument marker */ ! 400: ! 401: /* type names */ ! 402: ! 403: FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP); ! 404: FIDDLE(str_name,str_items,str_pages,STRSPP); ! 405: FIDDLE(int_name,int_items,int_pages,INTSPP); ! 406: FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP); ! 407: FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP); ! 408: FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP); ! 409: FIDDLE(array_name,array_items,array_pages,ARRAYSPP); ! 410: FIDDLE(val_name,val_items,val_pages,VALSPP); ! 411: FIDDLE(funct_name,funct_items,funct_pages,BCDSPP); ! 412: ! 413: (plimit = newint())->i = PAGE_LIMIT; ! 414: copval(plima,plimit); /* default value */ ! 415: ! 416: /* the following atom is used when reading caar, cdar, etc. */ ! 417: ! 418: xatom = matom("??"); ! 419: ! 420: /* now it is OK to collect garbage */ ! 421: ! 422: initflag = FALSE; ! 423: } ! 424: ! 425: /* matom("name") ******************************************************/ ! 426: /* */ ! 427: /* simulates an atom being read in from the reader and returns a */ ! 428: /* pointer to it. */ ! 429: /* */ ! 430: /* BEWARE: if an atom becomes "truly worthless" and is collected, */ ! 431: /* the pointer becomes obsolete. */ ! 432: /* */ ! 433: lispval ! 434: matom(string) ! 435: char *string; ! 436: { ! 437: strcpy(strbuf,string); ! 438: return(getatom()); ! 439: } ! 440: ! 441: /* mstr ***************************************************************/ ! 442: /* */ ! 443: /* Makes a string. Uses matom. */ ! 444: /* Not the most efficient but will do until the string from the code */ ! 445: /* itself can be used as a lispval. */ ! 446: ! 447: lispval mstr(string) char *string; ! 448: { ! 449: return((lispval)(inewstr(string))); ! 450: } ! 451: ! 452: /* mfun("name",entry) *************************************************/ ! 453: /* */ ! 454: /* Same as matom, but entry point to c code is associated with */ ! 455: /* "name" as function binding. */ ! 456: /* A pointer to the atom is returned. */ ! 457: /* */ ! 458: lispval mfun(string,entry,discip) char *string; lispval (*entry)(), discip; ! 459: { ! 460: lispval v; ! 461: v = matom(string); ! 462: v -> fnbnd = newfunct(); ! 463: v->fnbnd->entry = entry; ! 464: v->fnbnd->discipline = discip; ! 465: return(v); ! 466: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.