From 6fc53266e94e46a62f6cd4a87dcadcded0c523b5 Mon Sep 17 00:00:00 2001 From: Tom London Date: Sun, 5 Nov 1978 23:33:35 -0500 Subject: [PATCH] Bell 32V development 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 Synthesized-from: 32v --- usr/src/cmd/ratfor/r.g | 66 +++++++ usr/src/cmd/ratfor/r.h | 64 +++++++ usr/src/cmd/ratfor/r0.c | 83 +++++++++ usr/src/cmd/ratfor/r1.c | 371 +++++++++++++++++++++++++++++++++++++ usr/src/cmd/ratfor/rio.c | 212 +++++++++++++++++++++ usr/src/cmd/ratfor/rlook.c | 67 +++++++ 6 files changed, 863 insertions(+) create mode 100644 usr/src/cmd/ratfor/r.g create mode 100644 usr/src/cmd/ratfor/r.h create mode 100644 usr/src/cmd/ratfor/r0.c create mode 100644 usr/src/cmd/ratfor/r1.c create mode 100644 usr/src/cmd/ratfor/rio.c create mode 100644 usr/src/cmd/ratfor/rlook.c diff --git a/usr/src/cmd/ratfor/r.g b/usr/src/cmd/ratfor/r.g new file mode 100644 index 0000000000..c692f2ce6f --- /dev/null +++ b/usr/src/cmd/ratfor/r.g @@ -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 index 0000000000..47a6ee7e7b --- /dev/null +++ b/usr/src/cmd/ratfor/r.h @@ -0,0 +1,64 @@ +#include +#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 index 0000000000..3d84e705c1 --- /dev/null +++ b/usr/src/cmd/ratfor/r0.c @@ -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 index 0000000000..b43b8c0683 --- /dev/null +++ b/usr/src/cmd/ratfor/r1.c @@ -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 index 0000000000..89eb6f6106 --- /dev/null +++ b/usr/src/cmd/ratfor/rio.c @@ -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 index 0000000000..0ebf64a923 --- /dev/null +++ b/usr/src/cmd/ratfor/rlook.c @@ -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); +} -- 2.20.1