--- /dev/null
+#include <stdio.h>
+#include "def.h"
+int routbeg;
+
+extern int debug;
+struct coreblk {struct coreblk *nxtblk;
+ int blksize;
+ int nxtfree;
+ int *blk;
+ };
+
+long space;
+challoc(n)
+int n;
+ {
+ int i;
+ i = malloc(n);
+ if(i) { space += n; return(i); }
+ fprintf(stderr,"alloc out of space\n");
+ fprintf(stderr,"total space alloc'ed = %D\n",space);
+ fprintf(stderr,"%d more bytes requested\n",n);
+ exit(1);
+ }
+
+
+chfree(p,n)
+int *p,n;
+ {
+ ASSERT(p,chfree);
+ space -= n;
+ free(p);
+ }
+
+
+struct coreblk *tcore, *gcore;
+int tblksize=12, gblksize=300;
+
+
+balloc(n,p,size) /* allocate n bytes from coreblk *p */
+int n,size; /* use specifies where called */
+struct coreblk **p;
+ {
+ int i;
+ struct coreblk *q;
+ n = (n+sizeof(i)-1)/sizeof(i); /* convert bytes to wds to ensure ints always at wd boundaries */
+ for (q = *p; ; q = q->nxtblk)
+ {
+ if (!q)
+ {
+ q = morespace(n,p,size);
+ break;
+ }
+ if (q-> blksize - q->nxtfree >= n) break;
+ }
+ i = q->nxtfree;
+ q ->nxtfree += n;
+ return( &(q->blk)[i]);
+ }
+
+talloc(n) /* allocate from line-by-line storage area */
+int n;
+ {return(balloc(n,&tcore,tblksize)); }
+
+galloc(n) /* allocate from graph storage area */
+int n;
+ {
+ return(balloc(n,&gcore,gblksize));
+ }
+
+reuse(p) /* set nxtfree so coreblk can be reused */
+struct coreblk *p;
+ {
+ for (; p; p=p->nxtblk) p->nxtfree = 0;
+ }
+
+bfree(p) /* free coreblk p */
+struct coreblk *p;
+ {
+ if (!p) return;
+ bfree(p->nxtblk);
+ p->nxtblk = 0;
+ free(p);
+ }
+
+
+morespace(n,p,size) /* get at least n more wds for coreblk *p */
+int n,size;
+struct coreblk **p;
+ {struct coreblk *q;
+ int t,i;
+
+ t = n<size?size:n;
+ q = malloc(i=t*sizeof(*(q->blk))+sizeof(*q));
+ if(!q){
+ error(": alloc out of space","","");
+ fprintf(stderr,"space = %D\n",space);
+ fprintf(stderr,"%d more bytes requested\n",n);
+ exit(1);
+ }
+ space += i;
+ q->nxtblk = *p;
+ *p = q;
+ q -> blksize = t;
+ q-> nxtfree = 0;
+ q->blk = q + 1;
+ return(q);
+ }
+
+
+
+
+freegraf()
+ {
+ bfree(gcore);
+ gcore = 0;
+
+
+ }
+
+
+
+
+
+
+
+
+
+error(mess1, mess2, mess3)
+char *mess1, *mess2, *mess3;
+ {
+ static lastbeg;
+ if (lastbeg != routbeg)
+ {
+ fprintf(stderr,"routine beginning on line %d:\n",routbeg);
+ lastbeg = routbeg;
+ }
+ fprintf(stderr,"error %s %s %s\n",mess1, mess2, mess3);
+ }
+
+
+faterr(mess1, mess2, mess3)
+char *mess1, *mess2, *mess3;
+ {
+ error(mess1, mess2, mess3);
+ exit(1);
+ }
+
+
+strerr(mess1, mess2, mess3)
+char *mess1, *mess2, *mess3;
+ {
+ error("struct error: ",mess1, mess2);
+ }
--- /dev/null
+#include <stdio.h>
+#
+#include "def.h"
+int errflag;
+FILE *infd;
+
+
+int intcase=1, arbcase=0;
+int exitsize=0; /* max number of nodes to be left in loop without iterating */
+int maxnode=400; /* max number of nodes */
+int maxhash=347; /* prime number = size of hash table */
+int progress=0; /* if not 0, print line number every n lines, n = progress */
+int labinit=10; /* labels generated starting with labinit */
+int labinc=10; /* labels increase by labinc */
+int inputform=0; /* = 0 if freeform input, 1 if standard form input */
+int debug=0;
+int levbrk=1; /* true implies multilevel breaks; false implies single-level breaks only */
+int levnxt=1; /* true implies multilevel nexts; false implies single-level nexts only */
+
+
+int maxprogsw=12; /* number of program switches which can be set */
+char *progsw[] = {"i", "a",
+ "e", "m",
+ "h", "p",
+ "t", "c",
+ "s", "d",
+ "b", "n"
+ };
+
+
+int *swval[] = {&intcase, &arbcase,
+ &exitsize, &maxnode,
+ &maxhash, &progress,
+ &labinit, &labinc,
+ &inputform, &debug,
+ &levbrk, &levnxt
+ };
+
+
+char *getargs(argc, argv)
+int argc; char *argv[];
+ {
+ int n, infile;
+ infile = 0;
+
+ for (n = 1; n < argc; ++n)
+ {
+ if (argv[n][0] == '-')
+ setsw(&argv[n][1]);
+ else
+ {
+ if (infile != 0)
+ error("multiple input files - using first one: ", argv[infile],"");
+ else
+ infile = n;
+ }
+ }
+ if (errflag)
+ exit(1);
+ if (!infile) faterr("no input file","","");
+ infd = fopen(argv[infile],"r");
+ if (infd == NULL)
+ faterr("can't open input file:",argv[infile],"");
+ return;
+ }
+
+setsw(str)
+char *str;
+ {
+ int i, val, swnum;
+#define maxtemp 15
+ char temp[maxtemp];
+ for (i = 0; 'a' <= str[i] && str[i] <= 'z'; ++i)
+ {
+ if (i >= maxtemp)
+ {
+ error("invalid switch:",str,"");
+ errflag = 1;
+ }
+ temp[i] = str[i];
+ }
+ temp[i] = '\0';
+
+ swnum = find(temp,progsw,maxprogsw);
+ if (swnum == -1)
+ {
+ error("invalid switch:", str,"");
+ errflag = 1;
+ return;
+ }
+ if (str[i] == '\0')
+ *(swval[swnum]) = !*(swval[swnum]);
+ else
+ {
+ sscanf(&str[i],"%d",&val);
+ *(swval[swnum]) = val;
+ }
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+
+int routnum;
+FILE *debfd;
+LOGICAL routerr;
+int nodenum, accessnum;
+int **graph;
+int progtype;
+VERT stopvert, retvert;
+VERT START;
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+struct lablist {long labelt; struct lablist *nxtlab; };
+struct lablist *endlab, *errlab, *reflab, *linelabs, *newlab;
+
+int nameline; /* line number of function/subroutine st., if any */
+int stflag; /* determines whether at beginning or middle of block of straight line code */
+
+
+
+int nlabs, lswnum, swptr, flag,
+ counter, p1, p3, begline, endline, r1,r2, endcom;
+long begchar, endchar, comchar;
+
+
+char *pred, *inc, *prerw, *postrw, *exp, *stcode;
+
+#define maxdo 20 /* max nesting of do loops */
+long dostack[maxdo]; /* labels of do nodes */
+int doloc[maxdo]; /* loc of do node */
+int doptr;
+
+
+struct list *FMTLST; /* list of FMTVX's generated */
+struct list *ENTLST; /* list of STLNVX nodes corresponding to entry statements */
+long rtnbeg; /* number of chars up to beginning of current routine */
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+
+#define TABOVER(n) tabover(n,stderr)
+prgraph()
+ {
+ VERT v;
+ int i;
+ if (progress) fprintf(stderr,"prgraph():\n");
+ for (v = 0; v < nodenum; ++v)
+ {
+ fprintf(stderr,"%d %s:",v, typename[NTYPE(v)]);
+ for (i = 0; i < ARCNUM(v); ++i)
+ {
+ printf("%d ",ARC(v,i));
+ ASSERT(UNDEFINED <= ARC(v,i) && ARC(v,i) < nodenum, prgraph);
+ }
+ printf("\n");
+ }
+ printf("\n\n");
+ }
+
+prtree()
+ {
+ prtr(START,1);
+ }
+
+prtr(v,tab) /* print tree in form of program indenting by tab */
+VERT v;
+int tab;
+ {
+ int i;
+ TABOVER(tab);
+ fprintf(stderr,"%d %s:",v,typename[NTYPE(v)]);
+ for (i = 0; i < ARCNUM(v); ++i)
+ fprintf(stderr," %d",ARC(v,i));
+ printf("\n");
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ TABOVER(tab+1);
+ fprintf(stderr,"{\n");
+ if (DEFINED(LCHILD(v,i)))
+ prtr(LCHILD(v,i),tab+1);
+ TABOVER(tab+1);
+ fprintf(stderr,"}\n");
+ }
+ if (DEFINED(RSIB(v)))
+ prtr(RSIB(v),tab);
+ }
+
+
+tabover(n,fd) /* tab n times */
+int n;
+FILE *fd;
+ {
+ int i;
+ for (i = 0; i < n; ++i)
+ putc('\t',fd);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+
+struct list *consls(v,ls) /* make list */
+VERT v;
+struct list *ls;
+ {
+ struct list *temp;
+ temp = challoc(sizeof(*temp));
+ temp->elt = v;
+ temp->nxtlist = ls;
+ return(temp);
+ }
+
+struct list *append(v,ls) /* return ls . v */
+VERT v;
+struct list *ls;
+ {
+ struct list *temp;
+ if (!ls) return(consls(v,0));
+ for (temp = ls; temp -> nxtlist; temp = temp->nxtlist)
+ ;
+ temp->nxtlist = consls(v,0);
+ return(ls);
+ }
+
+
+freelst(ls)
+struct list *ls;
+ {
+ if (!ls) return;
+ if (ls->nxtlist)
+ freelst(ls->nxtlist);
+ chfree(ls,sizeof(*ls));
+ }
+
+
+oneelt(ls) /* return w if w is only elt of ls, UNDEFINED otherwise */
+struct list *ls;
+ {
+ if (!ls) return(UNDEFINED);
+ if (ls->nxtlist) return(UNDEFINED);
+ return(ls->elt);
+ }
+
+
+lslen(ls) /* return number of elements in list ls */
+struct list *ls;
+ {
+ int count;
+ struct list *lp;
+ count = 0;
+ for (lp = ls; lp; lp = lp->nxtlist)
+ ++count;
+ return(count);
+ }
+
+
+prlst(ls)
+struct list *ls;
+ {
+ struct list *lp;
+ for (lp = ls; lp; lp = lp->nxtlist)
+ printf("%d,",lp->elt);
+ fprintf(stderr,"\n");
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+
+char *typename[TYPENUM] = {"STLNVX", "IFVX", "DOVX", "IOVX", "FMTVX",
+ "COMPVX", "ASVX", "ASGOVX", "LOOPVX", "WHIVX",
+ "UNTVX", "ITERVX", "THENVX", "STOPVX", "RETVX",
+ "DUMVX", "GOVX", "BRKVX", "NXTVX", "SWCHVX",
+ "ACASVX", "ICASVX"
+ };
+int hascom[TYPENUM] = {2, 2, 2, 2, 2,
+ 2, 2, 2, 0, 0,
+ 0, 0, 2, 0, 0,
+ 0, 0, 0, 0, 2,
+ 2, 0
+ };
+
+int nonarcs[TYPENUM] = {FIXED+3, FIXED+4, FIXED+2, FIXED+3, FIXED+2,
+ FIXED+2, FIXED+2, FIXED+2, FIXED+1, FIXED+1,
+ FIXED+1, FIXED+4, FIXED+3, FIXED, FIXED,
+ FIXED+2, FIXED+1, FIXED + 1, FIXED + 1, FIXED+3,
+ FIXED+4, FIXED+2
+ };
+
+int childper[TYPENUM] = {0, 2, 1, 0, 0,
+ 0, 0, 0, 1, 1,
+ 1, 1, 1, 0, 0,
+ 1, 0, 0, 0, 1,
+ 2, 1
+ };
+
+int arcsper[TYPENUM] = {1, 2, 2, 3, 0,
+ -(FIXED+1), 1, -(FIXED+1), 1, 1,
+ 1, 1, 2, 0, 0,
+ -FIXED, 1, 1, 1, -(FIXED+1),
+ 2, 1
+ };
+
+VERT *arc(v,i)
+VERT v;
+int i;
+ {
+ ASSERT(DEFINED(v),arc);
+ ASSERT(0 <= i && i < ARCNUM(v), arc);
+ return(&graph[v][nonarcs[NTYPE(v)] + i ]);
+ }
+
+VERT *lchild(v,i)
+VERT v; int i;
+ {
+ ASSERT(DEFINED(v),lchild);
+ ASSERT(0 <= i && i < childper[NTYPE(v)],lchild);
+ return(&graph[v][nonarcs[NTYPE(v)]-i-1]);
+ }
+
+int *vxpart(v,type,j)
+VERT v;
+int type,j;
+ {
+ ASSERT((NTYPE(v) == type) && (0 <= j) && (j < nonarcs[type] - FIXED), vxpart);
+ return(&graph[v][FIXED+j]);
+ }
+
+int *expres(v)
+VERT v;
+ {
+ int ty;
+ ty = NTYPE(v);
+ ASSERT(ty == COMPVX || ty == ASGOVX || ty == ASVX || ty == SWCHVX || ty == ICASVX,expres);
+ return(&graph[v][FIXED]);
+ }
+
+int *negpart(v)
+VERT v;
+ {
+ ASSERT(NTYPE(v) == IFVX || NTYPE(v) == ACASVX,negpart);
+ return(&graph[v][FIXED+1]);
+ }
+
+int *predic(v)
+VERT v;
+ {
+ ASSERT(NTYPE(v) == IFVX || NTYPE(v) == ACASVX, predic);
+ return(&graph[v][FIXED]);
+ }
+
+int *level(v)
+VERT v;
+ {
+ ASSERT(NTYPE(v) == GOVX || NTYPE(v) == BRKVX || NTYPE(v) == NXTVX, level);
+ return(&graph[v][FIXED]);
+ }
+int *stlfmt(v,n)
+VERT v;
+int n;
+ {
+ ASSERT(NTYPE(v) == STLNVX || NTYPE(v) == FMTVX,stlfmt);
+ return(&graph[v][FIXED + n]);
+ }
+
+create(type,arcnum)
+int type, arcnum;
+ {
+ int i, *temp, wds;
+ if (nodenum >= maxnode)
+ {
+ maxnode += 100;
+ temp=realloc(graph,maxnode*sizeof(*graph));
+ free(graph);
+ graph=temp;
+ }
+ wds = nonarcs[type] + arcnum;
+ graph[nodenum] = galloc(sizeof(*graph) * wds);
+ for (i = 0; i < wds; i++) graph[nodenum][i] = 0;
+ NTYPE(nodenum) = type;
+ if (arcsper[type] < 0)
+ ARCNUM(nodenum) = arcnum;
+
+ return(nodenum++);
+ }
+
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "1.defs.h"
+
+str_copy(s,ptr,length) /* copy s at ptr, return length of s */
+char *s, *ptr;
+int length;
+ {int i;
+ for (i = 0; i < length; i++)
+ {
+ ptr[i] = s[i];
+ if (ptr[i] == '\0')
+ return(i + 1);
+ }
+ faterr("string too long to be copied at given address:\n",s,"");
+ }
+
+
+find(s,ar,size)
+char *s,*ar[];
+int size;
+ {
+ int i;
+ for (i=0; i < size; i++)
+ {if (str_eq(s, ar[i])) return(i);}
+ return(-1);
+ }
+
+
+str_eq(s,t)
+char s[],t[];
+ {int j;
+ for (j = 0; s[j] == t[j]; j++)
+ {if (s[j] == '\0') return(1);}
+ return(0);
+ }
+
+
+classmatch(c,i)
+char c;
+int i;
+ {switch(i)
+ {case _digit:
+ if ('0' <= c && c <= '9') return(1);
+ else return(0);
+
+ case _letter:
+ if ( ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z'))
+ return(1);
+ else return(0);
+
+ case _diglet: return(classmatch(c,_digit)||classmatch(c,_letter) );
+
+ case _arith:
+ if (050 <= c && c<= 057) return(1);
+ else return(0);
+ case _nl:
+ return(c=='\n');
+ case _other:
+ return(1);
+ }
+ }
+
+
+copychars(cbeg,target,n) /* copy n chars from cbeg to target */
+char *cbeg, *target;
+int n;
+ {
+ int i;
+ for (i = 0; i < n; i++)
+ target[i] = cbeg[i];
+ }
+
+
+
+copycs(cbeg,target,n) /* copy n chars from cbeg to target, add '\0' */
+char *cbeg, *target;
+int n;
+ {
+ copychars(cbeg,target,n);
+ target[n] = '\0';
+ }
+
+
+slength(s) /* return number of chars in s, not counting '\0' */
+char *s;
+ {
+ int i;
+ if (!s) return(-1);
+ for (i = 0; s[i] != '\0'; i++);
+ return(i);
+ }
+
+
+concat(x,y) /* allocate space, return xy */
+char *x, *y;
+ {
+ char *temp;
+ int i,j;
+ i = slength(x);
+ j = slength(y);
+ temp = galloc(i + j + 1);
+ sprintf(temp,"%s",x);
+ sprintf(&temp[i],"%s",y);
+ return(temp);
+ }
--- /dev/null
+#define snum 145
+#define _s0 0
+#define _s1 1
+#define _s2 2
+#define _s3 3
+#define _s4 4
+#define _start 5
+#define _g 6
+#define _go 7
+#define _got 8
+#define _goto 9
+#define _ugo 10
+#define _ago 11
+#define _agoc 12
+#define _agol 13
+#define _agor 14
+#define _cgo 15
+#define _cgold 16
+#define _cgor 17
+#define _cgoc 18
+#define _i 19
+#define _if 20
+#define _if1 21
+#define _if2 22
+#define _pard 23
+#define _arif 24
+#define _c 25
+#define _co 26
+#define _con 27
+#define _cont 28
+#define _conti 29
+#define _contin 30
+#define _con_u 31
+#define _con_ue 32
+#define _d 33
+#define _do 34
+#define _dol 35
+#define _dov 36
+#define _doveq 37
+#define _a 38
+#define _as 39
+#define _ass 40
+#define _assi 41
+#define _assig 42
+#define _assign 43
+#define _assd 44
+#define _ast 45
+#define _asto 46
+#define _fr 47
+#define _fre 48
+#define _frea 49
+#define _1func 50
+#define _1f 51
+#define _fu 52
+#define _fun 53
+#define _func 54
+#define _funct 55
+#define _fncti 56
+#define _fncto 57
+#define _fin 58
+#define _fint 59
+#define _finte 60
+#define _fintg 61
+#define _finge 62
+#define _fc 63
+#define _fco 64
+#define _fcom 65
+#define _fcomp 66
+#define _fcmpl 67
+#define _fcple 68
+#define _fdou 69
+#define _fdoub 70
+#define _fdobl 71
+#define _fdble 72
+#define _fp 73
+#define _fpr 74
+#define _fpre 75
+#define _fprec 76
+#define _fprci 77
+#define _fpris 78
+#define _fprsi 79
+#define _fprco 80
+#define _fl 81
+#define _flo 82
+#define _flog 83
+#define _flogi 84
+#define _flgic 85
+#define _flgca 86
+#define _s 87
+#define _st 88
+#define _sto 89
+#define _su 90
+#define _sub 91
+#define _subr 92
+#define _subro 93
+#define _subrt 94
+#define _subri 95
+#define _subrn 96
+#define _r 97
+#define _re 98
+#define _ret 99
+#define _retu 100
+#define _retr 101
+#define _e 102
+#define _en 103
+#define _end 104
+#define _ent 105
+#define _entr 106
+#define _fo 107
+#define _for 108
+#define _form 109
+#define _fma 110
+#define _fmt 111
+#define _w 112
+#define _wr 113
+#define _wri 114
+#define _writ 115
+#define _write 116
+#define _read 117
+#define _rdig 118
+#define _rwp 119
+#define _rwlab 120
+#define _rwe 121
+#define _rwen 122
+#define _rwend 123
+#define _endeq 124
+#define _rwer 125
+#define _rwerr 126
+#define _p 127
+#define _pr 128
+#define _pri 129
+#define _prin 130
+#define _pu 131
+#define _pun 132
+#define _punc 133
+#define _bd 134
+#define _bl 135
+#define _blo 136
+#define _blc 137
+#define _blk 138
+#define _bld 139
+#define _blda 140
+#define _bldt 141
+#define ABORT 142
+#define endrt 143
+#define nulls 144
+#define _other 1
+#define _digit 2
+#define _letter 3
+#define _diglet 4
+#define _arith 5
+#define _nl 6
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "1.incl.h"
+
+fingraph()
+ {
+ /* if any entry statements, add a DUMVX with arcs to all entry statements */
+ if (ENTLST)
+ {
+ ARC(START,0) = addum(ARC(START,0),ENTLST);
+ freelst(ENTLST);
+ }
+ /* if any FMTVX, add a DUMVX with arcs to all FMTVX's */
+ if (FMTLST)
+ {
+ ARC(START,0) = addum(ARC(START,0),FMTLST);
+ freelst(FMTLST);
+ }
+ }
+
+addum(v,lst)
+VERT v;
+struct list *lst;
+ {
+ VERT new;
+ int count,i;
+ struct list *ls;
+ count = lslen(lst); /* length of lst */
+ new = create(DUMVX,1+count);
+ ARC(new,0) = v;
+ for (i = count, ls = lst; i >= 1; --i, ls = ls->nxtlist)
+ {
+ ASSERT(ls,addum);
+ ARC(new,i) = ls->elt;
+ }
+ ASSERT(!ls, addum);
+ return(new);
+ }
--- /dev/null
+#include <stdio.h>
+#include "1.defs.h"
+#include "def.h"
+extern int linechar, errflag, debug;
+extern int (*input)(), (*unput)();
+
+
+
+uptolow(c) /*translates upper to lower case */
+int c;
+ {
+ if ('A' <= c && c <= 'Z')
+ return(c+'a'-'A');
+ else
+ return(c);
+ }
+
+rdfree(func)
+int (*func)();
+ {
+ int c;
+ while ( (c = (*input)()) != '\n')
+ {
+ (*func)(c);
+ }
+ }
+
+rdstand(func)
+int (*func)();
+ {
+ int c;
+ while ( (c=(*input)()) != '\n')
+ {
+ (*func)(c);
+ }
+ }
+
+labfree(func) /* labels in freeform input */
+int (*func)();
+ {
+ int c;
+ int temp[6];
+ int j;
+ for (j = 0; j < 5; ++j)
+ {
+ while ( (c = (*input)()) == ' ' || c == '\t' );
+ if (c == '\n')
+ {
+ if (j != 0)
+ {
+ temp[j] = '\0';
+ error("label without code - ignored:","","");
+ }
+ }
+ if (c < '0' || c > '9')
+ {
+ (*unput)(c);
+ break;
+ }
+ else
+ {
+ temp[j] = c;
+ (*func)(c);
+ }
+ }
+ for ( ; j < 5; ++j)
+ (*func)(' ');
+ }
+
+labstand(func) /* labels in standard form input */
+int (*func)();
+ {
+ int c;
+ int j;
+
+ for (j = 0; j < 5; ++j)
+ {
+ c = (*input)();
+ if (c == '\n')
+ {
+ error("line shorter than 5 characters","","");
+ errflag = 1;
+ (*unput)('\n');
+ }
+ if (c == '\t' || c == '\n')
+ {
+ for ( ;j<5; ++j)
+ (*func)(' ');
+ return;
+ }
+ (*func)(c);
+ }
+ (*input)(); /* throw away continuation char */
+ }
+
+
+
+contfree() /* identify continuation lines in free-form input */
+ {
+ return(nonblchar(_diglet,0)); /* any non-alpha non-digit */
+ }
+
+
+nonblchar(class,yesno)
+int class,yesno;
+ {
+#define CARDSIZE 121
+ int temp[CARDSIZE];
+ int j;
+ for (j=0; (temp[j]=(*input)()) == ' ' || temp[j] == '\t'; ++j)
+ if (j>=CARDSIZE-1)
+ {
+ temp[CARDSIZE-1] = '\0';
+ error ("line unexpectedly long","","");
+ break;
+ }
+ if (temp[j]!=EOF && classmatch(temp[j],class)==yesno)
+ return(1);
+ else
+ {
+ for ( ; j >= 0; --j)
+ (*unput)(temp[j]);
+ return(0);
+ }
+ }
+
+
+contstand() /* continuation lines in standard form input */
+ {
+ int temp[6];
+ int i;
+
+ for (i = 0; i < 6; ++i)
+ {
+ temp[i] = (*input)();
+ if (temp[i] == '\t' || temp[i] == '\n' || temp[i] == '\0' || temp[i] == EOF)
+ {
+ for ( ;i >= 0; --i)
+ (*unput)(temp[i]);
+ return(0);
+ }
+ }
+ if (temp[5] != '0' && temp[5] != ' ')
+ return(1);
+ else
+ {
+ for ( i = 5 ; i >= 0; --i)
+ (*unput)(temp[i]);
+ return(0);
+ }
+ }
+
+
+
+comstand(posafter) /* standard form comments */
+int posafter;
+ {
+ int c;
+ c = (*input)();
+ if (!posafter)
+ (*unput)(c);
+ if (c == 'c' || c == '*' || c== '#')
+ return(1);
+ else
+ return(0);
+ }
+
+
+comfree(posafter)
+int posafter;
+ {
+ return(comstand(posafter));
+ }
+int (*rline[])() = {rdfree,rdstand};
+int (*comment[])() = {comfree,comstand};
+int (*getlabel[])() = {labfree, labstand};
+int (*chkcont[])() = {contfree,contstand};
+
+blankline()
+ {
+ if ( nonblchar(_nl,1) ) /* first non-blank is nl */
+ {
+ (*unput) ('\n');
+ return(1);
+ }
+ else return(0);
+ }
+
+#define maxunbp 80
+char unbuf[maxunbp+1];
+int unbp;
+
+empseek(linebeg)
+int linebeg;
+ {
+ unbp = 0;
+ if (fseek(infd,(long)(linebeg+rtnbeg),0) == -1)
+ faterr("in disk seek","","");
+ }
+
+inchar()
+ {
+ if (unbp > 0)
+ return( unbuf[--unbp] );
+ else
+ {
+ return( uptolow(getc(infd)) );
+ }
+ }
+
+
+unchar(c)
+int c;
+ {
+ if (unbp >= maxunbp)
+ faterr("dec.rat: unbuf size exceeded","","");
+ if(c!=EOF)unbuf[unbp++] = c;
+ }
--- /dev/null
+#include <stdio.h>
+#include "1.incl.h"
+#include "1.defs.h"
+#include "def.h"
+
+
+act(k,c,bufptr)
+int k,bufptr;
+char c;
+ {
+ long ftemp;
+ struct lablist *makelab();
+ switch(k)
+ /*handle labels */
+ {case 1:
+ if (c != ' ')
+ {
+ ftemp = c - '0';
+ newlab->labelt = 10L * newlab->labelt + ftemp;
+
+ if (newlab->labelt > 99999L)
+ {
+ error("in syntax:\n","","");
+ fprintf(stderr,"line %d: label beginning %D too long\n%s\n",
+ begline,newlab->labelt,buffer);
+ fprintf(stderr,"treating line as straight line code\n");
+ return(ABORT);
+ }
+ }
+ break;
+
+ case 3: nlabs++;
+ newlab = newlab->nxtlab = makelab(0L);
+ break;
+
+ /* handle labsw- switches and labels */
+ /* handle if statements */
+ case 30: counter++; break;
+
+ case 31:
+ counter--;
+ if (counter) return(_if1);
+ else
+ {
+ pred = remtilda(stralloc(&buffer[p1],bufptr - p1));
+ p3 = bufptr + 1; /* p3 pts. to 1st symbol after ) */
+ flag = 1;
+ return(_if2); }
+
+ case 45: /* set p1 to pt.to 1st symbol of pred */
+ p1 = bufptr + 1;
+ act(30,c,bufptr); break;
+
+ /* handle do loops */
+ case 61: p1 = bufptr; break; /* p1 pts. to 1st symbol of increment string */
+
+ case 62: counter ++; break;
+
+ case 63: counter --; break;
+
+ case 64:
+ if (counter != 0) break;
+ act(162,c,bufptr);
+ return(ABORT);
+
+ case 70: if (counter) return(_rwp);
+ r1 = bufptr;
+ return(_rwlab);
+
+ case 72: exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); break;
+
+ case 73: endlab = newlab;
+ break;
+
+ case 74: errlab = newlab;
+ break;
+
+ case 75: reflab = newlab;
+ act(3,c,bufptr);
+ break;
+
+ case 76: r1 = bufptr; break;
+
+ case 77:
+ if (!counter)
+ {
+ act(111,c,bufptr);
+ return(ABORT);
+ }
+ counter--;
+ break;
+ /* generate nodes of all types */
+ case 111: /* st. line code */
+ stcode = remtilda(stralloc(&buffer[p3],endbuf - p3));
+ recognize(STLNVX,flag);
+ return(ABORT);
+
+ case 122: /* uncond. goto */
+ recognize(ungo,flag);
+ break;
+
+ case 123: /* assigned goto */
+ act(72,c,bufptr);
+ faterr("in parsing:\n","assigned goto must have list of labels","");
+
+ case 124: /* ass. goto, labels */
+ recognize(ASGOVX, flag);
+ break;
+
+ case 125: /* computed goto*/
+ exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1));
+ recognize(COMPVX, flag);
+ return(ABORT);
+
+ case 133: /* if() = is a simple statement, so reset flag to 0 */
+ flag = 0;
+ act(111,c,bufptr);
+ return(ABORT);
+
+ case 141: /* arith. if */
+ recognize(arithif, 0);
+ break;
+
+ case 150: /* label assignment */
+ exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1));
+ recognize(ASVX, flag);
+ break;
+
+ case 162: /* do node */
+ inc = remtilda(stralloc(&buffer[p1],endbuf - p1));
+ recognize(DOVX, 0);
+ break;
+
+ case 180: /* continue statement */
+ recognize(contst, 0);
+ break;
+
+ case 200: /* function or subroutine statement */
+ progtype = sub;
+ nameline = begline;
+ recognize(STLNVX,0);
+ break;
+
+
+ case 210: /* block data statement */
+ progtype = blockdata;
+ act(111,c,bufptr);
+ return(ABORT);
+
+ case 300: /* return statement */
+ recognize(RETVX,flag);
+ break;
+
+
+ case 350: /* stop statement */
+ recognize(STOPVX, flag);
+ break;
+
+
+ case 400: /* end statement */
+ if (progtype == sub)
+ act(300, c, bufptr);
+ else
+ act(350, c, bufptr);
+ return(endrt);
+
+ case 500:
+ prerw = remtilda(stralloc(&buffer[p3],r1 - p3 + 1));
+ postrw = remtilda(stralloc(&buffer[r2],endbuf - r2));
+ if (reflab || endlab || errlab) recognize(IOVX,flag);
+ else recognize(STLNVX,flag);
+ return(ABORT);
+
+ case 510: r2 = bufptr;
+ act(3,c,bufptr);
+ act(500,c,bufptr);
+ return(ABORT);
+
+ case 520: r2 = bufptr;
+ reflab = newlab;
+ act(3,c,bufptr);
+ act(500,c,bufptr);
+ return(ABORT);
+
+
+ case 600:
+ recognize(FMTVX,0); return(ABORT);
+
+ case 700:
+ stcode = remtilda(stralloc(&buffer[p3],endbuf - p3));
+ recognize(entry,0); return(ABORT);
+ /* error */
+ case 999:
+ printf("error: symbol '%c' should not occur as %d'th symbol of: \n%s\n",
+ c,bufptr, buffer);
+ return(ABORT);
+ }
+ return(nulls);
+ }
+
+
+
+struct lablist *makelab(x)
+long x;
+ {
+ struct lablist *p;
+ p = challoc (sizeof(*p));
+ p->labelt = x;
+ p->nxtlab = 0;
+ return(p);
+ }
+
+
+long label(i)
+int i;
+ {
+ struct lablist *j;
+ for (j = linelabs; i > 0; i--)
+ {
+ if (j == 0) return(0L);
+ j = j->nxtlab;
+ }
+ if (j)
+ return(j->labelt);
+ else
+ return(0L);
+ }
+
+
+freelabs()
+ {
+ struct lablist *j,*k;
+ j = linelabs;
+ while(j != 0)
+ {
+ k = j->nxtlab;
+ chfree(j,sizeof(*j));
+ j = k;
+ }
+ }
+
+
+stralloc(ad,n) /* allocate space, copy n chars from address ad, add '0' */
+int n; char *ad;
+ {
+ char *cp;
+ cp = galloc(n+1);
+ copycs(ad,cp,n);
+ return(cp);
+ }
+
+
+remtilda(s) /* change ~ to blank */
+char *s;
+ {
+ int i;
+ for (i = 0; s[i] != '\0'; i++)
+ if (s[i] == '~') s[i] = ' ';
+ return(s);
+ }
--- /dev/null
+#include <stdio.h>
+#include "1.incl.h"
+#include "1.defs.h"
+#include"def.h"
+
+extern int match[], symclass[], action[], newstate[];
+extern char symbol[];
+long *hashtab;
+int *value, *chain;
+
+extern FILE *infd;
+
+
+parse()
+ {int i,j,found,current, someread;
+ char c;
+
+ hash_init();
+ routinit();
+ line_init();
+
+ someread = 0; /* indicates haven't read part of a routine */
+
+ empseek(0);
+ endbuf = getline(&endline, &endchar, &endcom, & comchar);
+ if (progress && endbuf != -1) fprintf(stderr,"parsing\n");
+ while(endbuf != -1) /* getline returns -1 when no more input */
+ {
+ someread = 1;
+ if (progress > 0)
+ {
+ for (i = begline; i <= endline; i++)
+ if (!(i % progress)) fprintf(stderr,"parsing line %d\n",i);
+ }
+ current = 0;
+ for (i = 0; i < endbuf; i++)
+ {
+
+ c = buffer[i];
+ if(c != '~')
+ {
+ found = 0;
+ if ( (current < 0 || current >= snum) && current != ABORT)
+ {
+ strerr("in parsing:","","");
+ fprintf(stderr,"line %d of file, parser in invalid state", begline,current);
+ fprintf(stderr,"treating it as straight line code\n");
+ current = ABORT;
+ }
+ else
+ for (j = match[current]; j < match[current + 1]; j++)
+ {
+ if ((symclass[j] == 0 && c == symbol[j]) ||
+ (symclass[j] != 0 && classmatch(c,symclass[j]) ))
+ {found = 1; break;
+ }
+ }
+ if (!found)
+ {
+ error("in syntax:","","");
+ fprintf(stderr,"between lines %d and %d of file\n",begline, endline);
+ if (debug)
+ fprintf(stderr,"symbol '%c' does not match entries for state %d\n",c,current);
+ fprintf(stderr,"treating it as straight line code\n");
+ current = ABORT;
+ }
+ else if (!action[j])
+ current = newstate[j];
+ else
+ {
+ current = act(action[j],c,i);
+ if (current == nulls) current = newstate[j];
+ }
+ if (current == ABORT) break;
+ if (current == endrt)
+ {
+ return(1);
+ }
+ }
+ }
+ line_init();
+ endbuf = getline(&endline, &endchar, &endcom,&comchar);
+ }
+ if (someread) return(1);
+ else return(0);
+ }
+
+
+hash_init()
+ {
+ int i;
+ hashtab = challoc(sizeof(*hashtab) * maxhash);
+ chain = challoc(sizeof(*chain) * maxhash);
+ value = challoc(sizeof(*value) * maxhash);
+ for (i = 0; i < maxhash; i++)
+ {
+ hashtab[i] = -1L;
+ value[i] = -2;
+ chain[i] = 0;
+ }
+ }
+
+
+hash_check()
+ {
+ int i;
+ for (i = 0; i < maxhash; ++i)
+ if (value[i] == -2 && hashtab[i] != -1L)
+ {
+ error("in syntax; label used but does not appear as statement label:","","");
+ fprintf(stderr,"%D\n",hashtab[i]);
+ routerr = 1;
+ }
+ }
+
+hash_free()
+ {
+ chfree(hashtab,sizeof(*hashtab) * maxhash);
+ hashtab = 0;
+ chfree(chain,sizeof(*chain) * maxhash);
+ chain = 0;
+ chfree(value,sizeof(*value) * maxhash);
+ value = 0;
+ }
+hash(x)
+long x;
+ {
+ int quo, rem, hcount, temp;
+
+ ASSERT(x >= 0L, hash);
+ quo = x/maxhash;
+ rem = x - (quo * maxhash);
+ if (quo == 0) quo = 1;
+
+ temp = rem;
+ for (hcount=0; (hashtab[temp] != -1L) && (hashtab[temp] != x) && (hcount<maxhash); hcount++)
+ temp = (temp + quo)%maxhash;
+ if(hcount>=maxhash) faterr("hash table overflow - too many labels","","");
+ hashtab[temp] = x;
+ return(temp);
+ }
+
+addref(x,ptr) /* put ptr in chain for x or assign value of x to *ptr */
+long x;
+int *ptr;
+ {
+ int index;
+ index = hash(x);
+
+ if (value[index] == -1)
+ { /* x already assigned value */
+ *ptr = chain[index];
+ return;
+ }
+
+ /* add ptr to chain */
+
+ if (chain[index] == 0)
+ *ptr = 0;
+ else
+ *ptr = chain[index];
+ chain[index] = ptr;
+ }
+
+fixvalue (x,ptr)
+long x;
+int ptr;
+ {
+ int *temp1, *temp2, index, temp0;
+ index = hash(x);
+
+ while (index != -2)
+ { /* trace chain of linked labels */
+
+ if (value[index] == -1)
+ {
+ error("in syntax: ","","");
+ fprintf(stderr,"attempt to redefine value of label %D between lines %d and %d\n",
+ x,begline,endline);
+ routerr = 1;
+ return;
+ }
+
+ temp1 = &chain[index]; /* trace chain for each label */
+ while (temp1 != 0)
+ {
+ temp2 = *temp1;
+ *temp1 = ptr;
+ temp1 = temp2;
+ }
+ temp0 = index;
+ index = value[index];
+ value[temp0] = -1;
+ }
+ }
+
+connect(x,y)
+long x,y;
+ {
+ int *temp, index, temp2;
+ index = hash(x);
+
+ if (value[index] == -1)
+ fixvalue(y, chain[index]);
+ else
+ {
+ if (y == implicit)
+ { /* attach implicit chain to x chain */
+ temp = &chain[index];
+
+ while (*temp != 0)
+ temp = *temp;
+
+ *temp = chain[hash(y)];
+ }
+ temp2 = index; /* attach y linked labels to x linked labels */
+ while (value[temp2] >= 0)
+ temp2 = value[temp2];
+ if (y == implicit)
+ value[temp2] = value[hash(y)];
+ else
+ value[temp2] = hash(y);
+ }
+ if (y == implicit) clear(y);
+ }
+
+
+clear(x)
+long x;
+ {
+ int index;
+ index = hash(x);
+ value[index] = -2;
+ chain[index] = 0;
+ hashtab[index] = -1L;
+ }
+
+
--- /dev/null
+#define maxlsw 10 /* max number of switches and labels per statement */
+#define implicit 0L /* "label" of following line so all flow can be treated as jump to label */
+struct lablist {long labelt; struct lablist *nxtlab; };
+extern struct lablist *endlab, *errlab, *reflab, *linelabs, *newlab;
+extern long label();
+
+extern int routbeg; /* line number of first line of routine */
+extern int nameline; /* line number of function/subroutine st., if any */
+extern int stflag; /* determines whether at beginning or middle of block of straight line code */
+
+
+
+extern char buffer[];
+extern int endbuf;
+
+extern int nlabs, lswnum, swptr, flag,
+ counter, p1, p3, begline, endline, r1,r2, endcom;
+extern long begchar, endchar, comchar;
+
+
+/* statement types not associated with actual node types */
+#define contst -1
+#define ungo -2
+#define arithif -3
+#define readst -8
+#define writest -9
+#define entry -10
+
+
+extern char *pred, *inc, *prerw, *postrw, *exp, *stcode;
+
+#define maxdo 20 /* max nesting of do loops */
+extern long dostack[maxdo]; /* labels of do nodes */
+extern int doloc[maxdo]; /* loc of do node */
+extern int doptr;
+
+
+extern struct list *FMTLST; /* list of FMTVX's generated */
+extern struct list *ENTLST; /* list of STLNVX nodes corresponding to entry statements */
--- /dev/null
+#include <stdio.h>
+#include "1.defs.h"
+#include "1.incl.h"
+#include "def.h"
+
+
+prog_init()
+ {
+ endline = endcom = 0; endchar = -1;
+ comchar = -1;
+ graph = challoc(sizeof(*graph) * maxnode);
+ }
+
+routinit()
+ {
+ graf_init();
+ progtype = !sub;
+ routbeg = endline + 1;
+ rtnbeg = endchar + 1;
+ nameline = 0;
+ stflag = UNDEFINED;
+ }
+line_init()
+ {
+ struct lablist *makelab();
+ freelabs();
+ newlab = linelabs = makelab(0L);
+ flag = counter = nlabs = lswnum = swptr = p1 = 0;
+ p3 = 5;
+ endcom = endline;
+ comchar = endchar;
+ begline = endline + 1; begchar = endchar + 1;
+ reflab = endlab = errlab = 0;
+ r1 = r2 = 0;
+ }
+graf_init()
+ {
+ int arctype[3]; long arclab[3];
+ nodenum = 0;
+ doptr = UNDEFINED;
+ retvert = stopvert = UNDEFINED;
+ ENTLST = FMTLST = 0;
+
+
+ arctype[0] = -2; arclab[0] = implicit;
+ START = makenode(DUMVX,FALSE,FALSE,implicit,1,arctype,arclab);
+ }
+
--- /dev/null
+#include <stdio.h>
+#
+#include "def.h"
+#define bufsize 1601
+char buffer[bufsize];
+int bufcount;
+extern int errflag;
+long stchars; /* counts number of chars at most recent \n read */
+#ifndef unix
+long ostchars;
+extern long ftell();
+#endif
+int newline; /* counts number of lines read so far in file */
+extern int rdfree(), comfree(),labfree(), contfree();
+extern int rdstand(), comstand(), labstand(), contstand();
+extern int (*rline[])();
+extern int (*comment[])();
+extern int (*getlabel[])();
+extern int (*chkcont[])();
+
+
+
+flush()
+ {bufcount = 0; }
+
+addchar(c)
+ {
+ buffer[bufcount++] = c;
+ }
+
+getline(lastline,lastchar,linecom,charcom)
+int *lastline, *linecom;
+long *lastchar, *charcom;
+ /* set *lastline to number of last line of statement,
+ set *lastchar to number of last char of statement,
+ set *linecom to number of last line of comment preceding statement */
+ {
+
+ int i;
+ flush();
+ while ( unput1(input1()) != EOF)
+ {
+ while ( (*comment[inputform])(0) || blankline() )
+ {
+ (*rline[inputform])(addchar);
+ flush();
+ }
+ *linecom = newline;
+ /* set charcom to number of last char of comment, starting at 0
+ if at start of file and no comment, will be -1 */
+ *charcom = stchars - 1;
+ if (unput1(input1()) == EOF) break;
+ (*getlabel[inputform])(addchar);
+ (*rline[inputform])(addchar);
+
+ while ( blankline() || ( !(*comment[inputform])(0) && (*chkcont[inputform])() ))
+ (*rline[inputform])(addchar);
+
+ addchar('\0');
+ *lastline = newline;
+ *lastchar = stchars - 1;
+if (debug == 40)
+fprintf(stderr,"line %d; bufcount: %d\n",newline,bufcount);
+
+ for (i = 5; i < bufcount; ++i)
+ if (buffer[i] == ' ' || buffer[i] == '\t' || buffer[i] == '\n')
+ buffer[i] = '~';
+ return(bufcount);
+ }
+ return(-1);
+ }
+
+
+int linechars; /* counts number of chars read so far in current line */
+long newchar; /* counts number of chars read so far in file */
+
+
+input1()
+ {
+ static int c;
+ if (c == '\n') linechars = 0;
+ c = inchar();
+ ++linechars;
+ ++newchar;
+ if (c == '\n')
+ {
+ ++newline;
+#ifdef unix
+ stchars = newchar;
+#else
+ ostchars=stchars; stchars=ftell(infd);
+#endif
+ }
+ return(c);
+ }
+
+unput1(c)
+ {
+ --linechars;
+ --newchar;
+ unchar(c);
+ if (c == '\n')
+ {
+#ifdef unix
+ stchars = newchar;
+#else
+ stchars=ostchars;
+#endif
+ --newline;
+ }
+ return(c);
+ }
+
+
+
+
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+int endbuf;
+
+mkgraph()
+ {
+ if (!parse())
+ return(FALSE);
+ hash_check();
+ hash_free();
+ fingraph();
+ return(TRUE);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "1.incl.h"
+
+makenode(type,addimp,addcom, labe,arcnum,arctype,arclab)
+LOGICAL addimp,addcom;
+int type, arctype[], arcnum;
+long arclab[], labe;
+ {
+ int i;
+ VERT num;
+
+ ASSERT(arcsper[type] < 0 || arcnum == arcsper[type], makenode);
+ num = create(type,arcnum);
+
+ if (addimp) fiximp(num,labe);
+
+ for (i = 0; i < arcnum; ++i)
+ {
+ if (arctype[i] == -2)
+ addref(arclab[i],&ARC(num,i));
+ else
+ ARC(num,i) = arctype[i];
+ }
+
+
+ if (hascom[type] )
+ {
+ if (!addcom || endcom < begline)
+ BEGCOM(num) = UNDEFINED;
+ else
+ BEGCOM(num) = begchar - rtnbeg;
+ }
+ return(num);
+ }
+
+
+
+
+
+fiximp(num,labe) /* fix implicit links, check nesting */
+VERT num;
+long labe;
+ {
+ fixvalue(implicit, num); /* set implicit links to this node */
+ clear(implicit);
+ if(labe != implicit) fixvalue(labe, num);
+ }
--- /dev/null
+#include <stdio.h>
+#include "1.incl.h"
+#include "def.h"
+
+
+recognize(type, ifflag) /* if ifflag = 1, statement is if()type; otherwise is type */
+int type, ifflag; /* do whatever is needed for this statement */
+ {
+ int *arctype, i, sp;
+ VERT num, num1, nest, loophead;
+ extern long label();
+ long *arclab;
+ if (nlabs > 3) sp = nlabs; else sp = 3;
+ arctype = challoc(sizeof(*arctype) * sp); arclab = challoc(sizeof(*arclab) * sp);
+ for( i=0; i < endbuf; i++) {if (buffer[i] == '~') buffer[i] = ' ';}
+ loophead = nest = innerdo(label(0));
+ if (DEFINED(nest))
+ {
+ /* this statement is last line of do loop */
+ nest = ARC(nest,0); /* nest is ITERVX of the innermost do ending here */
+ }
+
+
+ if (ifflag)
+ {
+ if (type == ungo)
+ {
+ arctype[0] = -2;
+ arclab[0] = label(1);
+ }
+ else
+ arctype[0] = 0;
+
+ arctype[1] = (nest >= 0) ? nest : -2;
+ arclab[1] = implicit;
+ num1 = makenode(IFVX,TRUE,TRUE,label(0),2,arctype,arclab);
+ PRED(num1) = pred;
+ }
+
+ arctype[0] = (nest >= 0) ? nest : -2;
+ arclab[0] = implicit;
+
+ switch(type)
+ {
+ case ungo:
+ if (!ifflag)
+ {
+ connect(label(1),implicit);
+ if (label(0) != implicit) connect(label(1),label(0));
+ }
+ break;
+ case RETVX:
+ case STOPVX:
+ if (type == RETVX)
+ {
+ if (retvert == UNDEFINED)
+ retvert = makenode(type,FALSE,FALSE,implicit,0,arctype,arclab);
+ num = retvert;
+ }
+ else
+ {
+ if (stopvert == UNDEFINED)
+ stopvert = makenode(type,FALSE,FALSE,implicit,0,arctype,arclab);
+ num = stopvert;
+ }
+ if (!ifflag)
+ {
+ fixvalue(implicit,num);
+ clear(implicit);
+ if (label(0) != implicit) fixvalue(label(0),num);
+ }
+ break;
+
+
+ case contst:
+ contin(label(0),loophead);
+ break;
+
+ case FMTVX:
+ num = makenode(FMTVX,FALSE,TRUE,implicit,0,arctype,arclab);
+ BEGCODE(num) = comchar + 1 - rtnbeg;
+ ONDISK(num) = endline - endcom;
+ if (label(0) != implicit)
+ fixvalue(label(0),num);
+ FMTLST = append(num,FMTLST);
+ break;
+ case STLNVX:
+ if (DEFINED(stflag) && !ifflag && (label(0) == implicit))
+ {
+ ++CODELINES(stflag);
+ ONDISK(stflag) += endline - begline + 1;
+ }
+ else
+ {
+ num = makenode(STLNVX,!ifflag,!ifflag,label(0),1,arctype,arclab);
+ if (!ifflag)
+ {
+ stflag = num;
+ BEGCODE(num) = comchar + 1 - rtnbeg;
+ ONDISK(num) = endline - endcom;
+ CODELINES(num) = 1;
+ }
+ else
+ {
+ BEGCODE(num) = stcode;
+ ONDISK(num) = FALSE;
+ CODELINES(num) = 1;
+ }
+ }
+ break;
+
+ case DOVX:
+ if (arctype[0] != -2)
+ {
+ error("illegal do range, ","","");
+ fprintf(stderr," between lines %d and %d\n",begline, endline);
+ exit(1);
+ }
+ arctype[1] = UNDEFINED;
+ num1 = makenode(DOVX,TRUE,TRUE,label(0),2,arctype,arclab);
+ if (++doptr >= maxdo)
+ {
+ faterr("in parsing:\n","do loops nested deeper than allowed","");
+ }
+ dostack[doptr] = label(1);
+ doloc[doptr] = num1; /* stack link to node after loop */
+ INC(num1) = inc;
+ num = makenode(ITERVX,TRUE,FALSE,implicit,1,arctype,arclab);
+ ARC(num1,0) = num;
+ FATH(num) = UNDEFINED; /* number of DOVX can change so leave UNDEFINED until later */
+ break;
+ case arithif:
+ if (label(1) == label(2) || label(1) == 0L)
+ makeif(1,label(0),concat(pred," > 0"),label(3),label(2));
+ else if (label(1) == label(3) || label(3) == 0L)
+ makeif(1,label(0),concat(pred," == 0"),label(2),label(1));
+ else if (label(2) == label(3) || label(2) == 0L)
+ makeif(1,label(0),concat(pred," < 0"),label(1),label(3));
+ else
+ {
+ makeif(1,label(0),concat(pred," < 0"),label(1),implicit);
+ makeif(1,implicit,concat(pred," == 0"),label(2),label(3));
+ }
+ break;
+
+ case IOVX:
+ if (endlab)
+ {
+ arctype[1] = -2;
+ arclab[1] = endlab->labelt;
+ }
+ else
+ arctype[1] = UNDEFINED;
+ if (errlab)
+ {
+ arctype[2] = -2;
+ arclab[2] = errlab->labelt;
+ }
+ else
+ arctype[2] = UNDEFINED;
+ num = makenode(IOVX,!ifflag,!ifflag,label(0),3,arctype,arclab);
+ PRERW(num) = prerw;
+ POSTRW(num) = postrw;
+ if (reflab)
+ addref(reflab->labelt, &FMTREF(num));
+ else
+ FMTREF(num) = UNDEFINED;
+ break;
+
+ case COMPVX:
+ if (intcase)
+ {
+ num = compcase(ifflag);
+ break;
+ }
+ case ASGOVX:
+ for (i = 0; i < nlabs - 1; i++)
+ {
+ arctype[i] = -2;
+ arclab[i] = label(nlabs-i-1);
+ }
+ num = makenode(type,!ifflag,!ifflag,label(0),nlabs - 1, arctype, arclab);
+ EXP(num) = exp;
+ break;
+ case ASVX:
+ num = makenode(ASVX,!ifflag,!ifflag,label(0),1,arctype,arclab);
+ EXP(num) = exp;
+ addref(label(1),&LABREF(num));
+ break;
+ case entry:
+ num = makenode(STLNVX,FALSE,TRUE,label(0),1,arctype,arclab);
+ BEGCODE(num) = comchar + 1 - rtnbeg;
+ ONDISK(num) = endline - endcom;
+ CODELINES(num) = 1;
+ ENTLST = append(num,ENTLST);
+ break;
+ }
+ if (ifflag && type != ungo)
+ {
+ ARC(num1,0) = num;
+ }
+ if (DEFINED(loophead)) nesteddo(label(0), loophead);
+ if (ifflag || DEFINED(loophead) || type != STLNVX) stflag = UNDEFINED;
+
+
+ chfree(arctype,sizeof(*arctype) * sp); chfree(arclab,sizeof(*arclab) * sp);
+ if (debug)
+ {
+ fprintf(debfd,"line %d: ", begline);
+ if (ifflag) fprintf(debfd,"if() ");
+ switch(type)
+ {case RETVX: fprintf(debfd,"return"); break;
+ case STOPVX: fprintf(debfd,"stop"); break;
+ case contst: fprintf(debfd,"continue"); break;
+ case ungo: fprintf(debfd,"uncond. goto"); break;
+ case COMPVX: fprintf(debfd,"comp. goto"); break;
+ case ASGOVX: fprintf(debfd,"ass. goto, labs"); break;
+ case ASVX: fprintf(debfd,"label assignment"); break;
+ case STLNVX: fprintf(debfd,"simple statement"); break;
+ case arithif: fprintf(debfd,"arith if"); break;
+ case DOVX: fprintf(debfd,"do "); break;
+ case FMTVX: fprintf(debfd,"format st"); break;
+ case IOVX: fprintf(debfd,"IOVX statement "); break;
+case entry: fprintf(debfd,"entry statement "); break;
+ }
+ fprintf(debfd,"\n%s\n", buffer);
+ }
+ }
+
+
+
+makeif(first,labe,test,arc1,arc2) /* construct IFVX with arcs to labels arc1,arc2 */
+int first;
+long labe, arc1,arc2;
+char *test;
+ {
+ int num, arctype[2];
+ long arclab[2];
+ arctype[0] = arctype[1] = -2;
+ arclab[0] = arc1;
+ arclab[1] = arc2;
+ num = makenode(IFVX,first,first,labe,2,arctype,arclab);
+ PRED(num) = test;
+ return(num);
+ }
+
+
+innerdo(labe) /* return number of DOVX associated with labe, or UNDEFINED */
+long labe;
+ {
+ if (DEFINED(doptr))
+ {if (dostack[doptr] == labe)
+ return(doloc[doptr--]);
+ }
+ return(UNDEFINED);
+ }
+
+
+
+
+contin(labe,nest) /* handle continue statements */
+long labe;
+int nest;
+ {
+ VERT y;
+
+ if (!DEFINED(nest))
+ { /* not nested */
+ if (labe != implicit) connect(implicit,labe); /* labe pts to next node */
+ }
+ else
+ { /* nested */
+ y = ARC(nest,0);
+ fixvalue(labe,y); /* labe pts to ITERVX */
+ fixvalue(implicit, y); /* implicit links pt to ITERVX */
+ clear(implicit);
+ }
+ }
+
+
+
+
+nesteddo(labe,v)
+ /* if multiple do's end on same label, add arc from inner DOVX
+ to enclosing DOVX;
+ add implicit link out of outermost DOVX with this label */
+long labe;
+int v;
+ {
+
+ while (DEFINED(doptr) && dostack[doptr] == labe)
+ {
+ ARC(v,1) = ARC(doloc[doptr],0); /*set inner DOVX to point to outer ITERVX */
+ v = doloc[doptr--];
+ }
+ addref(implicit, &ARC(v,1));
+ }
+
+
+
+compcase(ifflag) /* turn computed goto into case statement */
+LOGICAL ifflag;
+ {
+ int *arctype, i, num, d, arct;
+ extern long label();
+ long *arclab;
+ char *str;
+ arctype = challoc(sizeof(*arctype) * nlabs);
+ arclab = challoc (sizeof(*arclab) * nlabs);
+
+ d = distinct(linelabs->nxtlab,arctype,arclab,nlabs-1);
+ /* puts distinct labels in arclab, count of each in arctype */
+ arct = -2;
+ for (i = 0; i < d; ++i)
+ arctype[i] = makenode(ICASVX,FALSE,FALSE,implicit,1,&arct,&arclab[i]);
+ num = makenode(SWCHVX,!ifflag,!ifflag,label(0),d,arctype,arclab);
+ EXP(num) = exp;
+
+ str = challoc(6*(nlabs-1)); /* 5 digits + , or \0 per label */
+ for (i = 0; i < d; ++i) /* construct list of values for each label */
+ EXP(arctype[i]) = stralloc(str,accum(str,linelabs->nxtlab,arclab[i]));
+ chfree(str,6*(nlabs-1));
+ chfree(arctype,sizeof(*arctype) * nlabs); chfree(arclab,sizeof(*arclab) * nlabs);
+ return(num);
+ }
+
+
+accum(str,vlist,f) /* build string of indices in compnode corr. to label f */
+char *str; long f; struct lablist *vlist;
+ {
+ int s,j; struct lablist *p;
+
+ s = 0;
+ j = 1;
+ for (p = vlist; p ; p = p->nxtlab) /* search for occurrences of f */
+ {
+ if (p->labelt ==f)
+ {
+ if (s)
+ {
+ str[s] = ',';
+ ++s;
+ }
+ sprintf(&str[s],"%d",j);
+ while (str[s] != '\0') ++s;
+ }
+ ++j;
+ }
+ return(s+1);
+ }
+
+
+distinct(vlist,count,dlist,size) /* make dlist into list of distinct labels in vlist */
+struct lablist *vlist; long dlist[]; /*count[] gets count of each label; d distinct labels */
+int count[],size;
+ {int d,i;
+ d = 0;
+ for(i = 0; i < size; i++) count[i] = 0;
+
+ for (;vlist && vlist->labelt != 0L; vlist = vlist ->nxtlab)
+ {
+ for (i = 0; ;i++)
+ {
+ if (i == d) dlist[d++] = vlist->labelt;
+ if (dlist[i] == vlist->labelt)
+ {
+ ++count[i]; break;
+ }
+ }
+ }
+ return(d);
+ }
+
+
--- /dev/null
+#include <stdio.h>
+
+int match[146]
+ = {
+ 0, 1, 2, 3, 4, 5, 19, 21,
+ 23, 25, 29, 32, 36, 38, 42, 44,
+ 46, 50, 52, 56, 59, 61, 65, 74,
+ 77, 81, 83, 85, 87, 89, 91, 93,
+ 95, 97, 99, 102, 105, 108, 114, 116,
+ 118, 120, 122, 124, 126, 129, 131, 134,
+ 136, 139, 142, 144, 147, 149, 151, 153,
+ 155, 157, 159, 161, 163, 165, 167, 169,
+ 171, 174, 176, 178, 180, 182, 184, 186,
+ 188, 190, 192, 194, 196, 198, 200, 202,
+ 204, 206, 208, 210, 212, 214, 216, 218,
+ 221, 223, 225, 227, 229, 231, 233, 235,
+ 237, 239, 241, 243, 245, 247, 249, 251,
+ 254, 256, 258, 260, 262, 264, 266, 268,
+ 270, 272, 274, 276, 278, 280, 283, 287,
+ 292, 298, 303, 307, 311, 316, 320, 324,
+ 327, 329, 331, 333, 335, 337, 339, 341,
+ 343, 345, 347, 349, 351, 353, 355, 356,
+ 357, 359
+ };
+
+int symclass[358]
+ = {
+ 1, 1, 1, 1, 1, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 1, 0, 1, 0, 1, 0,
+ 1, 2, 3, 0, 1, 2, 0, 1,
+ 4, 0, 0, 1, 0, 1, 2, 0,
+ 0, 1, 0, 1, 2, 1, 2, 0,
+ 0, 1, 0, 1, 4, 5, 0, 1,
+ 0, 0, 1, 0, 1, 0, 0, 0,
+ 1, 0, 0, 0, 0, 0, 0, 0,
+ 2, 1, 2, 0, 1, 2, 0, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 2, 0, 1, 2, 3,
+ 1, 4, 0, 1, 4, 0, 0, 0,
+ 5, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 2, 1, 2, 0,
+ 1, 0, 1, 4, 0, 1, 0, 1,
+ 0, 0, 1, 0, 0, 1, 0, 1,
+ 0, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 1, 0, 1, 0, 1, 0, 1,
+ 0, 2, 1, 2, 0, 0, 1, 0,
+ 0, 0, 0, 1, 2, 0, 0, 0,
+ 0, 1, 0, 0, 0, 0, 1, 0,
+ 0, 0, 1, 0, 0, 0, 1, 2,
+ 0, 0, 0, 1, 0, 0, 0, 1,
+ 0, 0, 0, 1, 0, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 1, 0, 1, 0,
+ 1, 0, 1, 0, 0, 0
+ };
+
+char symbol[358]
+ = {
+ '_', '_', '_', '_', '_', 'i', 'd', 'g',
+ 'a', 'r', 'w', 'c', 'l', 's', 'e', 'p',
+ 'f', 'b', '_', 'o', '_', 't', '_', 'o',
+ '_', '_', '_', '(', '_', '_', '\0', '_',
+ '_', ',', '\0', '_', '(', '_', '_', ',',
+ ')', '_', '\0', '_', '_', '_', '_', ',',
+ ')', '_', ',', '_', '_', '_', '\0', '_',
+ 'f', 'n', '_', '(', '_', '(', ')', '\0',
+ '_', '=', 'g', 'a', 'r', 'p', 'w', 's',
+ '_', '_', '_', ',', '_', '_', ',', '\0',
+ '_', 'o', '_', 'n', '_', 't', '_', 'i',
+ '_', 'n', '_', 'u', '_', 'e', '_', '\0',
+ '_', 'o', '_', '_', 'u', '_', '_', '_',
+ '_', '_', '=', '_', '_', '(', ')', ',',
+ '_', '_', 's', '_', 's', '_', 'i', '_',
+ 'g', '_', 'n', '_', '_', '_', '_', 't',
+ '_', 'o', '_', '_', '\0', '_', 'e', '_',
+ 'a', 't', '_', 'l', 'd', '_', 'f', '_',
+ 'u', 'o', '_', 'n', '_', 'c', '_', 't',
+ '_', 'i', '_', 'o', '_', 'n', '_', 't',
+ '_', 'e', '_', 'g', '_', 'e', '_', 'r',
+ '_', 'o', '_', 'm', 'n', '_', 'p', '_',
+ 'l', '_', 'e', '_', 'x', '_', 'b', '_',
+ 'l', '_', 'e', '_', 'p', '_', 'r', '_',
+ 'e', '_', 'c', '_', 'i', '_', 's', '_',
+ 'i', '_', 'o', '_', 'n', '_', 'o', '_',
+ 'g', '_', 'i', '_', 'c', '_', 'a', '_',
+ 'l', '_', 't', 'u', '_', 'o', '_', 'p',
+ '_', 'b', '_', 'r', '_', 'o', '_', 't',
+ '_', 'i', '_', 'n', '_', 'e', '_', 'e',
+ '_', 't', '_', 'u', '_', 'r', '_', 'n',
+ '_', 'n', '_', 'd', 't', '_', '\0', '_',
+ 'r', '_', 'y', '_', 'r', '_', 'm', '_',
+ 'a', '_', 't', '_', '(', '_', 'r', '_',
+ 'i', '_', 't', '_', 'e', '_', '(', '_',
+ '(', '_', '_', '_', ',', '\0', '_', '(',
+ ')', ',', '\0', '_', '_', 'e', ',', '\0',
+ ')', '_', 'n', 'r', ')', '\0', '_', 'd',
+ ')', '\0', '_', '=', ')', '\0', '_', '_',
+ ',', ')', '\0', '_', 'r', ')', '\0', '_',
+ '=', ')', '\0', '_', 'r', 'u', '_', 'i',
+ '_', 'n', '_', 't', '_', 'n', '_', 'c',
+ '_', 'h', '_', 'l', '_', 'o', '_', 'c',
+ '_', 'k', '_', 'd', '_', 'a', '_', 't',
+ '_', 'a', '_', '_', '_', '_'
+ };
+
+int action[358]
+ = {
+ 1, 1, 1, 1, 1, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 111, 0, 111, 0, 111, 76,
+ 111, 1, 0, 0, 111, 1, 122, 111,
+ 0, 72, 123, 111, 0, 111, 1, 3,
+ 3, 111, 124, 111, 1, 111, 1, 3,
+ 3, 111, 76, 111, 0, 0, 125, 111,
+ 0, 0, 111, 45, 111, 30, 31, 111,
+ 0, 133, 0, 0, 0, 0, 0, 0,
+ 1, 111, 1, 3, 111, 1, 3, 141,
+ 111, 0, 111, 0, 111, 0, 111, 0,
+ 111, 0, 111, 0, 111, 0, 111, 180,
+ 111, 0, 111, 1, 0, 111, 1, 61,
+ 111, 0, 0, 111, 0, 62, 63, 64,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 1, 111, 1, 3,
+ 111, 76, 111, 0, 150, 111, 0, 111,
+ 0, 0, 111, 0, 76, 111, 0, 111,
+ 0, 0, 111, 0, 111, 0, 111, 0,
+ 111, 0, 111, 0, 111, 200, 111, 0,
+ 111, 0, 111, 0, 111, 0, 111, 0,
+ 111, 0, 111, 0, 0, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 111, 0, 0, 111, 0, 111, 350,
+ 111, 0, 111, 0, 111, 0, 111, 0,
+ 111, 0, 111, 0, 111, 200, 111, 0,
+ 111, 0, 111, 0, 111, 0, 111, 300,
+ 111, 0, 111, 0, 0, 111, 400, 111,
+ 0, 111, 700, 111, 0, 111, 0, 111,
+ 0, 111, 0, 111, 600, 111, 0, 111,
+ 0, 111, 0, 111, 0, 111, 0, 111,
+ 0, 1, 111, 1, 520, 520, 111, 62,
+ 77, 70, 111, 0, 1, 0, 75, 111,
+ 520, 0, 0, 0, 510, 111, 0, 0,
+ 510, 111, 0, 73, 510, 111, 0, 1,
+ 3, 510, 111, 0, 0, 510, 111, 0,
+ 74, 510, 111, 0, 0, 0, 111, 0,
+ 111, 0, 111, 76, 111, 0, 111, 0,
+ 111, 76, 111, 0, 111, 0, 111, 0,
+ 111, 0, 111, 0, 111, 0, 111, 0,
+ 111, 210, 111, 0, 0, 0
+ };
+
+int newstate[358]
+ = {
+ 1, 2, 3, 4, 5, 19, 33, 6,
+ 38, 47, 112, 63, 81, 87, 102, 127,
+ 51, 134, 142, 7, 142, 8, -5, 9,
+ -5, 10, 11, 15, -5, 10, 142, -5,
+ 11, 12, 142, -5, 13, -5, 13, 13,
+ 14, -5, 142, -5, 16, 142, 16, 15,
+ 17, 142, 18, 142, 18, 18, 142, -5,
+ 20, 58, 142, 21, -5, 21, -5, -5,
+ 21, 142, 6, 38, 47, 127, 112, 87,
+ 23, 142, 23, 24, 142, 24, 24, 142,
+ -5, 26, -5, 27, -5, 28, -5, 29,
+ -5, 30, -5, 31, -5, 32, -5, 142,
+ 142, 34, -5, 35, 69, -5, 35, 36,
+ -5, 36, 37, -5, 37, 37, 37, 37,
+ 37, -5, 39, -5, 40, -5, 41, -5,
+ 42, -5, 43, -5, 44, 142, 44, 45,
+ 142, 46, -5, 46, 142, -5, 48, 142,
+ 49, 99, 142, 50, 117, 142, 51, 142,
+ 52, 107, 142, 53, 142, 54, 142, 55,
+ 142, 56, 142, 57, 142, 142, 142, 59,
+ 142, 60, 142, 61, 142, 62, 142, 50,
+ 142, 64, 142, 65, 27, 142, 66, 142,
+ 67, 142, 68, 142, 50, 142, 70, 142,
+ 71, 142, 72, 142, 73, 142, 74, 142,
+ 75, 142, 76, 142, 77, 142, 78, 142,
+ 79, 142, 80, 142, 50, 142, 82, 142,
+ 83, 142, 84, 142, 85, 142, 86, 142,
+ 50, 142, 88, 90, 142, 89, 142, 142,
+ 142, 91, 142, 92, 142, 93, 142, 94,
+ 142, 95, 142, 96, 142, 142, 142, 98,
+ 142, 99, 142, 100, 142, 101, 142, 142,
+ 142, 103, 142, 104, 105, 142, 142, 142,
+ 106, 142, 142, 142, 108, -5, 109, -5,
+ 110, -5, 111, -5, -5, -5, 113, -5,
+ 114, -5, 115, -5, 116, -5, 119, -5,
+ 119, 118, -5, 118, -5, -5, -5, 119,
+ 119, -5, -5, 119, 120, 121, 120, -5,
+ -5, 119, 122, 125, -5, -5, 119, 123,
+ -5, -5, 119, 124, -5, -5, 119, 124,
+ 120, -5, -5, 119, 126, -5, -5, 119,
+ 124, -5, -5, 119, 128, 131, 142, 129,
+ 142, 130, 142, 117, 142, 132, 142, 133,
+ 142, 117, 142, 135, -5, 136, -5, 137,
+ -5, 138, -5, 139, -5, 140, -5, 141,
+ -5, -5, -5, -5, -5, -5
+ };
--- /dev/null
+extern int accessnum; /* number of nodes accessible from START */
+extern VERT *after; /* node numbers associated with after numbers of depth first search */
+extern int *ntobef; /* before numbers associated with nodes */
+extern int *ntoaft; /* after numbers associated with nodes */
--- /dev/null
+#include <stdio.h>
+#
+/* depth-first search used to identify back edges, unreachable nodes;
+ each node v entered by back edge replaced by
+ LOOPVX ->ITERVX -> v,
+ so that back edges entering v now enter the ITERVX,
+ and other edges entering v now enter the LOOPVX.
+ Nodes are numbered according to depth-first search:
+ before numbering- ntobef[v] = i => node numbered v is i'th
+ node in order of first visit during the search;
+ after numbering- ntoaft[v] = i => node numbered v is i'th
+ node visited in order of last visit during the search.
+ Also, in this case after[i] = v.
+*/
+
+#include "def.h"
+#include "2.def.h"
+
+#define MAXINS 3 /* spacing needed between numbers generated during depth first search */
+
+int *status;
+int befcount, aftcount;
+/* following defines used to mark back edges and nodes entered by back edges */
+#define UNPROCESSED 0
+#define STACKED 1
+#define FINISHED 2
+#define MARK(v) {REACH(v) = 1; } /* mark node v */
+#define UNMARK(v) {REACH(v) = 0; }
+#define MARKED(v) (REACH(v))
+#define MKEDGE(e) {if (e >= -1) e = -(e+3); } /* mark edge e */
+#define UNMKEDGE(e) {if (e < -1) e = -(e+3); }
+#define BACKEDGE(e) (e < -1)
+
+
+dfs(v) /* depth first search */
+VERT v;
+ {
+ int i; VERT w;
+ accessnum = 0;
+ status = challoc(sizeof(*status) * nodenum);
+ for (w = 0; w < nodenum; ++w)
+ {
+ status[w] = UNPROCESSED;
+ UNMARK(w);
+ }
+ search(v);
+ chreach();
+ chfree(status, sizeof(*status) * nodenum);
+ addloop();
+ after = challoc(sizeof(*after) * accessnum);
+ for (i = 0; i < accessnum; ++i)
+ after[i] = UNDEFINED;
+ ntoaft = challoc(sizeof(*ntoaft) * nodenum);
+ ntobef = challoc(sizeof(*ntobef) * nodenum);
+ for (w = 0; w < nodenum; ++w)
+ ntobef[w] = ntoaft[w] = UNDEFINED;
+ befcount = 0;
+ aftcount = 0;
+ repsearch(v);
+ }
+
+
+search(v)
+ /* using depth first search, mark back edges using MKEDGE, and nodes entered by back
+ edges using MARK */
+VERT v;
+ {
+ VERT adj; int i;
+ status[v] = STACKED;
+ for(i = 0; i < ARCNUM(v); ++i)
+ {
+ adj = ARC(v,i);
+ if (!DEFINED(adj)) continue;
+ else if (status[adj] == UNPROCESSED)
+ search(adj);
+ else if (status[adj] == STACKED)
+ {
+ MARK(adj); /* mark adj as entered by back edge */
+ MKEDGE(ARC(v,i)); /* mark edge ARC(v,i) as being back edge */
+ }
+ }
+ status[v] = FINISHED;
+ ++accessnum;
+ }
+
+chreach() /* look for unreachable nodes */
+ {
+ VERT v;
+ LOGICAL unreach;
+ unreach = FALSE;
+ for (v = 0; v < nodenum; ++v)
+ if (status[v] == UNPROCESSED && NTYPE(v) != FMTVX
+ && NTYPE(v) != STOPVX && NTYPE(v) != RETVX)
+ {
+ unreach = TRUE;
+ if (debug)
+ fprintf(stderr,"node %d unreachable\n",v);
+ }
+ if (unreach)
+ error(": unreachable statements - ","will be ignored","");
+ }
+
+
+addloop() /* add LOOPVX, ITERVX at nodes entered by back edges, and adjust edges */
+ {
+ VERT v, adj;
+ int j, oldnum;
+ for (v = 0, oldnum = nodenum; v < oldnum; ++v) /* insloop increases nodenum */
+ if (MARKED(v))
+ {
+ UNMARK(v); /* remove mark indicating v entered by back edge */
+ if (NTYPE(v) != ITERVX) /* DO loops already have ITERVX */
+ insloop(v); /* add LOOPVX, ITERVX since v entered by back edge*/
+ }
+ /* arcs which used to enter v now enter LOOPVX; must make back edges enter ITERVX */
+ for (v = 0; v < nodenum; ++v)
+ for (j = 0; j < ARCNUM(v); ++j)
+ {
+ if (BACKEDGE(ARC(v,j)))
+ {
+ UNMKEDGE(ARC(v,j)); /* return edge to normal value */
+ adj = ARC(v,j);
+ if (NTYPE(adj) == ITERVX) continue;
+ ASSERT(NTYPE(adj) == LOOPVX,addloop);
+ ARC(v,j) = ARC(adj,0); /* change arc to point to ITERVX */
+ ASSERT(NTYPE(ARC(v,j)) == ITERVX,addloop);
+ }
+ }
+ }
+
+insloop(v) /* insert LOOPVX, ITERVX at node number v */
+VERT v;
+ {
+ VERT loo, iter;
+ loo = create(LOOPVX, 1);
+ iter = create(ITERVX,1);
+ accessnum += 2;
+ /* want LOOPVX to take on node number v, so that arcs other than back arcs
+ entering v will enter the LOOPVX automatically */
+ exchange(&graph[v], &graph[loo]);
+ exchange(&v, &loo);
+ ARC(loo,0) = iter;
+ ARC(iter,0) = v;
+ FATH(iter) = UNDEFINED; /* will be defined later along with FATH for DOVX */
+ }
+
+exchange(p1,p2) /* exchange values of p1,p2 */
+int *p1,*p2;
+ {
+ int temp;
+ temp = *p1;
+ *p1 = *p2;
+ *p2 = temp;
+ }
+
+
+repsearch(v) /* repeat df search in order to fill in after, ntoaft, ntobef tables */
+VERT v;
+ {
+ VERT adj; int i,temp;
+ ntobef[v] = befcount;
+ ++befcount;
+ for(i = 0; i < ARCNUM(v); ++i)
+ {
+ adj = ARC(v,i);
+ if (DEFINED(adj) && ntobef[adj] == UNDEFINED)
+ repsearch(adj);
+ }
+ ++aftcount;
+ temp = accessnum - aftcount;
+ after[temp] = v;
+ ntoaft[v] = temp;
+ }
--- /dev/null
+#include <stdio.h>
+#
+/*
+set dom[v] to immediate dominator of v, based on arcs as stored in inarcs
+(i.e. pretending the graph is reducible if it isn't).
+Algorithm is from Hecht and Ullman, Analysis of a simple algorithm for global
+flow analysis problems, except bit vector operations replaced by search
+through DOM to save quadratic blowup in space
+*/
+#include "def.h"
+#include "2.def.h"
+
+
+getdom(inarc,dom)
+struct list **inarc;
+VERT *dom;
+ {
+ VERT v;
+ int i;
+ struct list *ls;
+ for (v = 0; v < nodenum; ++v)
+ dom[v] = UNDEFINED;
+ for (i = 1; i < accessnum; ++i)
+ {
+ v = after[i];
+ for (ls = inarc[v]; ls; ls = ls->nxtlist)
+ {
+ ASSERT(ntoaft[ls->elt] < i,getdom);
+ dom[v] = comdom(dom[v],ls->elt,dom);
+ }
+
+ }
+ }
+
+
+comdom(u,v,dom) /* find closest common dominator of u,v */
+VERT u,v, *dom;
+ {
+ if (u == UNDEFINED) return(v);
+ if (v == UNDEFINED) return(u);
+ while(u != v)
+ {
+ ASSERT(u != UNDEFINED && v != UNDEFINED, comdom);
+ if (ntoaft[u] < ntoaft[v])
+ v = dom[v];
+ else
+ u = dom[u];
+ }
+ return(u);
+ }
--- /dev/null
+#include <stdio.h>
+#
+/*
+set head[v] to ITERVX heading smallest loop containing v, for each v
+*/
+#include "def.h"
+#include "2.def.h"
+
+/* define ANC(v,w) true if v == w or v is ancestor of w */
+#define ANC(v,w) (ntobef[v] <= ntobef[w] && ntoaft[v] <= ntoaft[w]) /* reflexive ancestor */
+
+
+gethead(head)
+VERT *head;
+ {
+ VERT v, w, adj; int i, j;
+ /* search nodes in reverse of after numbering so that all paths from
+ a node to an ancestor are searched before the node */
+ /* at any point, the current value of head allows chains of nodes
+ to be reached from any node v by taking head[v], head[head[v]], etc.
+ until an UNDEFINED value is reached. Upon searching each arc,
+ the appropriate chains must be merged to avoid losing information.
+ For example, from one path out of a node v it may be known that
+ v is in a loop headed by z, while from another
+ it may be known that v is in a loop headed by w.
+ Thus, head[v] must be set to whichever of z,w is the closer ancestor,
+ and the fact that this node is in a loop headed by the other must be
+ recorded in head. */
+ for (v = 0; v < nodenum; ++v)
+ head[v] = UNDEFINED;
+ for (i = accessnum -1; i >= 0; --i)
+ {
+ v = after[i];
+ for (j = 0; j < ARCNUM(v); ++j)
+ {
+ adj = ARC(v,j);
+ if (!DEFINED(adj)) continue;
+ if (ntoaft[adj] < i) /* back edge */
+ merge(v,adj,head);
+ else if (ANC(v,adj)) /* not back edge or cross edge */
+ {
+ /* need to do only tree edges - must not do edge (v,adj)
+ when head[adj] is not ANC of v */
+ if (DEFINED(head[adj]) && ANC(head[adj],v))
+ merge(v,head[adj],head);
+ }
+ else /* cross edge */
+ {
+ w = lowanc(adj,v,head);
+ if (DEFINED(w))
+ merge(w,v,head);
+ }
+ }
+ if (NTYPE(v) == LOOPVX || NTYPE(v) == DOVX)
+ head[ARC(v,0)] = head[v]; /* head of ITERVX must be different ITERVX */
+ }
+ }
+
+
+lowanc(y,z,head) /* find the first node in chain of y which is anc of z, if it exists */
+VERT y,z, *head;
+ {
+ while (y != -1 && !ANC(y,z))
+ y = head[y];
+ return(y);
+ }
+
+
+merge(w,y,head) /* merge chains of w and y according to ANC relation */
+VERT w,y, *head;
+ {
+ VERT t, min;
+ if (w == y) return;
+
+ if (ANC(w,y)) /* set t to min of w,y */
+ {
+ t = y;
+ y = head[y];
+ }
+ else
+ {
+ t = w;
+ w = head[w];
+ }
+
+ while (w != -1 && y != -1) /* construct chain at t by adding min of remaining elts */
+ {
+ if (ANC(w,y))
+ {
+ min = y;
+ y = head[y];
+ }
+ else
+ {
+ min = w;
+ w = head[w];
+ }
+ if (t != min)
+ {
+ head[t] = min;
+ t = min;
+ }
+ }
+ if (w == -1) min = y; else min = w;
+ if (t != min) head[t] = min;
+
+ }
--- /dev/null
+#include <stdio.h>
+#
+/* find forward in-arcs for each node, pretending that arcs which jump into a loop
+ jump to the head of the largest such loop instead, based on the
+ depth first search tree */
+#include "def.h"
+#include "2.def.h"
+
+getinarc(inarc,head) /* construct array "inarc" containing in arcs for each node */
+struct list **inarc;
+VERT *head;
+ {
+ VERT v,adj,x;
+ int i, j;
+
+ for (v=0; v < nodenum; ++v) inarc[v] = 0;
+
+ /* fill in inarc nodes */
+
+ for (i = 0; i < accessnum; ++i)
+ {
+ v = after[i];
+ for (j = 0; j < ARCNUM(v); ++j)
+ {
+ adj = ARC(v,j);
+ if (!DEFINED(adj))
+ continue;
+ if (ntoaft[adj] > ntoaft[v]) /* not a back edge */
+ /* if edge jumps into loop, pretend jumps to head of
+ largest loop jumped into */
+ {
+ x = maxentry(v,adj,head);
+ if (!DEFINED(x)) x = adj;
+ else x = FATH(x);
+
+ inarc[x] = consls(v,inarc[x]); /* insert v in list inarc[x] */
+ }
+ }
+ }
+ }
+
+
+
+maxentry(x,y,head) /* return z if z is ITERVX of largest loop containing y but not x, UNDEFINED otherwise */
+VERT x,y, *head;
+ {
+ if (head[y] == UNDEFINED) return(UNDEFINED);
+ if (loomem(x,head[y], head)) return (UNDEFINED);
+ y = head[y];
+ while (head[y] != UNDEFINED)
+ {
+ if (loomem(x,head[y],head)) return(y);
+ y = head[y];
+ }
+ return(y);
+ }
+
+
+
+loomem(x,y,head) /* return TRUE if x is in loop headed by y, FALSE otherwise */
+VERT x,y, *head;
+ {
+ VERT w;
+ if (!DEFINED(y)) return(TRUE);
+ ASSERT(NTYPE(y) == ITERVX, loomem);
+ for (w = (NTYPE(x) == ITERVX) ? x : head[x]; DEFINED(w); w = head[w])
+ if (w == y) return (TRUE);
+ return(FALSE);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "2.def.h"
+
+VERT *after;
+int *ntobef, *ntoaft;
+build()
+ {
+ VERT v, *dom, *head;
+ int type;
+ struct list **inarc;
+ dfs(START);
+ if (routerr) return;
+ for (v = 0; v < nodenum; ++v)
+ {
+ type = NTYPE(v);
+ if (type == LOOPVX || type == DOVX)
+ FATH(ARC(v,0)) = v;
+ }
+
+ head = challoc(sizeof(*head) * nodenum);
+ if (progress) fprintf(stderr," gethead:\n");
+ gethead(head); /* sets head[v] to ITERVX heading smallest loop containing v or UNDEFINED */
+
+ if (routerr) return;
+ inarc = challoc(nodenum * sizeof(*inarc));
+ if (progress) fprintf(stderr," getinarc:\n");
+ getinarc(inarc,head); /* sets inarc[v] to list of forward arcs entering v */
+
+ dom = challoc(nodenum * sizeof(*dom));
+ if (progress) fprintf(stderr," getdom:\n");
+ getdom(inarc,dom); /* sets dom[v] to immediate dominator of v or UNDEFINED */
+ if (routerr) return;
+ if (progress) fprintf(stderr," gettree:\n");
+ gettree(inarc, dom, head);
+ if (routerr) return;
+
+ chfree(head, nodenum * sizeof(*head)); head = 0;
+ chfree(dom,nodenum * sizeof(*dom)); dom = 0;
+ for (v = 0; v < nodenum; ++v)
+ {
+ freelst(inarc[v]);
+ inarc[v] = 0;
+ }
+ chfree(inarc,sizeof(*inarc) * nodenum); inarc = 0;
+ chfree(ntoaft,sizeof(*ntoaft) * nodenum); ntoaft = 0;
+ chfree(ntobef,sizeof(*ntobef) * nodenum); ntobef = 0;
+ chfree(after, sizeof(*after) * accessnum); after = 0;
+ }
--- /dev/null
+#include <stdio.h>
+#
+/* for testing only */
+#include "def.h"
+#include "2.def.h"
+
+testaft()
+ {
+ int i;
+ for (i = 0; i < nodenum; ++i)
+ fprintf(stderr,"ntoaft[%d] = %d, ntobef[%d] = %d\n",i,ntoaft[i],i,ntobef[i]);
+ fprintf(stderr,"\n");
+ for (i = 0; i < accessnum; ++i)
+ fprintf(stderr,"after[%d] = %d\n",i,after[i]);
+ }
+
+testhead(head)
+VERT *head;
+ {
+ VERT v;
+ for (v = 0; v < nodenum; ++v)
+ fprintf(stderr,"head[%d] = %d\n",v,head[v]);
+ }
+
+testdom(dom)
+VERT *dom;
+ {
+ VERT v;
+ for (v = 0; v < nodenum; ++v)
+ fprintf(stderr,"dom[%d] = %d\n",v,dom[v]);
+ }
+
+
+testtree()
+ {
+ VERT v;
+ int i;
+ for (v = 0; v < nodenum; ++v)
+ {
+ fprintf(stderr,"%d: RSIB %d, ",v,RSIB(v));
+ for (i = 0; i < CHILDNUM(v); ++i)
+ fprintf(stderr," %d",LCHILD(v,i));
+ fprintf(stderr,"\n");
+ }
+ }
--- /dev/null
+#include <stdio.h>
+#
+/* use inarc, dom, and head to build tree representing structure of program.
+ Each node v has CHILDNUM(v) children denoted by
+ LCHILD(v,0), LCHILD(v,1),...
+ RSIB((v) is right sibling of v or UNDEFINED;
+ RSIB(v) represents code following v at the same level of nesting,
+ while LCHILD(v,i) represents code nested within v
+*/
+#include "def.h"
+#include "2.def.h"
+
+gettree(inarc,dom,head) /* build tree */
+struct list **inarc;
+VERT *dom, *head;
+ {
+ VERT v,u,from;
+ int i;
+ for ( v = 0; v < nodenum; ++v)
+ {
+ RSIB(v) = UNDEFINED;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ LCHILD(v,i) = UNDEFINED;
+ }
+ for (i = accessnum-1; i > 0; --i)
+ {
+ v = after[i];
+ from = oneelt(inarc[v]); /* the unique elt of inarc[v] or UNDEFINED */
+ if (DEFINED(from))
+ if (NTYPE(from) == IFVX && (head[v] == head[from] || asoc(v,exitsize) != -1) )
+ /* place in clause of IFVX if in smallest loop containing it
+ or if size of code for v is <= exitsize */
+ if (ARC(from,THEN) == v)
+ {
+ LCHILD(from,THEN) = v;
+ continue;
+ }
+ else
+ {
+ ASSERT(ARC(from,ELSE) == v,gettree);
+ LCHILD(from,ELSE) = v;
+ continue;
+ }
+ else if (NTYPE(v) == ITERVX || NTYPE(from) == ITERVX )
+ /* LOOPVX -> ITERVX ->vert always in same loop*/
+ {
+ LCHILD(from,0) = v;
+ continue;
+ }
+ else if (NTYPE(from) == SWCHVX)
+ {
+ ASSERT(0 < ARCNUM(v),gettree);
+ if (ARC(from,0) == v)
+ LCHILD(from,0) = v;
+ else
+ {
+ int j;
+ for (j = 1; j < ARCNUM(from); ++j)
+ if (ARC(from,j) == v)
+ {insib(ARC(from,j-1),v);
+ break;
+ }
+ }
+ continue;
+ }
+ else if (NTYPE(from) == ICASVX && (head[v] == head[from] || asoc(v,exitsize) != -1))
+ {
+ LCHILD(from,0) = v;
+ continue;
+ }
+ else if (NTYPE(from) == DUMVX && ARC(from,0) == v)
+ {
+ LCHILD(from,0) = v;
+ continue;
+ }
+ if (loomem(v,head[dom[v]],head))
+ /* v is in smallest loop containing dom[v] */
+ insib(dom[v],v);
+ else
+ {
+ /* make v follow LOOPVX heading largest loop
+ containing DOM[v] but not v */
+ ASSERT(DEFINED(head[dom[v]]),gettree);
+ for (u = head[dom[v]]; head[u] != head[v]; u = head[u])
+ ASSERT(DEFINED(head[u]),gettree);
+ ASSERT(NTYPE(u) == ITERVX,gettree);
+ insib(FATH(u),v);
+ }
+ }
+ }
+
+
+
+
+insib(w,v) /* make RSIB(w) = v, and make RSIB(rightmost sib of v) = old RSIB(w) */
+VERT w,v;
+ {
+ VERT u, temp;
+ temp = RSIB(w);
+ RSIB(w) = v;
+ for (u = v; DEFINED(RSIB(u)); u = RSIB(u))
+ ;
+ RSIB(u) = temp;
+ }
+
+
+asoc(v,n) /* return # of nodes associated with v if <= n, -1 otherwise */
+VERT v;
+int n;
+ {
+ int count,i,temp;
+ VERT w;
+ count = (NTYPE(v) == STLNVX) ? CODELINES(v) : 1;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ w = LCHILD(v,i);
+ if (!DEFINED(w)) continue;
+ temp = asoc(w,n-count);
+ if (temp == -1) return(-1);
+ count += temp;
+ if (count > n) return(-1);
+ }
+ if (DEFINED(RSIB(v)))
+ {
+ temp = asoc(RSIB(v),n-count);
+ if (temp == -1) return(-1);
+ count += temp;
+ }
+ if (count > n) return(-1);
+ else return(count);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "3.def.h"
+
+
+getbranch(head)
+VERT *head;
+ {
+ VERT v;
+ for (v = 0; v < nodenum; ++v)
+ LABEL(v) = FALSE;
+ for (v = START; DEFINED(v); v = RSIB(v))
+ chkbranch(v,head);
+ addlab(START);
+ }
+
+
+
+chkbranch(v,head)
+VERT v,*head;
+ {
+ VERT w;
+ int i;
+ switch(NTYPE(v))
+ {
+ case GOVX:
+ for (i = 1, w = head[v]; DEFINED(w); w = head[w], ++i)
+ {
+ if (i > 1 && !levnxt && !levbrk) break;
+ if (ARC(v,0) == BRK(w) && (levbrk || i == 1))
+ {
+ NTYPE(v) = BRKVX;
+ LEVEL(v) = i;
+ break;
+ }
+ else if (ARC(v,0) == NXT(w) && (levnxt || i == 1))
+ {
+ NTYPE(v) = NXTVX;
+ LEVEL(v) = i;
+ break;
+ }
+ }
+ if (NTYPE(v) == GOVX)
+ {
+ if (ARC(v,0) == stopvert)
+ NTYPE(v) = STOPVX;
+ else if (ARC(v,0) == retvert)
+ NTYPE(v) = RETVX;
+ else LABEL(ARC(v,0)) = TRUE;
+ }
+ break;
+ case COMPVX:
+ case ASGOVX:
+ for (i = 0; i < ARCNUM(v); ++i)
+ LABEL(ARC(v,i)) = TRUE;
+ break;
+ case IOVX:
+ if (DEFINED(ARC(v,ENDEQ)))
+ LABEL(ARC(v,ENDEQ)) = TRUE;
+ if (DEFINED(ARC(v,ERREQ)))
+ LABEL(ARC(v,ERREQ)) = TRUE;
+ if (DEFINED(FMTREF(v)))
+ LABEL(FMTREF(v)) = TRUE;
+ break;
+ }
+ for (i = 0; i < CHILDNUM(v); ++i)
+ for (w = LCHILD(v,i); DEFINED(w); w = RSIB(w))
+ chkbranch(w,head);
+ }
+
+
+addlab(v) /* add labels */
+VERT v;
+ {
+ int recvar;
+ if (NTYPE(v) != ITERVX && LABEL(v) )
+ LABEL(v) = nxtlab();
+ RECURSE(addlab,v,recvar);
+ if (NTYPE(v) == ITERVX && LABEL(NXT(v)))
+ LABEL(NXT(v)) = nxtlab();
+ }
+
+
+nxtlab()
+ {
+ static count;
+ return(labinit + (count++) * labinc);
+ }
--- /dev/null
+#define RECURSE(p,v,r) { for (r = 0; r < CHILDNUM(v); ++r) if (DEFINED(LCHILD(v,r))) p(LCHILD(v,r)); if (DEFINED(RSIB(v))) p(RSIB(v)); }
+
+#define IFTHEN(v) ( NTYPE(v) == IFVX && !DEFINED(LCHILD(v,ELSE)))
+
+#define BRK(v) FATH(v) /* lexical successor of v, for ITERVX only */
+#define LABEL(v) REACH(v)
--- /dev/null
+#include <stdio.h>
+#
+/*
+correct the flow of control in the new program - use GOTO's which may
+be changed later to NEXT, BREAK, etc.
+*/
+#include "def.h"
+#include "3.def.h"
+
+#define BRANCHTYPE(v) (NTYPE(v) == GOVX )
+#define HASLEX(t) (t != GOVX && t != COMPVX && t != ASGOVX && t != ITERVX )
+ /* for these, control never flows directly to following statement */
+
+
+getflow()
+ {
+ fixflow(START,UNDEFINED);
+ }
+
+
+fixflow(v,autolex)
+VERT v;
+VERT autolex; /* lexical successor of v */
+ {
+ VERT lex,chlex,z,x,w;
+ int i;
+ lex = lexval(v,autolex);
+ if (HASLEX(NTYPE(v)) && NTYPE(v) != ICASVX)
+ if (DEFINED(REACH(v)) && REACH(v) != lex)
+ insib(v,makebr(REACH(v)));
+ else if (NTYPE(v) == DOVX && ARC(v,1) != lex)
+ insib(v,makebr(ARC(v,1)));
+ if (NTYPE(v) == ITERVX)
+ {
+ BRK(v) = autolex;
+ chlex = v;
+ }
+ else
+ chlex = lexval(v,autolex);
+
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ w = LCHILD(v,i);
+ if (DEFINED(w))
+ fixflow(w,chlex);
+ else
+ {
+ ASSERT(i < ARCNUM(v),fixflow);
+ z = ARC(v,i);
+ ASSERT(DEFINED(z), fixflow);
+ if (z != chlex)
+ {
+ x = makebr(z);
+ LCHILD(v,i) = x;
+ RSIB(x) = UNDEFINED;
+ }
+ }
+ }
+ if (DEFINED(RSIB(v)))
+ fixflow(RSIB(v),autolex);
+ }
+
+
+lexval(v,lastlex)
+VERT v,lastlex;
+ {
+ VERT sib;
+ if (!HASLEX(NTYPE(v))) return(UNDEFINED);
+ sib = RSIB(v);
+ if (NTYPE(v) == ICASVX || NTYPE(v) == ACASVX)
+ return(lastlex);
+ else if (!DEFINED(sib))
+ return(lastlex);
+ else if (BRANCHTYPE(sib))
+ return(ARC(sib,0));
+ else return(sib);
+ }
+
+
+makebr(w) /* make branching node leading to w */
+VERT w;
+ {
+ VERT new;
+ new = create(GOVX,1);
+ ARC(new,0) = w;
+ RSIB(new) = UNDEFINED;
+ REACH(new) = UNDEFINED;
+ return(new);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "3.def.h"
+
+#define ARCCOUNT(v) REACH(v)
+
+
+fixhd(v,hd,head)
+VERT v,hd,*head;
+ {
+ VERT w,newhd;
+ int i;
+ head[v] = hd;
+ newhd = (NTYPE(v) == ITERVX) ? v : hd;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ for (w = LCHILD(v,i); DEFINED(w); w = RSIB(w))
+ fixhd(w,newhd,head);
+ }
+
+getloop()
+ {
+ cntarcs();
+ fixloop(START);
+ }
+
+
+cntarcs() /* count arcs entering each node */
+ {
+ VERT w,v;
+ int i;
+ for (v = 0; v < nodenum; ++v)
+ ARCCOUNT(v) = 0;
+ for (v = 0; v < nodenum; ++v)
+ for (i = 0; i < ARCNUM(v); ++i)
+ {
+ w = ARC(v,i);
+ if (!DEFINED(w)) continue;
+ ++ARCCOUNT(w);
+ }
+ }
+
+
+fixloop(v) /* find WHILE loops */
+VERT v;
+ {
+ int recvar;
+ if (NTYPE(v) == LOOPVX)
+ {
+ ASSERT(DEFINED(ARC(v,0)),fixloop);
+ NXT(ARC(v,0)) = ARC(v,0);
+ if (!getwh(v))
+ getun(v);
+ }
+ else if (NTYPE(v) == IFVX && arbcase)
+ getswitch(v);
+ else if (NTYPE(v)==DOVX)
+ {
+ ASSERT(DEFINED(ARC(v,0)),fixloop);
+ NXT(ARC(v,0))=ARC(v,0);
+ }
+ RECURSE(fixloop,v,recvar);
+ }
+
+
+getwh(v)
+VERT v;
+ {
+ VERT vchild, vgrand,vgreat;
+ ASSERT(NTYPE(v) == LOOPVX,getwh);
+ vchild = LCHILD(v,0);
+ ASSERT(DEFINED(vchild),getwh);
+ ASSERT(NTYPE(vchild) == ITERVX,getwh);
+ vgrand = LCHILD(vchild,0);
+ if (!DEFINED(vgrand) || !IFTHEN(vgrand) )
+ return(FALSE);
+ vgreat = LCHILD(vgrand,THEN);
+ if (DEFINED(vgreat) && NTYPE(vgreat) == GOVX && ARC(vgreat,0) == BRK(vchild))
+ {
+ /* turn into WHILE */
+ NTYPE(v) = WHIVX;
+ NEG(vgrand) = !NEG(vgrand);
+ LPRED(vchild) = vgrand;
+ LCHILD(vchild,0) = RSIB(vgrand);
+ RSIB(vgrand) = UNDEFINED;
+ return(TRUE);
+ }
+ return(FALSE);
+ }
+
+
+
+getun(v) /* change loop to REPEAT UNTIL if possible */
+VERT v;
+ {
+ VERT vchild, vgrand, vgreat, before, ch;
+ ASSERT(NTYPE(v) == LOOPVX,getun);
+ vchild = LCHILD(v,0);
+ ASSERT(DEFINED(vchild), getun);
+ if (ARCCOUNT(vchild) > 2)
+ return(FALSE); /* loop can be iterated without passing through predicate of UNTIL */
+ vgrand = ARC(vchild,0);
+ if (!DEFINED(vgrand))
+ return(FALSE);
+ for (ch = vgrand,before = UNDEFINED; DEFINED(RSIB(ch)); ch = RSIB(ch))
+ before = ch;
+ if (!IFTHEN(ch))
+ return(FALSE);
+ vgreat = LCHILD(ch,THEN);
+ if (DEFINED(vgreat) && NTYPE(vgreat) == GOVX && ARC(vgreat,0) == BRK(vchild))
+ {
+ /* create UNTIL node */
+ NTYPE(v) = UNTVX;
+ NXT(vchild) = ch;
+ LPRED(vchild)=ch;
+ RSIB(before) = UNDEFINED;
+ return(TRUE);
+ }
+ return(FALSE);
+ }
+
+
+#define FORMCASE(w) (DEFINED(w) && !DEFINED(RSIB(w)) && NTYPE(w) == IFVX && ARCCOUNT(w) == 1)
+
+getswitch(v)
+VERT v;
+ {
+ VERT ch, grand, temp;
+ /* must be of form if ... else if ... else if ... */
+ if (NTYPE(v) != IFVX) return(FALSE);
+ ch = LCHILD(v,ELSE);
+ if (!FORMCASE(ch)) return(FALSE);
+ grand = LCHILD(ch,ELSE);
+ if (!FORMCASE(grand)) return(FALSE);
+
+ temp = create(SWCHVX,0);
+ exchange(&graph[temp],&graph[v]); /* want arcs to enter switch, not first case*/
+ BEGCOM(v) = UNDEFINED;
+ RSIB(v) = RSIB(temp); /* statements which followed IFVX should follow switch */
+ EXP(v) = UNDEFINED;
+ LCHILD(v,0) = temp;
+ NTYPE(temp) = ACASVX;
+ for (ch = LCHILD(temp,ELSE); FORMCASE(ch); )
+ {
+ LCHILD(temp,ELSE) = UNDEFINED;
+ RSIB(temp) = ch;
+ NTYPE(ch) = ACASVX;
+ temp = ch;
+ ch = LCHILD(temp,ELSE);
+ }
+ ASSERT(!DEFINED(RSIB(temp)),getswitch);
+ return(TRUE);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+
+structure()
+ {
+ VERT v, *head;
+
+ if (progress)
+ fprintf(stderr," getreach:\n");
+ getreach();
+ if (routerr) return;
+ if (progress)
+ fprintf(stderr," getflow:\n");
+ getflow();
+ if (progress)
+ fprintf(stderr," getthen:\n");
+ getthen(START);
+ head = challoc(nodenum * sizeof(*head));
+ for (v = 0; v < nodenum; ++v)
+ head[v] = UNDEFINED;
+ for (v = START; DEFINED(v); v = RSIB(v))
+ fixhd(v,UNDEFINED,head);
+ /* fixhd must be called before getloop so that
+ it gets applied to IFVX which becomes NXT(w) for UNTVX w */
+ if (progress)
+ fprintf(stderr," getloop:\n");
+ getloop();
+ if (progress)
+ fprintf(stderr," getbranch:\n");
+ getbranch(head);
+ chfree(head,nodenum * sizeof(*head));
+ head = 0;
+ }
--- /dev/null
+#include <stdio.h>
+#
+/*
+set REACH[v] = w if w is only node outside subtree of v which is reached from within
+ subtree of v, REACH[v] = UNDEFINED otherwise
+*/
+#include "def.h"
+
+/* strategy in obtaining REACH(v) for each node v:
+Since only need to know whether there is exactly one exit from subtree of v,
+need keep track only of 2 farthest exits from each subtree rather than all exits.
+The first may be the unique exit, while the second is used when the children
+of a node has the same first exit.
+To obtain 2 farthest exits of v, look at 2 farthest exits of children of v and
+the nodes entered by arcs from v. Farthest exits are identified by numbering
+the nodes from -2 to -(accessnum-2) starting at the bottom left corner of tree
+using procedure number(). The farthest exit from the subtree of v is the one
+with the least number according NUM to this numbering. If a node w is an exit from the
+subtree of v, then NUM(w) < NUM(v). The negative numbers allow NUM(v) to be stored
+in the same location as REACH(v). REACH(w) may already be set when an arc (v,w) to a child
+is searched, but the negative numbering is consistent, i.e. NUM(v) < NUM(w) in this case
+as in other cases where w is not an exit from the subtree of v.
+*/
+
+struct pair {
+ int smallest;
+ int second;
+ };
+
+
+getreach() /* obtain REACH(v) for each node v */
+ {
+ VERT v;
+ struct pair *pr;
+ for (v = 0; v < nodenum; ++v)
+ REACH(v) = UNDEFINED;
+ number(START);
+ for (v = START; DEFINED(v); v = RSIB(v))
+ {
+ pr = exits(v); /* need to free the space for pr */
+ chfree(pr,sizeof(*pr));
+ }
+ }
+
+
+exits(v) /* set REACH(v) = w if w is only node outside subtree of v which is reached from within
+ subtree of v, leave REACH(v) UNDEFINED otherwise */
+VERT v;
+ {
+ struct pair *vpair, *chpair;
+ VERT w,t;
+ int i;
+ vpair = challoc(sizeof(*vpair));
+ vpair ->smallest = vpair ->second = UNDEFINED;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ w = LCHILD(v,i);
+ if (!DEFINED(w)) continue;
+ for (t = w; DEFINED(t); t = RSIB(t))
+ {
+ chpair = exits(t);
+
+ /* set vpair->smallest,second to two smallest of vpair->smallest,second,
+ chpair->smallest,second */
+ if (inspr(chpair->smallest,vpair))
+ inspr(chpair->second,vpair);
+ chfree(chpair, sizeof(*chpair));
+ }
+ }
+ for (i = 0; i < ARCNUM(v); ++i)
+ {
+ w = ARC(v,i);
+ if (!DEFINED(w)) continue;
+ inspr(w,vpair);
+ }
+ /* throw out nodes in subtree of v */
+ if (NUM(vpair->second) >= NUM(v))
+ {
+ vpair->second = UNDEFINED;
+ if (NUM(vpair->smallest) >= NUM(v))
+ vpair->smallest = UNDEFINED;
+ }
+ if (vpair->second == UNDEFINED)
+ REACH(v) = vpair->smallest; /* vpair->smallest possibly UNDEFINED */
+ else
+ REACH(v) = UNDEFINED;
+ return(vpair);
+ }
+
+
+ /* number nodes from -2 to -(accessnum+2) starting at bottom left corner of tree */
+number(v)
+VERT v;
+ {
+ int i;
+ VERT w;
+ static int count;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ w = LCHILD(v,i);
+ if (DEFINED(w))
+ number(w);
+ }
+ SETNUM(v,count-2);
+ --count;
+ if (DEFINED(RSIB(v)))
+ number(RSIB(v));
+ }
+
+
+NUM(v)
+VERT v;
+ {
+ if (!DEFINED(v)) return(UNDEFINED);
+ return(REACH(v));
+ }
+
+SETNUM(v,count)
+VERT v; int count;
+ {
+ /* this reuses REACH to save space;
+ /* appears to be no conflict with setting true value of REACH later */
+ REACH(v) = count;
+ }
+
+
+LOGICAL inspr(w,pr) /* insert w in order in pr, return TRUE if <= smaller of pr */
+ /* don't insert duplicates */
+VERT w;
+struct pair *pr;
+ {
+ if (w == pr-> smallest) return(TRUE);
+ if (NUM(w) < NUM(pr->smallest))
+ {
+ pr->second = pr->smallest;
+ pr->smallest = w;
+ return(TRUE);
+ }
+ if (w == pr->second) return(FALSE);
+ if (NUM(w) < NUM(pr->second))
+ pr->second = w;
+ return(FALSE);
+ }
--- /dev/null
+#include <stdio.h>
+#
+/* for testing only */
+#include "def.h"
+
+testreach()
+ {
+ VERT v;
+ for (v = 0; v < nodenum; ++v)
+ fprintf(stderr,"REACH(%d) = %d\n",v,REACH(v));
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "3.def.h"
+
+#define BRANCHTYPE(t) (t == STOPVX || t == RETVX || t == BRKVX || t == NXTVX || t == GOVX)
+#define MAXCHUNK 20
+ /* if else clause smaller than MAXCHUNK and smaller than then clause,
+ and there is no reason not to negate the if, negate the if */
+
+getthen(v) /* turn IFVX into THEN when appropriate, create else ifs where possible */
+VERT v;
+ {
+ VERT tch, fch;
+ int tn,fn;
+ int recvar;
+
+ if (NTYPE(v) == IFVX)
+ {
+ tch = LCHILD(v,THEN);
+ fch = LCHILD(v,ELSE);
+ if (!DEFINED(fch))
+ mkthen(v);
+ else if (!DEFINED(tch))
+ {
+ negate(v);
+ mkthen(v);
+ }
+ else if (BRANCHTYPE(NTYPE(tch)))
+ mkthen(v);
+ else if (BRANCHTYPE(NTYPE(fch)))
+ {
+ negate(v);
+ mkthen(v);
+ }
+ else if (NTYPE(fch) != IFVX || DEFINED(RSIB(fch))) /* not an else if */
+ if ( NTYPE(tch) == IFVX && !DEFINED(RSIB(tch)))
+ /* invert into else if */
+ negate(v);
+ else
+ {
+ /* asoc(v,n) returns number of statements associated with v
+ if <= n, -1 otherwise */
+ tn = asoc(tch,MAXCHUNK);
+ fn = asoc(fch,MAXCHUNK);
+ if (fn >= 0 && (tn < 0 || fn < tn))
+ /* else clause smaller */
+ negate(v);
+ }
+ }
+ RECURSE(getthen,v,recvar);
+ }
+
+mkthen(v)
+VERT v;
+ {
+ VERT w,tc;
+ w = LCHILD(v,ELSE);
+ tc = LCHILD(v,THEN);
+ ASSERT(!DEFINED(w) || (DEFINED(tc) && BRANCHTYPE(NTYPE(tc)) ),mkthen);
+ if (DEFINED(w))
+ {
+ insib(v,w);
+ LCHILD(v,ELSE) = UNDEFINED;
+ }
+ ASSERT(IFTHEN(v),mkthen);
+ }
+
+
+negate(v)
+VERT v;
+ {
+ ASSERT(NTYPE(v) == IFVX,negate);
+ exchange(&LCHILD(v,THEN), &LCHILD(v,ELSE));
+ NEG(v) = !NEG(v);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "4.def.h"
+#include "3.def.h"
+
+ndbrace(v) /* determine whether braces needed around subparts of v */
+ /* return TRUE if v ends with IF THEN not in braces */
+VERT v;
+ {
+ VERT w;
+ int i;
+ LOGICAL endif;
+ endif = FALSE;
+ for (i = 0; i < CHILDNUM(v); ++i)
+ {
+ endif = FALSE;
+ for (w = LCHILD(v,i); DEFINED(w); w = RSIB(w))
+ endif = ndbrace(w);
+ if (NTYPE(v) != DUMVX && NTYPE(v) != ITERVX &&
+ (!DEFINED(LCHILD(v,i)) || compound(v,i) ||
+ (endif && NTYPE(v) == IFVX && !IFTHEN(v) && i == THEN )))
+ /* DUMVX doesn't nest, ITERVX doen't nest since
+ nesting is done at LOOPNODE, etc., must
+ check for IFTHEN followed by unrelated ELSE */
+ {
+ YESBRACE(v,i);
+ endif = FALSE;
+ }
+ }
+ return(endif || IFTHEN(v) );
+ }
+
+
+compound(v,ch) /* return TRUE iff subpart ch of v has multiple statements */
+VERT v;
+int ch;
+ {
+ VERT w;
+ w = LCHILD(v,ch);
+ if (!DEFINED(w))
+ return(FALSE);
+ if (NTYPE(w) == ITERVX)
+ {
+ ASSERT(DEFINED(NXT(w)),compound);
+ if (LABEL(NXT(w)))
+ return(TRUE); /* loop ends with labeled CONTINUE statement */
+ else
+ return(compound(w,0));
+ }
+ else if (DEFINED(RSIB(w)))
+ return(TRUE);
+ else if (NTYPE(w) == STLNVX && CODELINES(w) > 1)
+ return(TRUE);
+ else
+ return(FALSE);
+ }
--- /dev/null
+#define YESTAB TRUE
+#define NOTAB FALSE
+#define TABOVER(n) tabover(n,outfd)
+#define OUTSTR(x) fprintf(outfd,"%s",x)
+#define OUTNUM(x) fprintf(outfd,"%d",x)
+
+
+extern LOGICAL *brace;
+#define YESBRACE(v,i) { if (DEFINED(LCHILD(v,i))) brace[LCHILD(v,i)] = TRUE; }
+#define NOBRACE(v,i) { if (DEFINED(LCHILD(v,i))) brace[LCHILD(v,i)] = FALSE; }
+#define HASBRACE(v,i) ((DEFINED(LCHILD(v,i))) ? brace[LCHILD(v,i)] : TRUE)
--- /dev/null
+#include <stdio.h>
+#
+#include "def.h"
+#include "4.def.h"
+extern int linechars;
+extern int rdfree(), comfree(), labfree(), contfree();
+extern int rdstand(), comstand(), labstand(), contstand();
+extern int (*rline[])();
+extern int (*comment[])();
+extern int (*getlabel[])();
+extern int (*chkcont[])();
+null(c)
+char c;
+ {return;}
+
+
+
+comprint()
+ {
+ int c, blank, first,count;
+ blank = 1;
+ first = 1;
+ count = 0;
+ while ((c = (*comment[inputform])(0) ) || blankline() )
+ {
+ ++count;
+ if (c)
+ {
+ (*comment[inputform])(1); /* move head past comment signifier */
+ blank = blankline();
+ /* if (first && !blank)
+ OUTSTR("#\n");*/
+ prline("#");
+ first = 0;
+ }
+ else
+ (*rline[inputform])(null);
+ }
+ /* if (!blank)
+ OUTSTR("#\n"); */
+ return(count);
+ }
+
+
+
+prcode(linecount,tab)
+int linecount, tab;
+ {
+ int someout;
+ someout = FALSE;
+ while (linecount)
+ {
+ if ( (*comment[inputform])(0) )
+ {
+ linecount -= comprint();
+ someout = TRUE;
+ continue;
+ }
+ else if (blankline() )
+ (*rline[inputform])(null);
+ else if ((*chkcont[inputform])() )
+ {
+ TABOVER(tab);
+ prline("&");
+ someout = TRUE;
+ }
+ else
+ {if (someout) TABOVER(tab);
+ (*getlabel[inputform])(null);
+ prline("");
+ someout=TRUE;
+ }
+ --linecount;
+ }
+ }
+
+
+charout(c)
+char c;
+ {
+ putc(c,outfd);
+ }
+
+
+
+prline(str)
+char *str;
+ {
+ fprintf(outfd,"%s",str);
+ (*rline[inputform]) (charout);
+ putc('\n',outfd);
+ }
+
+
+input2()
+ {
+ static int c;
+ c = inchar();
+ if (c == '\n')
+ linechars = 0;
+ else
+ ++linechars;
+ return(c);
+ }
+
+
+unput2(c)
+int c;
+ {
+ unchar(c);
+ --linechars;
+ return(c);
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "4.def.h"
+
+LOGICAL *brace;
+output()
+ {
+ VERT w;
+ int i;
+ brace = challoc(nodenum * sizeof(*brace));
+ for (i = 0; i < nodenum; ++i)
+ brace[i] = FALSE;
+ if (progress) fprintf(stderr,"ndbrace:\n");
+ for (w = START; DEFINED(w); w = RSIB(w))
+ ndbrace(w);
+ if (progress) fprintf(stderr,"outrat:\n");
+ for (w = START; DEFINED(w); w = RSIB(w))
+ outrat(w,0,YESTAB);
+ OUTSTR("END\n");
+ chfree(brace,nodenum * sizeof(*brace));
+ brace = 0;
+ }
--- /dev/null
+#include <stdio.h>
+#include "def.h"
+#include "4.def.h"
+#include "3.def.h"
+
+outrat(v,tab,tabfirst)
+VERT v;
+int tab; /* number of tabs to indent */
+LOGICAL tabfirst; /* FALSE if doing IF of ELSE IF */
+ {
+ LOGICAL ndcomma;
+ VERT w;
+ int type,i;
+ type = NTYPE(v);
+ if (hascom[type])
+ prcom(v);
+ if (!LABEL(v) && type == FMTVX)
+ {
+ OUTSTR("#following unreferenced format statement commented out\n");
+ OUTSTR("#");
+ }
+ if (LABEL(v) && type != ITERVX)
+ {
+ ASSERT(tabfirst, outrat);
+ prlab(LABEL(v),tab);
+ }
+ else if (tabfirst && type != DUMVX && type != ITERVX)
+ TABOVER(tab);
+
+ switch(type)
+ {
+ case DUMVX:
+ newlevel(v,0,tab,YESTAB);
+ break;
+ case GOVX:
+ OUTSTR("go to ");
+ OUTNUM(LABEL(ARC(v,0)));
+ OUTSTR("\n");
+ break;
+ case STOPVX:
+ if (progtype != blockdata)
+ OUTSTR("stop\n");
+ break;
+ case RETVX:
+ OUTSTR("return\n");
+ break;
+ case BRKVX:
+ if (!levbrk)
+ {
+ ASSERT(LEVEL(v) == 1,outrat);
+ OUTSTR("break\n");
+ }
+ else
+ {
+ OUTSTR("break ");
+ OUTNUM(LEVEL(v));
+ OUTSTR("\n");
+ }
+ break;
+ case NXTVX:
+ if (!levnxt)
+ {
+ ASSERT(LEVEL(v) == 1,outrat);
+ OUTSTR("next\n");
+ }
+ else
+ {
+ OUTSTR("next ");
+ OUTNUM(LEVEL(v));
+ OUTSTR("\n");
+ }
+ break;
+ case ASGOVX:
+ case COMPVX:
+ OUTSTR("goto ");
+ if (type == ASGOVX)
+ {
+ OUTSTR(EXP(v));
+ OUTSTR(",");
+ }
+ OUTSTR("(");
+ for (i = ARCNUM(v)-1; i >=0; --i) /* arcs were stored backward */
+ {
+ OUTNUM(LABEL(ARC(v,i)));
+ if (i > 0) OUTSTR(",");
+ }
+ OUTSTR(")");
+ if (type == COMPVX)
+ {
+ OUTSTR(",");
+ OUTSTR(EXP(v));
+ }
+ OUTSTR("\n");
+ break;
+ case ASVX:
+ OUTSTR("assign ");
+ OUTNUM(LABEL(LABREF(v)));
+ OUTSTR(" to ");
+ OUTSTR(EXP(v));
+ OUTSTR("\n");
+ break;
+ case IFVX:
+ OUTSTR("IF");
+ prpred(v,TRUE);
+ if (IFTHEN(v))
+ newlevel(v,THEN,tab+1,YESTAB);
+ else
+ {
+ newlevel(v,THEN,tab+1,YESTAB);
+ TABOVER(tab);
+ OUTSTR("ELSE ");
+ w = LCHILD(v,ELSE);
+ ASSERT(DEFINED(w),outrat);
+ if (NTYPE(w) == IFVX && !LABEL(w) && !DEFINED(RSIB(w)) &&
+ !HASBRACE(v,ELSE) )
+ newlevel(v,ELSE,tab,NOTAB);
+ else
+ newlevel(v,ELSE,tab+1,YESTAB);
+ }
+ break;
+ case ITERVX:
+ newlevel(v,0,tab,YESTAB);
+ ASSERT(DEFINED(NXT(v)),outrat);
+ if (LABEL(NXT(v)))
+ {
+ prlab(LABEL(NXT(v)),tab);
+ OUTSTR("continue\n");
+ }
+ break;
+ case DOVX:
+ OUTSTR("DO ");
+ OUTSTR(INC(v));
+ newlevel(v,0,tab+1,YESTAB);
+ break;
+ case LOOPVX:
+ case UNTVX:
+ OUTSTR("REPEAT");
+ newlevel(v,0,tab+1,YESTAB);
+ if (type == UNTVX)
+ {
+ TABOVER(tab+1);
+ OUTSTR("UNTIL");
+ ASSERT(DEFINED(ARC(v,0)),outrat);
+ prpred(LPRED(ARC(v,0)),TRUE);
+ OUTSTR("\n");
+ }
+ break;
+ case WHIVX:
+ OUTSTR("WHILE");
+ ASSERT(DEFINED(ARC(v,0)),outrat);
+ ASSERT(DEFINED(LPRED(ARC(v,0))),outrat);
+ prpred(LPRED(ARC(v,0)),TRUE);
+ newlevel(v,0,tab+1,YESTAB);
+ break;
+ case STLNVX:
+ case FMTVX:
+ prstln(v,tab);
+ break;
+ case SWCHVX:
+ OUTSTR("SWITCH");
+ if (DEFINED(EXP(v)))
+ {
+ OUTSTR("(");
+ OUTSTR(EXP(v));
+ OUTSTR(")");
+ }
+ newlevel(v,0,tab+1,YESTAB);
+ break;
+ case ICASVX:
+ case ACASVX:
+ OUTSTR("CASE ");
+ if (type == ACASVX)
+ prpred(v,FALSE);
+ else
+ OUTSTR(EXP(v));
+ OUTSTR(":\n");
+ newlevel(v,0,tab+1,YESTAB);
+ if (type == ACASVX &&DEFINED(LCHILD(v,ELSE)))
+ {
+ TABOVER(tab);
+ OUTSTR("DEFAULT:\n");
+ newlevel(v,1,tab+1,YESTAB);
+ }
+ break;
+ case IOVX:
+ OUTSTR(PRERW(v));
+ ndcomma = FALSE;
+ if (DEFINED(FMTREF(v)))
+ {
+ OUTNUM(LABEL(FMTREF(v)));
+ ndcomma = TRUE;
+ }
+ if (DEFINED(ARC(v,ENDEQ)))
+ {
+ if (ndcomma)
+ OUTSTR(",");
+ OUTSTR("end = ");
+ OUTNUM(LABEL(ARC(v,ENDEQ)));
+ ndcomma = TRUE;
+ }
+ if (DEFINED(ARC(v,ERREQ)))
+ {
+ if (ndcomma)
+ OUTSTR(",");
+ OUTSTR("err = ");
+ OUTNUM(LABEL(ARC(v,ERREQ)));
+ ndcomma = TRUE;
+ }
+ OUTSTR(POSTRW(v));
+ OUTSTR("\n");
+ break;
+ }
+ }
+
+
+newlevel(v,ch,tab,tabfirst)
+VERT v;
+int ch; /* number of lchild of v being processed */
+int tab; /* number of tabs to indent */
+LOGICAL tabfirst; /* same as for outrat */
+ {
+ LOGICAL addbrace;
+ VERT w;
+ if (NTYPE(v) == ACASVX || NTYPE(v) == ICASVX)
+ addbrace = FALSE;
+ else
+ addbrace = HASBRACE(v,ch);
+ ASSERT(tabfirst || !addbrace,newlevel);
+ if (addbrace)
+ OUTSTR(" {");
+ if(tabfirst && NTYPE(v)!=ITERVX && NTYPE(v)!=DUMVX) OUTSTR("\n");
+ for (w = LCHILD(v,ch); DEFINED(w); w = RSIB(w))
+ outrat(w,tab,tabfirst);
+ if (addbrace)
+ {
+ TABOVER(tab);
+ OUTSTR("}\n");
+ }
+ }
+
+
+
+
+
+prpred(v,addpar)
+VERT v;
+LOGICAL addpar;
+ {
+ if (addpar)
+ OUTSTR("(");
+ if (NEG(v)) OUTSTR("!(");
+ OUTSTR(PRED(v));
+ if (NEG(v)) OUTSTR(")");
+ if (addpar)
+ OUTSTR(")");
+ }
+
+prlab(n,tab)
+int n,tab;
+ {
+ TABOVER(tab);
+ OUTSTR("~");
+ OUTNUM(n);
+ OUTSTR(" ");
+ }
+
+prstln(v,tab)
+VERT v;
+int tab;
+ {
+ ASSERT(NTYPE(v) == STLNVX || NTYPE(v) == FMTVX,prstln);
+ if (!ONDISK(v))
+ {
+ OUTSTR(BEGCODE(v));
+ OUTSTR("\n");
+ }
+ else
+ {
+ empseek(BEGCODE(v));
+ prcode(ONDISK(v),tab);
+ }
+ }
+
+prcom(v)
+VERT v;
+ {
+ if (DEFINED(BEGCOM(v)))
+ {
+ empseek(BEGCOM(v));
+ comprint();
+ }
+ }
--- /dev/null
+extern int xxindent, xxval, newflag, xxmaxchars, xxbpertab;
+extern int xxlineno; /* # of lines already output */
+#define xxtop 100 /* max size of xxstack */
+extern int xxstind, xxstack[xxtop], xxlablast, xxt;
+struct node
+ {int op;
+ char *lit;
+ struct node *left;
+ struct node *right;
+ };
--- /dev/null
+#define xxtop 100 /* max size of xxstack */
+int xxindent, xxval, newflag, xxmaxchars, xxbpertab;
+int xxlineno; /* # of lines already output */
+int xxstind, xxstack[xxtop], xxlablast, xxt;
--- /dev/null
+%term xxif 300 xxelse 301 xxwhile 302 xxrept 303 xxdo 304 xxrb 305 xxpred 306
+%term xxident 307 xxle 308 xxge 309 xxne 310 xxnum 311 xxcom 312
+%term xxstring 313 xxexplist 314 xxidpar 315 xxelseif 316 xxlb 318 xxend 319
+%term xxcase 320 xxswitch 321 xxuntil 322 xxdefault 323
+%term xxeq 324
+
+%left '|'
+%left '&'
+%left '!'
+%binary '<' '>' xxeq xxne xxge xxle
+%left '+' '-'
+%left '*' '/'
+%left xxuminus
+%right '^'
+
+%{
+#include "b.h"
+#include <stdio.h>
+%}
+
+%%
+%{
+struct node *t;
+%}
+
+
+allprog: prog xxnew
+ ;
+
+prog: stat
+ | prog stat
+ ;
+
+stat: iftok pred nlevel elsetok nlevel
+ | iftok pred nlevel
+ | xxtab whtok pred nlevel
+ | xxtab rpttok nlevel optuntil
+ | xxtab dotok nlevel
+ | xxtab swtok oppred pindent lbtok caseseq xxtab rbtok mindent
+ | xxtab fstok
+ | lbtok prog xxtab rbtok
+ | lbtok rbtok
+ | labtok stat
+ | xxnl comtok stat
+ | error
+ ;
+
+
+xxtab: = {
+ if (!xxlablast) tab(xxindent);
+ xxlablast = 0;
+ }
+
+xxnl: = newline();
+xxnew: = putout('\n',"\n");
+nlevel: pindent stat mindent;
+pindent: =
+ {
+ if (xxstack[xxstind] != xxlb)
+ ++xxindent;
+ };
+mindent: =
+ {if (xxstack[xxstind] != xxlb && xxstack[xxstind] != xxelseif)
+ --xxindent;
+ pop();
+ };
+caseseq: casetok caseseq
+ | casetok
+ ;
+
+casetok: xxtab xxctok predlist pindent prog mindent
+ | xxtab xxctok predlist pindent mindent
+ | xxtab deftok pindent prog mindent
+ | xxnl comtok casetok
+ ;
+
+xxctok: xxcase = {putout(xxcase,"case "); free ($1); push(xxcase); }
+
+
+deftok: xxdefault ':' = {
+ putout(xxcase,"default");
+ free($1);
+ putout(':',":");
+ free($2);
+ push(xxcase);
+ }
+swtok: xxswitch = {putout(xxswitch,"switch"); free($1); push(xxswitch); }
+
+fstok: xxend = {
+ free($1);
+ putout(xxident,"end");
+ putout('\n',"\n");
+ putout('\n',"\n");
+ putout('\n',"\n");
+ }
+ | xxident = {
+ putout(xxident,$1);
+ free($1);
+ newflag = 1;
+ forst();
+ newflag = 0;
+ };
+
+
+
+identtok: xxident '(' explist ')' = {
+ xxt = addroot($1,xxident,0,0);
+ $$ = addroot("",xxidpar,xxt,$3);
+ }
+
+ | xxident = $$ = addroot($1,xxident,0,0);
+ ;
+
+predlist: explist ':' = {
+ yield($1,0);
+ putout(':',":");
+ freetree($1);
+ }
+explist: expr ',' explist = $$ = addroot($2,xxexplist,checkneg($1,0),$3);
+ | expr = $$ = checkneg($1,0);
+ ;
+
+
+oppred: pred
+ |
+ ;
+
+pred: '(' expr ')' = { t = checkneg($2,0);
+ yield(t,100); freetree(t); };
+
+expr: '(' expr ')' = $$ = $2;
+ | '-' expr %prec xxuminus = $$ = addroot($1,xxuminus,$2,0);
+ | '!' expr = $$ = addroot($1,'!',$2,0);
+ | expr '+' expr = $$ = addroot($2,'+',$1,$3);
+ | expr '-' expr = $$ = addroot($2,'-',$1,$3);
+ | expr '*' expr = $$ = addroot($2,'*',$1,$3);
+ | expr '/' expr = $$ = addroot($2,'/',$1,$3);
+ | expr '^' expr = $$ = addroot($2,'^',$1,$3);
+ | expr '|' expr = $$ = addroot($2,'|',$1,$3);
+ | expr '&' expr = $$ = addroot($2,'&',$1,$3);
+ | expr '>' expr = $$ = addroot($2,'>',$1,$3);
+ | expr '<' expr = $$ = addroot($2,'<',$1,$3);
+ | expr xxeq expr = $$ = addroot($2,xxeq,$1,$3);
+ | expr xxle expr = $$ = addroot($2,xxle,$1,$3);
+ | expr xxge expr = $$ = addroot($2,xxge,$1,$3);
+ | expr xxne expr = $$ = addroot($2,xxne,$1,$3);
+ | identtok = $$ = $1;
+ | xxnum = $$ = addroot($1,xxnum,0,0);
+ | xxstring = $$ = addroot($1,xxstring,0,0);
+ ;
+
+iftok: xxif =
+ {
+ if (xxstack[xxstind] == xxelse && !xxlablast)
+ {
+ --xxindent;
+ xxstack[xxstind] = xxelseif;
+ putout(' '," ");
+ }
+ else
+ {
+ if (!xxlablast)
+ tab(xxindent);
+ xxlablast = 0;
+ }
+ putout(xxif,"if");
+ free($1);
+ push(xxif);
+ }
+elsetok: xxelse =
+ {
+ tab(xxindent);
+ putout(xxelse,"else");
+ free($1);
+ push(xxelse);
+ }
+whtok: xxwhile = {
+ putout(xxwhile,"while");
+ free($1);
+ push(xxwhile);
+ }
+rpttok: xxrept = {
+ putout(xxrept,"repeat");
+ free($1);
+ push(xxrept);
+ }
+optuntil: xxtab unttok pred
+ |
+ ;
+
+unttok: xxuntil = {
+ putout('\t',"\t");
+ putout(xxuntil,"until");
+ free($1);
+ }
+dotok: dopart opdotok
+ ;
+dopart: xxdo identtok '=' expr ',' expr =
+ {push(xxdo);
+ putout(xxdo,"do");
+ free($1);
+ puttree($2);
+ putout('=',"=");
+ free($3);
+ puttree($4);
+ putout(',',",");
+ free($5);
+ puttree($6);
+ }
+opdotok: ',' expr = {
+ putout(',',",");
+ puttree($2);
+ }
+ | ;
+lbtok: '{' = {
+ putout('{'," {");
+ push(xxlb);
+ }
+rbtok: '}' = { putout('}',"}"); pop(); }
+labtok: xxnum = {
+ tab(xxindent);
+ putout(xxnum,$1);
+ putout(' '," ");
+ xxlablast = 1;
+ }
+comtok: xxcom = { putout(xxcom,$1); free($1); xxlablast = 0; }
+ | comtok xxcom = { putout ('\n',"\n"); putout(xxcom,$2); free($2); xxlablast = 0; };
+%%
+#define ASSERT(X,Y) if (!(X)) error("struct bug: assertion 'X' invalid in routine Y","","");
+
+yyerror(s)
+char *s;
+ {
+ extern int yychar;
+ fprintf(stderr,"\n%s",s);
+ fprintf(stderr," in beautifying, output line %d,",xxlineno + 1);
+ fprintf(stderr," on input: ");
+ switch (yychar) {
+ case '\t': fprintf(stderr,"\\t\n"); return;
+ case '\n': fprintf(stderr,"\\n\n"); return;
+ case '\0': fprintf(stderr,"$end\n"); return;
+ default: fprintf(stderr,"%c\n",yychar); return;
+ }
+ }
+
+yyinit(argc, argv) /* initialize pushdown store */
+int argc;
+char *argv[];
+ {
+ xxindent = 0;
+ xxbpertab = 8;
+ xxmaxchars = 120;
+ }
+
+
+#include <signal.h>
+main()
+ {
+ int exit();
+ if ( signal(SIGINT, SIG_IGN) != SIG_IGN)
+ signal(SIGINT, exit);
+ yyinit();
+ yyparse();
+ }
+
+
+putout(type,string) /* output string with proper indentation */
+int type;
+char *string;
+ {
+ static int lasttype;
+ if ( (lasttype != 0) && (lasttype != '\n') && (lasttype != ' ') && (lasttype != '\t') && (type == xxcom))
+ accum("\t");
+ else if (lasttype == xxcom && type != '\n')
+ tab(xxindent);
+ else
+ if (lasttype == xxif ||
+ lasttype == xxwhile ||
+ lasttype == xxdo ||
+ type == '=' ||
+ lasttype == '=' ||
+ (lasttype == xxident && (type == xxident || type == xxnum) ) ||
+ (lasttype == xxnum && type == xxnum) )
+ accum(" ");
+ accum(string);
+ lasttype = type;
+ }
+
+
+accum(token) /* fill output buffer, generate continuation lines */
+char *token;
+ {
+ static char *buffer;
+ static int lstatus,llen,bufind;
+ int tstatus,tlen,i;
+
+#define NEW 0
+#define MID 1
+#define CONT 2
+
+ if (buffer == 0)
+ {
+ buffer = malloc(xxmaxchars);
+ if (buffer == 0) error("malloc out of space","","");
+ }
+ tlen = slength(token);
+ if (tlen == 0) return;
+ for (i = 0; i < tlen; ++i)
+ ASSERT(token[i] != '\n' || tlen == 1,accum);
+ switch(token[tlen-1])
+ {
+ case '\n': tstatus = NEW;
+ break;
+ case '+':
+ case '-':
+ case '*':
+ case ',':
+ case '|':
+ case '&':
+ case '(': tstatus = CONT;
+ break;
+ default: tstatus = MID;
+ }
+ if (llen + bufind + tlen > xxmaxchars && lstatus == CONT && tstatus != NEW)
+ {
+ putchar('\n');
+ ++xxlineno;
+ for (i = 0; i < xxindent; ++i)
+ putchar('\t');
+ putchar(' ');putchar(' ');
+ llen = 2 + xxindent * xxbpertab;
+ lstatus = NEW;
+ }
+ if (lstatus == CONT && tstatus == MID)
+ { /* store in buffer in case need \n after last CONT char */
+ ASSERT(bufind + tlen < xxmaxchars,accum);
+ for (i = 0; i < tlen; ++i)
+ buffer[bufind++] = token[i];
+ }
+ else
+ {
+ for (i = 0; i < bufind; ++i)
+ putchar(buffer[i]);
+ llen += bufind;
+ bufind = 0;
+ for (i = 0; i < tlen; ++i)
+ putchar(token[i]);
+ if (tstatus == NEW) ++xxlineno;
+ llen = (tstatus == NEW) ? 0 : llen + tlen;
+ lstatus = tstatus;
+ }
+ }
+
+tab(n)
+int n;
+ {
+ int i;
+ newline();
+ for ( i = 0; i < n; ++i)
+ putout('\t',"\t");
+ }
+
+newline()
+ {
+ static int already;
+ if (already)
+ putout('\n',"\n");
+ else
+ already = 1;
+ }
+
+error(mess1, mess2, mess3)
+char *mess1, *mess2, *mess3;
+ {
+ fprintf(stderr,"\nerror in beautifying, output line %d: %s %s %s \n",
+ xxlineno, mess1, mess2, mess3);
+ exit(1);
+ }
+
+
+
+
+
+
+
+push(type)
+int type;
+ {
+ if (++xxstind > xxtop)
+ error("nesting too deep, stack overflow","","");
+ xxstack[xxstind] = type;
+ }
+
+pop()
+ {
+ if (xxstind <= 0)
+ error("stack exhausted, can't be popped as requested","","");
+ --xxstind;
+ }
+
+
+forst()
+ {
+ while( (xxval = yylex()) != '\n')
+ {
+ putout(xxval, yylval);
+ free(yylval);
+ }
+ free(yylval);
+ }
--- /dev/null
+#define ASSERT(P,R) {if (!(P)) {fprintf(stderr,"failed assertion in routine R: P\n"); abort();}}
+
+extern int routnum, routerr;
+extern long rtnbeg; /* number of chars up to beginnine of curernt routing */
+extern int **graph, nodenum;
+extern int stopflg; /* turns off generation of stop statements */
+
+#define TRUE 1
+#define FALSE 0
+#define LOGICAL int
+#define VERT int
+#define DEFINED(v) (v >= 0)
+#define UNDEFINED -1
+
+/* node types */
+#define STLNVX 0
+#define IFVX 1
+#define DOVX 2
+#define IOVX 3
+#define FMTVX 4
+#define COMPVX 5
+#define ASVX 6
+#define ASGOVX 7
+#define LOOPVX 8
+#define WHIVX 9
+#define UNTVX 10
+#define ITERVX 11
+#define THENVX 12
+#define STOPVX 13
+#define RETVX 14
+#define DUMVX 15
+#define GOVX 16
+#define BRKVX 17
+#define NXTVX 18
+#define SWCHVX 19
+#define ACASVX 20
+#define ICASVX 21
+
+#define TYPENUM 22
+
+
+extern int hascom[TYPENUM]; /* FALSE for types with no comments, 2 otherwise */
+extern int nonarcs[TYPENUM]; /* number of wds per node other than arcs */
+extern VERT *arc(), *lchild();
+extern int *vxpart(), *negpart(), *predic(), *expres(), *level(), *stlfmt();
+/* node parts */
+#define FIXED 4 /* number of wds needed in every node */
+#define NTYPE(v) graph[v][0]
+#define BEGCOM(v) graph[v][1]
+#define RSIB(v) graph[v][2]
+#define REACH(v) graph[v][3]
+#define LCHILD(v,i) *lchild(v,i)
+#define CHILDNUM(v) childper[NTYPE(v)]
+#define ARC(v,i) *arc(v,i)
+#define ARCNUM(v) *((arcsper[NTYPE(v)] >= 0) ? &arcsper[NTYPE(v)]: &graph[v][-arcsper[NTYPE(v)]])
+
+/* STLNVX, FMTVX parts */
+#define BEGCODE(v) *stlfmt(v,0) /* 1st char of line on disk or address of string */
+#define ONDISK(v) *stlfmt(v,1) /* FALSE if in core,# of lines on disk otherwise */
+#define CODELINES(v) *vxpart(v,STLNVX,2) /* # of statements stored in node */
+
+/* IOVX parts */
+#define FMTREF(v) *vxpart(v,IOVX,0) /* FMTVX associated with i/o statememt */
+#define PRERW(v) *vxpart(v,IOVX,1) /* string occurring in i/o statement before parts with labels */
+#define POSTRW(v) *vxpart(v,IOVX,2) /* string occurring in i/o statement after parts wih labels */
+#define ENDEQ 1 /* arc number associated with endeq */
+#define ERREQ 2 /* arc number associated wth erreq */
+
+/* ITERVX parts */
+#define NXT(v) *vxpart(v,ITERVX,0) /* THENVX containing condition for iteration for WHILE or UNTIL */
+#define FATH(v) *vxpart(v,ITERVX,1) /* father of v */
+#define LPRED(v) *vxpart(v,ITERVX,2) /* loop predicate for WHILE, UNTIL */
+
+/*DOVX parts */
+#define INC(v) *vxpart(v,DOVX,0) /* string for iteration condition of DO */
+
+/* IFVX,THENVX parts */
+#define PRED(v) *predic(v) /* string containing predicate */
+#define NEG(v) *negpart(v) /* TRUE if predicate negated */
+#define THEN 0 /* arc number of true branch */
+#define ELSE 1 /* arc number of false branch */
+
+/* miscellaneous parts */
+#define EXP(v) *expres(v) /* expression - ASVX, COMPVX, ASGOVX, SWCHVX, ICASVX */
+#define LABREF(v) *vxpart(v,ASVX,1) /* node referred to by label in ASSIGN statement */
+
+
+/* BRKVX, NXTVX parts */
+#define LEVEL(v) *level(v)
+
+/* also COMPVX, ASGOVX, SWCHVX, and DUMVX contain wd for number of arcs */
+/* location of this wd specified by negative entry in arcsper */
+extern int arcsper[TYPENUM];
+
+/* also nodes contain wds for children as specified by childper */
+extern childper[TYPENUM];
+
+
+/* switches */
+extern int intcase, arbcase, whiloop, invelse, exitsize, maxnode,
+ maxhash, progress, labinit, labinc, inputform, debug,levbrk,levnxt,mkunt;
+
+/* arrays */
+extern int *after;
+extern char *typename[];
+
+struct list {
+ VERT elt;
+ struct list *nxtlist;
+ };
+struct list *append(), *consl();
+extern VERT retvert, stopvert; /* specifies unique return and stop vertices */
+extern VERT START;
+extern int progtype; /* type of program - main or sub or blockdata */
+#define sub 1
+#define blockdata 2
+
+extern FILE *infd, *debfd, *outfd;
--- /dev/null
+%{
+#include "y.tab.h"
+#include "b.h"
+#undef input
+#define input() ninput()
+#undef unput
+#define unput(c) nunput(c)
+extern int yylval;
+#define xxbpmax 1700
+char xxbuf[xxbpmax + 2];
+int xxbp = -1;
+#define xxunmax 200
+char xxunbuf[xxunmax + 2];
+int xxunbp = -1;
+
+
+int blflag;
+%}
+
+D [0-9]
+A [0-9a-z]
+L [a-z]
+SP [^0-9a-z]
+
+%%
+
+%{
+char *xxtbuff;
+int xxj, xxn, xxk;
+char *xxp;
+%}
+[=/,(]{D}+[h] {
+ blflag = 1;
+ sscanf(&yytext[1],"%d",&xxn);
+ xxtbuff = malloc(2*xxn+3);
+ for (xxj = xxk = 1; xxj <= xxn; ++xxj)
+ {
+ xxtbuff[xxk] = ninput();
+ if (xxtbuff[xxk] == '"')
+ xxtbuff[++xxk] = '"';
+ ++xxk;
+ }
+ xxtbuff[0] = xxtbuff[xxk++] = '"';
+ xxtbuff[xxk] = '\0';
+ putback(xxtbuff);
+ free(xxtbuff);
+
+ backup(yytext[0]);
+ blflag = 0;
+ xxbp = -1;
+ }
+IF {fixval(); xxbp = -1; return(xxif);}
+ELSE {fixval(); xxbp = -1; return(xxelse);}
+REPEAT {fixval(); xxbp = -1; return(xxrept); }
+WHILE {fixval(); xxbp = -1; return(xxwhile); }
+UNTIL { fixval(); xxbp = -1; return(xxuntil); }
+DO {fixval(); xxbp = -1; return(xxdo); }
+SWITCH {fixval(); xxbp = -1; return(xxswitch); }
+CASE {fixval(); xxbp = -1; return(xxcase); }
+DEFAULT {fixval(); xxbp = -1; return(xxdefault); }
+END {fixval(); xxbp = -1; return(xxend); }
+
+".true." |
+".false." |
+
+{L}{A}* {fixval(); xxbp = -1; return(xxident); }
+~{D}+ {xxbuf[0] = ' '; fixval(); xxbp = -1; return(xxnum); }
+{D}+/"."(ge|gt|le|lt|eq|ne|not|or|and)"." |
+{D}+\.? |
+{D}+\.?[de][+-]?{D}+ |
+{D}*\.{D}+[de][+-]?{D}+ |
+{D}*\.{D}+ {fixval(); xxbp = -1; return(xxnum); }
+
+".gt." { putback(">"); xxbp = -1; }
+".ge." { putback(">=");xxbp = -1; }
+".lt." { putback("<"); xxbp = -1; }
+".le." { putback("<="); xxbp = -1; }
+".eq." { putback("=="); xxbp = -1; }
+".ne." { putback("!="); xxbp = -1; }
+".not." { putback("!"); xxbp = -1; }
+".or." { putback("||"); xxbp = -1; }
+".and." { putback("&&"); xxbp = -1; }
+">=" {fixval(); xxbp = -1; return(xxge); }
+"<=" {fixval(); xxbp = -1; return(xxle); }
+== {fixval(); xxbp = -1; return(xxeq); }
+!= {fixval(); xxbp = -1; return(xxne); }
+"||" {fixval(); xxbp = -1; return('|'); }
+"&&" {fixval(); xxbp = -1; return('&'); }
+"**" {fixval(); xxbp = -1; return('^'); }
+
+#.* {fixval(); xxbp = -1; return(xxcom); }
+\"([^"]|\"\")*\" {fixval(); xxbp = -1; return(xxstring); }
+'([^']|'')*' {
+ fixval();
+ xxp = yylval;
+ xxn = slength(xxp);
+ xxtbuff = malloc(2*xxn+1);
+ xxtbuff[0] = '"';
+ for (xxj = xxk = 1; xxj < xxn-1; ++xxj)
+ {
+ if (xxp[xxj] == '\'' && xxp[++xxj] == '\'')
+ xxtbuff[xxk++] = '\'';
+ else if (xxp[xxj] == '"')
+ {
+ xxtbuff[xxk++] = '"';
+ xxtbuff[xxk++] = '"';
+ }
+ else
+ xxtbuff[xxk++] = xxp[xxj];
+ }
+ xxtbuff[xxk++] = '"';
+ xxtbuff[xxk] = '\0';
+ free(xxp);
+ yylval = xxtbuff;
+ xxbp = -1;
+ return(xxstring);
+ }
+
+^\n xxbp = -1;
+\n {xxbp = -1; if (newflag) {fixval(); return('\n'); } }
+{SP} {fixval(); xxbp = -1; return(yytext[0]); }
+
+%%
+
+rdchar()
+ {
+ int c;
+ if (xxunbp >= 0)
+ return(xxunbuf[xxunbp--]);
+ c = getchar();
+ if (c == EOF) return('\0');
+ else return((char)c);
+ }
+
+backup(c)
+char c;
+ {
+ if (++xxunbp > xxunmax)
+ {
+ xxunbuf[xxunmax + 1] = '\0';
+ error("RATFOR beautifying; input backed up too far during lex:\n",
+ xxunbuf,"\n");
+ }
+ xxunbuf[xxunbp] = c;
+ }
+
+nunput(c)
+char c;
+ {
+ backup(c);
+ if (xxbp < 0) return;
+ if (c != xxbuf[xxbp])
+ {
+ xxbuf[xxbp + 1] = '\0';
+ error("RATFOR beautifying; lex call of nunput with wrong char:\n",
+ xxbuf,"\n");
+ }
+ for ( --xxbp; xxbp >= 0 && (xxbuf[xxbp] == ' ' || xxbuf[xxbp] == '\t'); --xxbp)
+ backup(xxbuf[xxbp]);
+ xxbuf[xxbp+1] = '\0';
+ }
+
+ninput()
+ {
+ char c,d;
+ if (blflag) c = rdchar();
+ else
+ while ( (c = rdchar()) == ' ' || c == '\t')
+ addbuf(c);
+ if (c != '\n')
+ return(addbuf(c));
+ while ( (d = rdchar()) == ' ' || d == '\t');
+ if (d == '&')
+ return(ninput());
+ backup(d);
+ return(addbuf('\n'));
+ }
+
+addbuf(c)
+char c;
+ {
+ if (++xxbp > xxbpmax)
+ {
+ xxbuf[xxbpmax +1] = '\0';
+ error("RATFOR beautifying; buffer xxbuf too small for token beginning:\n",
+ xxbuf,"\n");
+ }
+ xxbuf[xxbp] = c;
+ xxbuf[xxbp + 1] = '\0';
+ return(c);
+ }
+
+
+fixval()
+ {
+ int i, j, k;
+ for (j = 0; xxbuf[j] == ' ' || xxbuf[j] == '\t'; ++j);
+ for (k = j; xxbuf[k] != '\0'; ++k);
+ for (--k; k > j && xxbuf[k] == ' ' || xxbuf[k] == '\t'; --k);
+ xxbuf[k+1] = '\0';
+ i = slength(&xxbuf[j]) + 1;
+ yylval = malloc(i);
+ str_copy(&xxbuf[j],yylval,i);
+ }
+
+
+
+putback(str)
+char *str;
+ {
+ int i;
+ for (i = 0; str[i] != '\0'; ++i);
+ for (--i; i >= 0; --i)
+ backup(str[i]);
+ }
+
--- /dev/null
+#include <signal.h>
+#include <stdio.h>
+#include "1.defs.h"
+#include "def.h"
+
+
+char (*input)(), (*unput)();
+FILE *outfd = stdout;
+
+
+
+main(argc,argv)
+int argc;
+char *argv[];
+ {
+ int anyoutput;
+ int dexit();
+ char *getargs();
+ char input1(), unput1(), input2(), unput2();
+ anyoutput = FALSE;
+ getargs(argc,argv);
+ if (debug == 2) debfd = stderr;
+ else if (debug)
+ debfd = fopen("debug1","w");
+
+ if (signal(SIGINT, SIG_IGN) !=SIG_IGN)
+ signal(SIGINT,dexit);
+ prog_init();
+
+ for (;;)
+ {
+ ++routnum;
+ routerr = 0;
+
+ input = input1;
+ unput = unput1;
+ if (!mkgraph()) break;
+ if (debug) prgraph();
+ if (routerr) continue;
+
+ if (progress)fprintf(stderr,"build:\n");
+ build();
+ if (debug) prtree();
+ if (routerr) continue;
+
+ if (progress)fprintf(stderr,"structure:\n");
+ structure();
+ if (debug) prtree();
+ if (routerr) continue;
+ input = input2;
+ unput = unput2;
+
+ if (progress)fprintf(stderr,"output:\n");
+ output();
+ if (routerr) continue;
+ anyoutput = TRUE;
+ freegraf();
+ }
+ if (anyoutput)
+ exit(0);
+ else
+ exit(1);
+ }
+
+
+dexit()
+ {
+ exit(1);
+ }
--- /dev/null
+# include "y.tab.h"
+#include "b.h"
+#include <stdio.h>
+
+
+addroot(string,type,n1,n2)
+char *string;
+int type;
+struct node *n1, *n2;
+ {
+ struct node *p;
+ p = malloc(sizeof(*p));
+ p->left = n1;
+ p->right = n2;
+ p->op = type;
+ p->lit = malloc(slength(string) + 1);
+ str_copy(string,p->lit,slength(string) + 1);
+ return(p);
+ }
+
+
+freetree(tree)
+struct node *tree;
+ {
+ if (tree)
+ {freetree(tree->left);
+ freetree(tree->right);
+ freenode(tree);
+ }
+ }
+
+freenode(treenode)
+struct node *treenode;
+ {
+ free(treenode->lit);
+ free(treenode);
+ }
+
+int compop[] { '&', '|', '<', '>', xxeq, xxle, xxne, xxge};
+int notop[] { '|', '&', xxge, xxle, xxne, '>', xxeq, '<'};
+char *opstring[] { "||", "&&", ">=", "<=", "!=", ">", "==", "<"};
+
+checkneg(tree,neg) /* eliminate nots if possible */
+struct node *tree;
+int neg;
+ {
+ int i;
+ struct node *t;
+ if (!tree) return(0);
+ for (i = 0; i < 8; ++i)
+ if (tree->op == compop[i]) break;
+ if (i > 1 && i < 8 && tree ->left ->op == '-' && str_eq(tree->right->lit,"0"))
+ {
+ t = tree->right;
+ tree->right = tree->left->right;
+ freenode(t);
+ t = tree->left;
+ tree->left = tree->left->left;
+ freenode(t);
+ }
+
+
+ if (neg)
+ {
+ if (tree ->op == '!')
+ {
+ t = tree->left;
+ freenode(tree);
+ return(checkneg(t,0));
+ }
+ if (i < 8)
+ {
+ tree->op = notop[i];
+ free(tree->lit);
+ tree->lit = malloc(slength(opstring[i])+1);
+ str_copy(opstring[i],tree->lit, slength(opstring[i])+1);
+ if (tree->op == '&' || tree->op == '|')
+ {
+ tree->left = checkneg(tree->left,1);
+ tree->right = checkneg(tree->right,1);
+ }
+ return(tree);
+ }
+ if (tree->op == xxident && str_eq(tree->lit,".false."))
+ str_copy(".true.",tree->lit, slength(".true.")+1);
+ else if (tree->op == xxident && str_eq(tree->lit,".true."))
+ {
+ free(tree->lit);
+ tree->lit = malloc(slength(".false.")+1);
+ str_copy(".false.",tree->lit, slength(".false.")+1);
+ }
+ else
+ {
+ tree = addroot("!",'!',tree,0);
+ tree->lit = malloc(2);
+ str_copy("!",tree->lit, slength("!")+1);
+ }
+ return(tree);
+ }
+ else
+ if (tree->op == '!')
+ {
+ t = tree;
+ tree = tree->left;
+ freenode(t);
+ return(checkneg(tree,1));
+ }
+ else
+ {tree->left = checkneg(tree->left,0);
+ tree->right = checkneg(tree->right,0);
+ return(tree);
+ }
+ }
+
+yield(tree,fprec)
+struct node *tree;
+int fprec; /* fprec is precedence of father of this node */
+ {
+ int paren,p;
+ static int oplast; /* oplast = 1 iff last char printed was operator */
+ if (!tree) return;
+ p = prec(tree ->op);
+ paren = (p < fprec || (oplast && tree->op == xxuminus)) ? 1 : 0;
+
+ if (paren)
+ {
+ putout('(',"(");
+ oplast = 0;
+ }
+
+ switch(tree->op)
+ {
+ case xxuminus:
+ tree->op = '-';
+ case '!':
+ putout(tree->op,tree->lit);
+ oplast = 1;
+ yield(tree->left,p);
+ break;
+ case '&':
+ case '|':
+ case '<':
+ case '>':
+ case xxeq:
+ case xxle:
+ case xxge:
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case '^':
+ yield(tree->left,p);
+ putout(tree->op, tree->lit);
+ oplast = 1;
+ yield(tree->right,p);
+ break;
+ case xxidpar:
+ yield(tree->left,0);
+ putout('(',"(");
+ oplast = 0;
+ yield(tree->right,0);
+ putout('(',")");
+ oplast = 0;
+ break;
+ default:
+ yield(tree->left,p);
+ putout(tree->op, tree->lit);
+ oplast = 0;
+ yield(tree->right,p);
+ break;
+ }
+ if (paren)
+ {
+ putout(')',")");
+ oplast = 0;
+ }
+ }
+
+puttree(tree)
+struct node *tree;
+ {
+ yield(tree,0);
+ freetree(tree);
+ }
+
+
+prec(oper)
+int oper;
+ {
+ switch(oper)
+ {
+ case ',': return(0);
+ case '|': return(1);
+ case '&': return(2);
+ case '!': return(3);
+
+ case '<': case '>': case xxeq:
+ case xxne: case xxle: case xxge:
+ return(4);
+ case '+':
+ case '-': return(5);
+ case '*':
+ case '/': return(6);
+ case xxuminus: return(7);
+ case '^': return(8);
+ default: return(9);
+ }
+ }
+str_copy(s,ptr,length) /* copy s at ptr, return length of s */
+char *s, *ptr;
+int length;
+ {int i;
+ for (i = 0; i < length; i++)
+ {
+ ptr[i] = s[i];
+ if (ptr[i] == '\0')
+ return(i + 1);
+ }
+ fprintf(2,"string %s too long to be copied by str_copy at address %d\n",
+ *s,ptr);
+ exit(1);
+ }
+str_eq(s,t)
+char s[],t[];
+ {int j;
+ for (j = 0; s[j] == t[j]; j++)
+ {if (s[j] == '\0') return(1);}
+ return(0);
+ }
+
+slength(s) /* return number of chars in s, not counting '\0' */
+char *s;
+ {
+ int i;
+ if (!s) return(-1);
+ for (i = 0; s[i] != '\0'; i++);
+ return(i);
+ }