From: Bill Joy Date: Thu, 10 May 1979 02:50:50 +0000 (-0800) Subject: BSD 2 development X-Git-Tag: BSD-2~14 X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/commitdiff_plain/0758c694486e3b2d290f388b05471681cb53bc00 BSD 2 development Work on file src/pi0/fdec.c Work on file src/pi0/hash.c Work on file src/pi0/lab.c Synthesized-from: 2bsd --- diff --git a/src/pi0/fdec.c b/src/pi0/fdec.c new file mode 100644 index 0000000000..dc0c159212 --- /dev/null +++ b/src/pi0/fdec.c @@ -0,0 +1,328 @@ +/* Copyright (c) 1979 Regents of the University of California */ +# +/* + * pi - Pascal interpreter code translator + * + * Charles Haley, Bill Joy UCB + * Version 1.2 January 1979 + */ + +#include "0.h" +#include "tree.h" + +/* + * Funchdr inserts + * declaration of a the + * prog/proc/func into the + * namelist. It also handles + * the arguments and puts out + * a transfer which defines + * the entry point of a procedure. + */ + +funchdr(r) + int *r; +{ + register struct nl *p; + register *il, **rl; + int *rll, o; + struct nl *cp, *dp, *sp; + int *pp; + + send(REVFHDR, r); + if (inpflist(r[2])) { + opush('l'); + yyretrieve(); /* kludge */ + } + line = r[1]; + if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { + /* + * Symbol already defined + * in this block. it is either + * a redeclared symbol (error) + * or a forward declaration. + */ + if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { + /* + * Grammar doesnt forbid + * types on a resolution + * of a forward function + * declaration. + */ + if (p->class == FUNC && r[4]) + error("Function type should be given only in forward declaration"); + return (p); + } + } + /* + * Declare the prog/proc/func + */ + switch (r[0]) { + case T_PROG: + program = p = defnl(r[2], PROG, 0, 0); + break; + case T_PDEC: + if (r[4] != NIL) + error("Procedures do not have types, only functions do"); + p = enter(defnl(r[2], PROC, 0, 0)); + break; + case T_FDEC: + il = r[4]; + if (il == NIL) + error("Function type must be specified"); + else if (il[0] != T_TYID) { + il = NIL; + error("Function type can be specified only by using a type identifier"); + } else + il = gtype(il); + p = enter(defnl(r[2], FUNC, il, NIL)); + /* + * An arbitrary restriction + */ + switch (o = classify(p->type)) { + case TFILE: + case TARY: + case TREC: + case TSET: + case TSTR: + warning(); + if (opt('s')) + standard(); + error("Functions should not return %ss", clnames[o]); + } + break; + default: + panic("funchdr"); + } + if (r[0] != T_PROG) { + /* + * Mark this proc/func as + * begin forward declared + */ + p->nl_flags =| NFORWD; + /* + * Enter the parameters + * in the next block for + * the time being + */ + if (++cbn >= DSPLYSZ) { + error("Procedure/function nesting too deep"); + pexit(ERRS); + } + /* + * For functions, the function variable + */ + if (p->class == FUNC) { + cp = defnl(r[2], FVAR, p->type, 0); + cp->chain = p; + p->value[NL_FVAR] = cp; + } + /* + * Enter the parameters + */ + cp = sp = p; + for (rl = r[3]; rl != NIL; rl = rl[2]) { + p = NIL; + if (rl[1] == NIL) + continue; + /* + * Parametric procedures + * don't have types + */ + if (rl[1][0] != T_PPROC) { + rll = rl[1][2]; + if (rll[0] != T_TYID) { + error("Types for arguments can be specified only by using type identifiers"); + p = NIL; + } else + p = gtype(rll); + } + for (il = rl[1][1]; il != NIL; il = il[2]) { + switch (rl[1][0]) { + default: + panic("funchdr2"); + case T_PVAL: + if (p != NIL) { + if (p->class == FILE) + error("Files cannot be passed by value"); + else if (p->nl_flags & NFILES) + error("Files cannot be a component of %ss passed by value", + nameof(p)); + } + dp = defnl(il[1], VAR, p, 0); + break; + case T_PVAR: + dp = defnl(il[1], REF, p, 0); + break; + case T_PFUNC: + case T_PPROC: + error("Procedure/function parameters not implemented"); + continue; + } + if (dp != NIL) { + cp->chain = dp; + cp = dp; + } + } + } + cbn--; + p = sp; + } else { + cp = p; + for (rl = r[3]; rl; rl = rl[2]) { + if (rl[1] == NIL) + continue; + dp = defnl(rl[1], VAR, 0, 0); + cp->chain = dp; + cp = dp; + } + } + return (p); +} + +/* + * Funcbody is called + * when the actual (resolved) + * declaration of a procedure is + * encountered. It puts the names + * of the (function) and parameters + * into the symbol table. + */ +funcbody(fp) + struct nl *fp; +{ + register struct nl *q, *p; + + cbn++; + if (cbn >= DSPLYSZ) { + error("Too many levels of function/procedure nesting"); + pexit(ERRS); + } + send(REVFBDY); + errcnt[cbn] = syneflg; + parts = NIL; + if (fp == NIL) + return (NIL); + /* + * Save the virtual name + * list stack pointer so + * the space can be freed + * later (funcend). + */ + fp->value[2] = nlp; + if (fp->class != PROG) + for (q = fp->chain; q != NIL; q = q->chain) + enter(q); + if (fp->class == FUNC) { + /* + * For functions, enter the fvar + */ + enter(fp->value[NL_FVAR]); + } + return (fp); +} + +int pnumcnt; +struct nl *Fp; +/* + * Funcend is called to + * finish a block by generating + * the code for the statements. + * It then looks for unresolved declarations + * of labels, procedures and functions, + * and cleans up the name list. + * For the program, it checks the + * semantics of the program + * statement (yuchh). + */ +funcend(fp, bundle, endline) + struct nl *fp; + int *bundle; + int endline; +{ + register struct nl *p; + register int i, b; + int *blk; + char *cp; + + blk = bundle[2]; + if (fp == NIL) { + cbn--; + return; + } + send(REVFEND, bundle, endline, syneflg == errcnt[cbn]); + if (Fp != NIL) + Fp = fp; + /* + * Clean up the symbol table displays and check for unresolves + */ + line = endline; + b = cbn; + for (i = 0; i <= 077; i++) { + for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) + if (p->class == BADUSE) { + cp = "s"; + if (p->chain->ud_next == NIL) + cp++; + eholdnl(); + if (p->value[NL_KINDS] & ISUNDEF) + nerror("%s undefined on line%s", p->symbol, cp); + else + nerror("%s improperly used on line%s", p->symbol, cp); + pnumcnt = 10; + pnums(p->chain); + putchar('\n'); + } + /* + * Pop this symbol + * table slot + */ + disptab[i] = p; + } + +#ifdef DEBUG + dumpnl(fp->value[2], fp->symbol); +#endif + /* + * Restore the + * (virtual) name list + * position + */ + nlfree(fp->value[2]); + /* + * Proc/func has been + * resolved + */ + fp->nl_flags =& ~NFORWD; + elineon(); + cbn--; + if (inpflist(fp->symbol)) { + opop('l'); + } +} + +pnums(p) + struct udinfo *p; +{ + + if (p->ud_next != NIL) + pnums(p->ud_next); + if (pnumcnt == 0) { + printf("\n\t"); + pnumcnt = 20; + } + pnumcnt--; + printf(" %d", p->ud_line); +} + +nerror(a1, a2, a3) +{ + + if (Fp != NIL) { + yySsync(); + printf("In %s %s:\n", classes[Fp->class], Fp->symbol); + Fp = NIL; + } + elineoff(); + error(a1, a2, a3); +} diff --git a/src/pi0/hash.c b/src/pi0/hash.c new file mode 100644 index 0000000000..1f534d3b64 --- /dev/null +++ b/src/pi0/hash.c @@ -0,0 +1,189 @@ +/* Copyright (c) 1979 Regents of the University of California */ +# +/* + * pi - Pascal interpreter code translator + * + * Charles Haley, Bill Joy UCB + * Version 1.2 January 1979 + * + * + * pxp - Pascal execution profiler + * + * Bill Joy UCB + * Version 1.2 January 1979 + */ + +#include "0.h" +#include "yy.h" + +/* + * The definition for the segmented hash tables. + */ +struct ht { + int *ht_low; + int *ht_high; + int ht_used; +} htab[MAXHASH]; + +/* + * This is the array of keywords and their + * token values, which are hashed into the table + * by inithash. + */ +struct kwtab yykey[] { + "and", YAND, + "array", YARRAY, + "assert", YASSERT, + "begin", YBEGIN, + "case", YCASE, + "const", YCONST, + "div", YDIV, + "do", YDO, + "downto", YDOWNTO, + "else", YELSE, + "end", YEND, + "file", YFILE, + "for", YFOR, + "forward", YFORWARD, + "function", YFUNCTION, + "goto", YGOTO, + "if", YIF, + "in", YIN, + "label", YLABEL, + "mod", YMOD, + "nil", YNIL, + "not", YNOT, + "of", YOF, + "or", YOR, + "packed", YPACKED, + "procedure", YPROCEDURE, + "program", YPROG, + "record", YRECORD, + "repeat", YREPEAT, + "set", YSET, + "then", YTHEN, + "to", YTO, + "type", YTYPE, + "until", YUNTIL, + "var", YVAR, + "while", YWHILE, + "with", YWITH, + "oct", YOCT, /* non-standard Pascal */ + "hex", YHEX, /* non-standard Pascal */ + 0 +}; + +char *lastkey &yykey[sizeof yykey/sizeof yykey[0]]; + +/* + * Inithash initializes the hash table routines + * by allocating the first hash table segment using + * an already existing memory slot. + */ +#ifndef PI0 +inithash() +#else +inithash(hshtab) + int *hshtab; +#endif +{ + register int *ip; +#ifndef PI0 + static int hshtab[HASHINC]; +#endif + + htab[0].ht_low = hshtab; + htab[0].ht_high = &hshtab[HASHINC]; + for (ip = yykey; *ip; ip =+ 2) + hash(ip[0], 0)[0] = ip; +} + +/* + * Hash looks up the s(ymbol) argument + * in the string table, entering it if + * it is not found. If save is 0, then + * the argument string is already in + * a safe place. Otherwise, if hash is + * entering the symbol for the first time + * it will save the symbol in the string + * table using savestr. + */ +int *hash(s, save) + char *s; + int save; +{ + register int *h; + register i; + register char *cp; + int *sym; + struct ht *htp; + int sh; + + /* + * The hash function is a modular hash of + * the sum of the characters with the sum + * doubled before each successive character + * is added. + */ + cp = s; + if (cp == NIL) + cp = token; /* default symbol to be hashed */ + i = 0; + while (*cp) + i = i*2 + *cp++; + sh = (i&077777) % HASHINC; + cp = s; + if (cp == NIL) + cp = token; + /* + * There are as many as MAXHASH active + * hash tables at any given point in time. + * The search starts with the first table + * and continues through the active tables + * as necessary. + */ + for (htp = htab; htp < &htab[MAXHASH]; htp++) { + if (htp->ht_low == NIL) { + cp = calloc(2, HASHINC); + if (cp == -1) { + yerror("Ran out of memory (hash)"); + pexit(DIED); + } + htp->ht_low = cp; + htp->ht_high = htp->ht_low + HASHINC; + cp = s; + if (cp == NIL) + cp = token; + } + h = htp->ht_low + sh; + /* + * quadratic rehash increment + * starts at 1 and incremented + * by two each rehash. + */ + i = 1; + do { + if (*h == 0) { + if (htp->ht_used > (HASHINC * 3)/4) + break; + htp->ht_used++; + if (save != 0) { + *h = savestr(cp); + } else + *h = s; + return (h); + } + sym = *h; + if (sym < lastkey && sym >= yykey) + sym = *sym; + if (sym->pchar == *cp && strcmp(sym, cp) == 0) + return (h); + h =+ i; + i =+ 2; + if (h >= htp->ht_high) + h =- HASHINC; + } while (i < HASHINC); + } + yerror("Ran out of hash tables"); + pexit(DIED); +} diff --git a/src/pi0/lab.c b/src/pi0/lab.c new file mode 100644 index 0000000000..2e013366e7 --- /dev/null +++ b/src/pi0/lab.c @@ -0,0 +1,124 @@ +/* Copyright (c) 1979 Regents of the University of California */ +# +/* + * pi - Pascal interpreter code translator + * + * Charles Haley, Bill Joy UCB + * Version 1.2 January 1979 + */ + +#include "0.h" +#include "tree.h" +#include "opcode.h" + +/* + * Label enters the definitions + * of the label declaration part + * into the namelist. + */ +label(r, l) + int *r, l; +{ +#ifndef PI0 + register *ll; + register struct nl *p, *lp; + + lp = NIL; +#else + send(REVLAB, r); +#endif + line = l; +#ifndef PI1 + if (parts & (CPRT|TPRT|VPRT)) + error("Label declarations must precede const, type and var declarations"); + if (parts & LPRT) + error("All labels must be declared in one label part"); + parts =| LPRT; +#endif +#ifndef PI0 + for (ll = r; ll != NIL; ll = ll[2]) { + l = getlab(); + p = enter(defnl(ll[1], LABEL, 0, l)); + /* + * Get the label for the eventual target + */ + p->value[1] = getlab(); + p->chain = lp; + p->nl_flags =| (NFORWD|NMOD); + p->value[NL_GOLEV] = NOTYET; + lp = p; + /* + * This operator is between + * the bodies of two procedures + * and provides a target for + * gotos for this label via TRA. + */ + putlab(l); + put2(O_GOTO | cbn<<9, p->value[1]); + } + gotos[cbn] = lp; +#endif +} + +#ifndef PI0 +/* + * Gotoop is called when + * we get a statement "goto label" + * and generates the needed tra. + */ +gotoop(s) + char *s; +{ + register struct nl *p; + + gocnt++; + p = lookup(s); + if (p == NIL) + return (NIL); + put2(O_TRA, p->value[0]); + if (bn == cbn) + if (p->nl_flags & NFORWD) { + if (p->value[NL_GOLEV] == NOTYET) { + p->value[NL_GOLEV] = level; + p->value[NL_GOLINE] = line; + } + } else + if (p->value[NL_GOLEV] == DEAD) { + recovered(); + error("Goto %s is into a structured statement", p->symbol); + } +} + +/* + * Labeled is called when a label + * definition is encountered, and + * marks that it has been found and + * patches the associated GOTO generated + * by gotoop. + */ +labeled(s) + char *s; +{ + register struct nl *p; + + p = lookup(s); + if (p == NIL) + return (NIL); + if (bn != cbn) { + error("Label %s not defined in correct block", s); + return; + } + if ((p->nl_flags & NFORWD) == 0) { + error("Label %s redefined", s); + return; + } + p->nl_flags =& ~NFORWD; + patch(p->value[1]); + if (p->value[NL_GOLEV] != NOTYET) + if (p->value[NL_GOLEV] < level) { + recovered(); + error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]); + } + p->value[NL_GOLEV] = level; +} +#endif