Bell 32V development
authorTom London <tbl@research.uucp>
Mon, 6 Nov 1978 04:33:35 +0000 (23:33 -0500)
committerTom London <tbl@research.uucp>
Mon, 6 Nov 1978 04:33:35 +0000 (23:33 -0500)
Work on file usr/src/cmd/ratfor/r0.c
Work on file usr/src/cmd/ratfor/r.h
Work on file usr/src/cmd/ratfor/r.g
Work on file usr/src/cmd/ratfor/r1.c
Work on file usr/src/cmd/ratfor/rlook.c
Work on file usr/src/cmd/ratfor/rio.c

Co-Authored-By: John Reiser <jfr@research.uucp>
Synthesized-from: 32v

usr/src/cmd/ratfor/r.g [new file with mode: 0644]
usr/src/cmd/ratfor/r.h [new file with mode: 0644]
usr/src/cmd/ratfor/r0.c [new file with mode: 0644]
usr/src/cmd/ratfor/r1.c [new file with mode: 0644]
usr/src/cmd/ratfor/rio.c [new file with mode: 0644]
usr/src/cmd/ratfor/rlook.c [new file with mode: 0644]

diff --git a/usr/src/cmd/ratfor/r.g b/usr/src/cmd/ratfor/r.g
new file mode 100644 (file)
index 0000000..c692f2c
--- /dev/null
@@ -0,0 +1,66 @@
+%{
+extern int transfer;
+extern int     indent;
+%}
+
+%term  IF ELSE FOR WHILE BREAK NEXT 
+%term  DIGITS DO
+%term  GOK DEFINE INCLUDE
+%term  REPEAT UNTIL
+%term  RETURN
+%term  SWITCH CASE DEFAULT
+%%
+
+statl  : statl  stat
+       |
+       ;
+stat   : if stat       ={ indent--; outcont($1); }
+       | ifelse stat   ={ indent--; outcont($1+1); }
+       | switch fullcase '}'   ={ endsw($1, $2); }
+       | while stat    ={ whilestat($1); }
+       | for stat      ={ forstat($1); }
+       | repeat stat UNTIL     ={ untils($1,1); }
+       | repeat stat           ={ untils($1,0); }
+       | BREAK ={ breakcode(); }
+       | NEXT          ={ nextcode(); }
+       | do stat       ={ dostat($1); }
+       | GOK           ={ gokcode($1); }
+       | RETURN        ={ retcode(); }
+       | ';'
+       | '{' statl '}'
+       | label stat
+       | error         ={ errcode(); yyclearin; }
+       ;
+switch : sw '{'
+       ;
+sw     : SWITCH        ={ swcode(); }
+       ;
+fullcase: caselist     ={ $$ = 0; }
+       | caselist defpart      ={ $$ = 1; }
+       ;
+caselist: casepart
+       | caselist casepart
+       ;
+defpart        : default statl
+       ;
+default        : DEFAULT       ={ getdefault(); }
+       ;
+casepart: case statl
+       ;
+case   : CASE  ={ getcase(); }
+       ;
+label  : DIGITS        ={ transfer = 0; outcode($1); }
+       ;
+if     : IF            ={ ifcode(); }
+       ;
+ifelse : if stat ELSE  ={ elsecode($1); }
+       ;
+while  : WHILE ={ whilecode(); }
+       ;
+for    : FOR           ={ forcode(); }
+       ;
+repeat : REPEAT        ={ repcode(); }
+       ;
+do     : DO            ={ docode(); }
+       ;
+%%
diff --git a/usr/src/cmd/ratfor/r.h b/usr/src/cmd/ratfor/r.h
new file mode 100644 (file)
index 0000000..47a6ee7
--- /dev/null
@@ -0,0 +1,64 @@
+#include <stdio.h>
+#include "y.tab.h"
+
+#
+#define        putbak(c)       *ip++ = c
+/*     #define getchr()        (ip>ibuf?*--ip: getc(infile[infptr]))   */
+
+#define        LET     1
+#define        DIG     2
+#define        CRAP    3
+#define        COMMENT '#'
+#define        QUOTE   '"'
+
+extern int     transfer;
+
+#define        INDENT  3       /* indent delta */
+#ifdef gcos
+#define        CONTFLD 6
+#endif
+#ifdef unix
+#define        CONTFLD 1
+#endif
+extern int     contfld;        /* column for continuation char */
+extern int     contchar;
+extern int     dbg;
+extern int     yyval;
+extern int     *yypv;
+extern int     yylval;
+extern int     errorflag;
+
+extern char    comment[];      /* save input comments here */
+extern int     comptr; /* next free slot in comment */
+extern int     printcom;       /* print comments, etc., if on */
+extern int     indent; /* level of nesting for indenting */
+
+extern char    ibuf[];
+extern char    *ip;
+
+extern FILE    *outfil;        /* output file id */
+extern FILE    *infile[];
+extern char    *curfile[];
+extern int     infptr;
+extern int     linect[];
+
+extern char    fcname[];
+
+extern int     svargc;
+extern char    **svargv;
+
+#define EOS 0
+#define        HSHSIZ  101
+struct nlist {
+       char    *name;
+       char    *def;
+       int     ydef;
+       struct  nlist *next;
+};
+
+struct nlist   *lookup();
+char   *install();
+char   *malloc();
+extern char    *fcnloc;
+
+extern char    type[];
diff --git a/usr/src/cmd/ratfor/r0.c b/usr/src/cmd/ratfor/r0.c
new file mode 100644 (file)
index 0000000..3d84e70
--- /dev/null
@@ -0,0 +1,83 @@
+#include "r.h"
+
+int    swlevel = -1;
+int    swexit[5];
+int    nextcase[5];
+
+swcode() {
+       transfer = 0;
+       putcom("switch");
+       swlevel++;
+       if (swlevel >= 5)
+               error("Switches nested > 5");
+       swexit[swlevel] = yyval = genlab(1);
+       outcode("\tI");
+       outnum(yyval);
+       outcode(" = ");
+       balpar();
+       outdon();
+       nextcase[swlevel] = 0;
+       indent++;
+}
+
+getcase() {
+       int t, lpar;
+       char token[100];
+
+       if (nextcase[swlevel] != 0) {
+               outgoto(swexit[swlevel]);
+               outcont(nextcase[swlevel]);
+       }
+       indent--;
+       outcode("\tif(.not.(");
+       do {
+               outcode("I");
+               outnum(swexit[swlevel]);
+               outcode(".eq.(");
+               lpar = 0;
+               do {
+                       if ((t=gtok(token)) == ':')
+                               break;
+                       if (t == '(')
+                               lpar++;
+                       else if (t == ')')
+                               lpar--;
+                       else if (t == ',') {
+                               if (lpar == 0)
+                                       break;
+                               }
+                       outcode(token);
+               } while (lpar >= 0);
+               if (lpar < 0)
+                       error("Missing left parenthesis in case");
+               if (t == ',')
+                       outcode(").or.");
+       } while (t != ':');
+       if (lpar != 0)
+               error("Missing parenthesis in case");
+       outcode(")))");
+       nextcase[swlevel] = genlab(1);
+       outgoto(nextcase[swlevel]);
+       indent++;
+}
+
+getdefault() {
+       char token[20];
+       if (gnbtok(token) != ':')
+               error("Missing colon after default");
+       outgoto(swexit[swlevel]);
+       outcont(nextcase[swlevel]);
+       indent--;
+       putcom("default");
+       indent++;
+}
+
+endsw(n, def) {
+       if (def == 0)
+               outcont(nextcase[swlevel]);
+       swlevel--;
+       if (swlevel < -1)
+               error("Switches unwound too far");
+       indent--;
+       outcont(n);
+}
diff --git a/usr/src/cmd/ratfor/r1.c b/usr/src/cmd/ratfor/r1.c
new file mode 100644 (file)
index 0000000..b43b8c0
--- /dev/null
@@ -0,0 +1,371 @@
+#include "r.h"
+
+#define        wasbreak        brkused[brkptr]==1 || brkused[brkptr]==3
+#define        wasnext brkused[brkptr]==2 || brkused[brkptr]==3
+
+int    transfer        = 0;    /* 1 if just finished retrun, break, next */
+
+char   fcname[10];
+char   scrat[500];
+
+int    brkptr  = -1;
+int    brkstk[10];     /* break label */
+int    typestk[10];    /* type of loop construct */
+int    brkused[10];    /* loop contains BREAK or NEXT */
+
+int    forptr  = 0;
+char   *forstk[10];
+
+repcode() {
+       transfer = 0;
+       outcont(0);
+       putcom("repeat");
+       yyval = genlab(3);
+       indent++;
+       outcont(yyval);
+       brkstk[++brkptr] = yyval+1;
+       typestk[brkptr] = REPEAT;
+       brkused[brkptr] = 0;
+}
+
+untils(p1,un) int p1,un; {
+       outnum(p1+1);
+       outtab();
+       if (un > 0) {
+               outcode("if(.not.");
+               balpar();
+               outcode(")");
+       }
+       transfer = 0;
+       outgoto(p1);
+       indent--;
+       if (wasbreak)
+               outcont(p1+2);
+       brkptr--;
+}
+
+ifcode() {
+       transfer = 0;
+       outtab();
+       outcode("if(.not.");
+       balpar();
+       outcode(")");
+       outgoto(yyval=genlab(2));
+       indent++;
+}
+
+elsecode(p1) {
+       outgoto(p1+1);
+       indent--;
+       putcom("else");
+       indent++;
+       outcont(p1);
+}
+
+whilecode() {
+       transfer = 0;
+       outcont(0);
+       putcom("while");
+       brkstk[++brkptr] = yyval = genlab(2);
+       typestk[brkptr] = WHILE;
+       brkused[brkptr] = 0;
+       outnum(yyval);
+       outtab();
+       outcode("if(.not.");
+       balpar();
+       outcode(")");
+       outgoto(yyval+1);
+       indent++;
+}
+
+whilestat(p1) int p1; {
+       outgoto(p1);
+       indent--;
+       putcom("endwhile");
+       outcont(p1+1);
+       brkptr--;
+}
+
+balpar() {
+       register c, lpar;
+       while ((c=gtok(scrat)) == ' ' || c == '\t')
+               ;
+       if (c != '(') {
+               error("missing left paren");
+               return;
+       }
+       outcode(scrat);
+       lpar = 1;
+       do {
+               c = gtok(scrat);
+               if (c==';' || c=='{' || c=='}' || c==EOF) {
+                       pbstr(scrat);
+                       break;
+               }
+               if (c=='(')
+                       lpar++;
+               else if (c==')')
+                       lpar--;
+               else if (c == '\n') {
+                       while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n')
+                               ;
+                       pbstr(scrat);
+                       continue;
+               }
+               else if (c == '=' && scrat[1] == '\0')
+                       error("assigment inside conditional");
+               outcode(scrat);
+       } while (lpar > 0);
+       if (lpar != 0)
+               error("missing parenthesis");
+}
+
+int    labval  = 23000;
+
+genlab(n){
+       labval += n;
+       return(labval-n);
+}
+
+gokcode(p1) {
+       transfer = 0;
+       outtab();
+       outcode(p1);
+       eatup();
+       outdon();
+}
+
+eatup() {
+       int t, lpar;
+       char temp[100];
+       lpar = 0;
+       do {
+               if ((t = gtok(scrat)) == ';' || t == '\n')
+                       break;
+               if (t == '{' || t == '}' || t == EOF) {
+                       pbstr(scrat);
+                       break;
+               }
+               if (t == ',' || t == '+' || t == '-' || t == '*' || t == '('
+                 || t == '&' || t == '|' || t == '=') {
+                       while (gtok(temp) == '\n')
+                               ;
+                       pbstr(temp);
+               }
+               if (t == '(')
+                       lpar++;
+               else if (t==')') {
+                       lpar--;
+                       if (lpar < 0) {
+                               error("missing left paren");
+                               return(1);
+                       }
+               }
+               outcode(scrat);
+       } while (lpar >= 0);
+       if (lpar > 0) {
+               error("missing right paren");
+               return(1);
+       }
+       return(0);
+}
+
+forcode(){
+       int lpar, t;
+       char *ps, *qs;
+
+       transfer = 0;
+       outcont(0);
+       putcom("for");
+       yyval = genlab(3);
+       brkstk[++brkptr] = yyval+1;
+       typestk[brkptr] = FOR;
+       brkused[brkptr] = 0;
+       forstk[forptr++] = malloc(1);
+       if ((t = gnbtok(scrat)) != '(') {
+               error("missing left paren in FOR");
+               pbstr(scrat);
+               return;
+       }
+       if (gnbtok(scrat) != ';') {     /* real init clause */
+               pbstr(scrat);
+               outtab();
+               if (eatup() > 0) {
+                       error("illegal FOR clause");
+                       return;
+               }
+               outdon();
+       }
+       if (gnbtok(scrat) == ';')       /* empty condition */
+               outcont(yyval);
+       else {  /* non-empty condition */
+               pbstr(scrat);
+               outnum(yyval);
+               outtab();
+               outcode("if(.not.(");
+               for (lpar=0; lpar >= 0;) {
+                       if ((t = gnbtok(scrat)) == ';')
+                               break;
+                       if (t == '(')
+                               lpar++;
+                       else if (t == ')') {
+                               lpar--;
+                               if (lpar < 0) {
+                                       error("missing left paren in FOR clause");
+                                       return;
+                               }
+                       }
+                       if (t != '\n')
+                               outcode(scrat);
+               }
+               outcode("))");
+               outgoto(yyval+2);
+               if (lpar < 0)
+                       error("invalid FOR clause");
+       }
+       ps = scrat;
+       for (lpar=0; lpar >= 0;) {
+               if ((t = gtok(ps)) == '(')
+                       lpar++;
+               else if (t == ')')
+                       lpar--;
+               if (lpar >= 0 && t != '\n')
+                       while(*ps)
+                               ps++;
+       }
+       *ps = '\0';
+       qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
+       ps = scrat;
+       while (*qs++ = *ps++)
+               ;
+       indent++;
+}
+
+forstat(p1) int p1; {
+       char *bp, *q;
+       bp = forstk[--forptr];
+       if (wasnext)
+               outnum(p1+1);
+       if (nonblank(bp)){
+               outtab();
+               outcode(bp);
+               outdon();
+       }
+       outgoto(p1);
+       indent--;
+       putcom("endfor");
+       outcont(p1+2);
+       for (q=bp; *q++;);
+       free(bp);
+       brkptr--;
+}
+
+retcode() {
+       register c;
+       if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
+               pbstr(scrat);
+               outtab();
+               outcode(fcname);
+               outcode(" = ");
+               eatup();
+               outdon();
+       }
+       else if (c == '}')
+               pbstr(scrat);
+       outtab();
+       outcode("return");
+       outdon();
+       transfer = 1;
+}
+
+docode() {
+       transfer = 0;
+       outtab();
+       outcode("do ");
+       yyval = genlab(2);
+       brkstk[++brkptr] = yyval;
+       typestk[brkptr] = DO;
+       brkused[brkptr] = 0;
+       outnum(yyval);
+       eatup();
+       outdon();
+       indent++;
+}
+
+dostat(p1) int p1; {
+       outcont(p1);
+       indent--;
+       if (wasbreak)
+               outcont(p1+1);
+       brkptr--;
+}
+
+#ifdef gcos
+#define        atoi(s) (*s-'0')        /* crude!!! */
+#endif
+
+breakcode() {
+       int level, t;
+
+       level = 0;
+       if ((t=gnbtok(scrat)) == DIG)
+               level = atoi(scrat) - 1;
+       else if (t != ';')
+               pbstr(scrat);
+       if (brkptr-level < 0)
+               error("illegal BREAK");
+       else {
+               outgoto(brkstk[brkptr-level]+1);
+               brkused[brkptr-level] |= 1;
+       }
+       transfer = 1;
+}
+
+nextcode() {
+       int level, t;
+
+       level = 0;
+       if ((t=gnbtok(scrat)) == DIG)
+               level = atoi(scrat) - 1;
+       else if (t != ';')
+               pbstr(scrat);
+       if (brkptr-level < 0)
+               error("illegal NEXT");
+       else {
+               outgoto(brkstk[brkptr-level]);
+               brkused[brkptr-level] |= 2;
+       }
+       transfer = 1;
+}
+
+nonblank(s) char *s; {
+       int c;
+       while (c = *s++)
+               if (c!=' ' && c!='\t' && c!='\n')
+                       return(1);
+       return(0);
+}
+
+int    errorflag       = 0;
+
+error(s1) char *s1; {
+       if (errorflag == 0)
+               fprintf(stderr, "ratfor:");
+       fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
+       fprintf(stderr, s1);
+       fprintf(stderr, "\n");
+       errorflag = 1;
+}
+
+errcode() {
+       int c;
+       if (errorflag == 0)
+               fprintf(stderr, "******\n");
+       fprintf(stderr, "*****F ratfor:");
+       fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
+       while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
+               ;
+       if (c == EOF || c == '\0')
+               putbak(c);
+       errorflag = 1;
+}
diff --git a/usr/src/cmd/ratfor/rio.c b/usr/src/cmd/ratfor/rio.c
new file mode 100644 (file)
index 0000000..89eb6f6
--- /dev/null
@@ -0,0 +1,212 @@
+#include "r.h"
+#define        BUFSIZE 512
+char   ibuf[BUFSIZE];
+char   *ip = ibuf;
+
+char   type[] = {
+       0,      CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,
+       CRAP,   '\t',   '\n',   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,
+       CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,
+       CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,   CRAP,
+       ' ',    '!',    '"',    '#',    '$',    '%',    '&',    '\'',
+       '(',    ')',    '*',    '+',    ',',    '-',    '.',    '/',
+       DIG,    DIG,    DIG,    DIG,    DIG,    DIG,    DIG,    DIG,
+       DIG,    DIG,    ':',    ';',    '<',    '=',    '>',    '?',
+       '@',    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    '[',    '\\',   ']',    '^',    '_',
+       '`',    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    LET,    LET,    LET,    LET,    LET,
+       LET,    LET,    LET,    '{',    '|',    '}',    '~',    0,
+};
+
+gtok(s) char *s; {     /* get token into s */
+       register c, t;
+       register char *p;
+       struct nlist *q;
+
+       for(;;) {
+               p = s;
+               *p++ = c = getchr();
+               switch(t = type[c]) {
+               case 0:
+                       if (infptr > 0) {
+                               fclose(infile[infptr]);
+                               infptr--;
+                               continue;
+                       }
+                       if (svargc > 1) {
+                               svargc--;
+                               svargv++;
+                               if (infile[infptr] != stdin)
+                                       fclose(infile[infptr]);
+                               if( (infile[infptr] = fopen(*svargv,"r")) == NULL )
+                                       cant(*svargv);
+                               linect[infptr] = 0;
+                               curfile[infptr] = *svargv;
+                               continue;
+                       }
+                       return(EOF);    /* real eof */
+               case ' ':
+               case '\t':
+                       while ((c = getchr()) == ' ' || c == '\t')
+                               ;       /* skip others */
+                       if (c == COMMENT || c == '_') {
+                               putbak(c);
+                               continue;
+                       }
+                       if (c != '\n') {
+                               putbak(c);
+                               *p = '\0';
+                               return(' ');
+                       } else {
+                               *s = '\n';
+                               *(s+1) = '\0';
+                               return(*s);
+                       }
+               case '_':
+                       while ((c = getchr()) == ' ' || c == '\t')
+                               ;
+                       if (c == COMMENT) {
+                               putbak(c);
+                               gtok(s);        /* recursive */
+                       }
+                       else if (c != '\n')
+                               putbak(c);
+                       continue;
+               case LET:
+               case DIG:
+                       while ((t=type[*p = getchr()]) == LET || t == DIG)
+                               p++;
+                       putbak(*p);
+                       *p = '\0';
+                       if ((q = lookup(s))->name != NULL && q->ydef == 0) {    /* found but not keyword */
+                               if (q->def != fcnloc) { /* not "function" */
+                                       pbstr(q->def);
+                                       continue;
+                               }
+                               getfname();     /* recursive gtok */
+                       }
+                       for (p=s; *p; p++)
+                               if (*p>='A' && *p<='Z')
+                                       *p += 'a' - 'A';
+                       for (p=s; *p; p++)
+                               if (*p < '0' || *p > '9')
+                                       return(LET);
+                       return(DIG);
+               case '[':
+                       *p = '\0';
+                       return('{');
+               case ']':
+                       *p = '\0';
+                       return('}');
+               case '$':
+               case '\\':
+                       if ((*p = getchr()) == '(' || *p == ')') {
+                               putbak(*p=='(' ? '{' : '}');
+                               continue;
+                       }
+                       if (*p == '"' || *p == '\'')
+                               p++;
+                       else
+                               putbak(*p);
+                       *p = '\0';
+                       return('$');
+               case COMMENT:
+                       comment[comptr++] = 'c';
+                       while ((comment[comptr++] = getchr()) != '\n')
+                               ;
+                       flushcom();
+                       *s = '\n';
+                       *(s+1) = '\0';
+                       return(*s);
+               case '"':
+               case '\'':
+                       for (; (*p = getchr()) != c; p++) {
+                               if (*p == '\\')
+                                       *++p = getchr();
+                               if (*p == '\n') {
+                                       error("missing quote");
+                                       putbak('\n');
+                                       break;
+                               }
+                       }
+                       *p++ = c;
+                       *p = '\0';
+                       return(QUOTE);
+               case '%':
+                       while ((*p = getchr()) != '\n')
+                               p++;
+                       putbak(*p);
+                       *p = '\0';
+                       return('%');
+               case '>': case '<': case '=': case '!': case '^':
+                       return(peek(p, '='));
+               case '&':
+                       return(peek(p, '&'));
+               case '|':
+                       return(peek(p, '|'));
+               case CRAP:
+                       continue;
+               default:
+                       *p = '\0';
+                       return(*s);
+               }
+       }
+}
+
+gnbtok(s) char *s; {
+       register c;
+       while ((c = gtok(s)) == ' ' || c == '\t')
+               ;
+       return(c);
+}
+
+getfname() {
+       while (gtok(fcname) == ' ')
+               ;
+       pbstr(fcname);
+       putbak(' ');
+}
+
+peek(p, c1) char *p, c1; {
+       register c;
+       c = *(p-1);
+       if ((*p = getchr()) == c1)
+               p++;
+       else
+               putbak(*p);
+       *p = '\0';
+       return(c);
+}
+
+pbstr(str)
+register char *str;
+{
+       register char *p;
+
+       p = str;
+       while (*p++);
+       --p;
+       if (ip >= &ibuf[BUFSIZE]) {
+               error("pushback overflow");
+               exit(1);
+       }
+       while (p > str)
+               putbak(*--p);
+}
+
+getchr() {
+       register c;
+
+       if (ip > ibuf)
+               return(*--ip);
+       c = getc(infile[infptr]);
+       if (c == '\n')
+               linect[infptr]++;
+       if (c == EOF)
+               return(0);
+       return(c);
+}
diff --git a/usr/src/cmd/ratfor/rlook.c b/usr/src/cmd/ratfor/rlook.c
new file mode 100644 (file)
index 0000000..0ebf64a
--- /dev/null
@@ -0,0 +1,67 @@
+#define NULL 0
+#define EOS 0
+#define        HSHSIZ  101
+struct nlist {
+       char    *name;
+       char    *def;
+       int     ydef;
+       struct  nlist *next;
+};
+
+struct nlist   *hshtab[HSHSIZ];
+struct nlist   *lookup();
+char   *install();
+char   *malloc();
+char   *copy();
+int    hshval;
+
+struct nlist *lookup(str)
+char *str;
+{
+       register char *s1, *s2;
+       register struct nlist *np;
+       static struct nlist nodef;
+
+       s1 = str;
+       for (hshval = 0; *s1; )
+               hshval += *s1++;
+       hshval %= HSHSIZ;
+       for (np = hshtab[hshval]; np!=NULL; np = np->next) {
+               s1 = str;
+               s2 = np->name;
+               while (*s1++ == *s2)
+                       if (*s2++ == EOS)
+                               return(np);
+       }
+       return(&nodef);
+}
+
+char *install(nam, val, tran)
+char *nam, *val;
+int tran;
+{
+       register struct nlist *np;
+
+       if ((np = lookup(nam))->name == NULL) {
+               np = (struct nlist *)malloc(sizeof(*np));
+               np->name = copy(nam);
+               np->def = copy(val);
+               np->ydef = tran;
+               np->next = hshtab[hshval];
+               hshtab[hshval] = np;
+               return(np->def);
+       }
+       free(np->def);
+       np->def = copy(val);
+       return(np->def);
+}
+
+char *copy(s)
+register char *s;
+{
+       register char *p, *s1;
+
+       p = s1 = (char *) malloc((unsigned)strlen(s)+1);
+       while (*s1++ = *s++);
+       return(p);
+}