rs@uunet.UU.NET (Rich Salz) (07/28/87)
Submitted-by: Per Bergsten <mcvax!enea!chalmers!holtec!perb> Posting-number: Volume 10, Issue 68 Archive-name: ptoc/Part04 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 4 (of 12)." # Contents: ptc.c.2 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'ptc.c.2' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ptc.c.2'\" else echo shar: Extracting \"'ptc.c.2'\" \(34509 characters\) sed "s/^X//" >'ptc.c.2' <<'END_OF_FILE' X tf = typnods.A[(int)(tset)]; X break ; X case nselect: X tq = tq->U.V40.tfield; X break ; X case nderef: X tq = typeof(tq->U.V42.texps); X switch (tq->tt) { X case nptr: X tq = tq->U.V16.tptrid; X break ; X case nfileof: X tq = tq->U.V18.tof; X break ; X case npredef: X tf = typnods.A[(int)(tchar)]; X break ; X default: X Caseerror(Line); X } X break ; X case nindex: X tq = typeof(tq->U.V39.tvariable); X if (tq->tt == nconfarr) X tq = tq->U.V22.tcelem; X else X if (tq == typnods.A[(int)(tstring)]) X tf = typnods.A[(int)(tchar)]; X else X tq = tq->U.V23.taelem; X break ; X default: X Caseerror(Line); X } X } X if (tp->ttype == (struct S61 *)NIL) X tp->ttype = tf; X R92 = tf; X return R92; X} X X void Xlinkup(up, tp) X treeptr up, tp; X{ X while (tp != (struct S61 *)NIL) { X if (tp->tup == (struct S61 *)NIL) { X tp->tup = up; X switch (tp->tt) { X case npgm: case nfunc: case nproc: X linkup(tp, tp->U.V13.tsubid); X linkup(tp, tp->U.V13.tsubpar); X linkup(tp, tp->U.V13.tfuntyp); X linkup(tp, tp->U.V13.tsublab); X linkup(tp, tp->U.V13.tsubconst); X linkup(tp, tp->U.V13.tsubtype); X linkup(tp, tp->U.V13.tsubvar); X linkup(tp, tp->U.V13.tsubsub); X linkup(tp, tp->U.V13.tsubstmt); X break ; X case nvalpar: case nvarpar: case nconst: case ntype: X case nfield: case nvar: X linkup(tp, tp->U.V14.tidl); X linkup(tp, tp->U.V14.tbind); X break ; X case nparproc: case nparfunc: X linkup(tp, tp->U.V15.tparid); X linkup(tp, tp->U.V15.tparparm); X linkup(tp, tp->U.V15.tpartyp); X break ; X case nptr: X linkup(tp, tp->U.V16.tptrid); X break ; X case nscalar: X linkup(tp, tp->U.V17.tscalid); X break ; X case nsubrange: X linkup(tp, tp->U.V19.tlo); X linkup(tp, tp->U.V19.thi); X break ; X case nvariant: X linkup(tp, tp->U.V20.tselct); X linkup(tp, tp->U.V20.tvrnt); X break ; X case nrecord: X linkup(tp, tp->U.V21.tflist); X linkup(tp, tp->U.V21.tvlist); X break ; X case nconfarr: X linkup(tp, tp->U.V22.tcindx); X linkup(tp, tp->U.V22.tcelem); X linkup(tp, tp->U.V22.tindtyp); X break ; X case narray: X linkup(tp, tp->U.V23.taindx); X linkup(tp, tp->U.V23.taelem); X break ; X case nfileof: case nsetof: X linkup(tp, tp->U.V18.tof); X break ; X case nbegin: X linkup(tp, tp->U.V24.tbegin); X break ; X case nlabstmt: X linkup(tp, tp->U.V25.tlabno); X linkup(tp, tp->U.V25.tstmt); X break ; X case nassign: X linkup(tp, tp->U.V27.tlhs); X linkup(tp, tp->U.V27.trhs); X break ; X case npush: case npop: X linkup(tp, tp->U.V28.tglob); X linkup(tp, tp->U.V28.tloc); X linkup(tp, tp->U.V28.ttmp); X break ; X case ncall: X linkup(tp, tp->U.V30.tcall); X linkup(tp, tp->U.V30.taparm); X break ; X case nif: X linkup(tp, tp->U.V31.tifxp); X linkup(tp, tp->U.V31.tthen); X linkup(tp, tp->U.V31.telse); X break ; X case nwhile: X linkup(tp, tp->U.V32.twhixp); X linkup(tp, tp->U.V32.twhistmt); X break ; X case nrepeat: X linkup(tp, tp->U.V33.treptstmt); X linkup(tp, tp->U.V33.treptxp); X break ; X case nfor: X linkup(tp, tp->U.V34.tforid); X linkup(tp, tp->U.V34.tfrom); X linkup(tp, tp->U.V34.tto); X linkup(tp, tp->U.V34.tforstmt); X break ; X case ncase: X linkup(tp, tp->U.V35.tcasxp); X linkup(tp, tp->U.V35.tcaslst); X linkup(tp, tp->U.V35.tcasother); X break ; X case nchoise: X linkup(tp, tp->U.V36.tchocon); X linkup(tp, tp->U.V36.tchostmt); X break ; X case nwith: X linkup(tp, tp->U.V37.twithvar); X linkup(tp, tp->U.V37.twithstmt); X break ; X case nwithvar: X linkup(tp, tp->U.V38.texpw); X break ; X case nindex: X linkup(tp, tp->U.V39.tvariable); X linkup(tp, tp->U.V39.toffset); X break ; X case nselect: X linkup(tp, tp->U.V40.trecord); X linkup(tp, tp->U.V40.tfield); X break ; X case ngoto: X linkup(tp, tp->U.V26.tlabel); X break ; X case nrange: case nformat: case nin: case neq: X case nne: case nlt: case nle: case ngt: X case nge: case nor: case nplus: case nminus: X case nand: case nmul: case ndiv: case nmod: X case nquot: X linkup(tp, tp->U.V41.texpl); X linkup(tp, tp->U.V41.texpr); X break ; X case nderef: case nnot: case nset: case numinus: X case nuplus: X linkup(tp, tp->U.V42.texps); X break ; X case nid: case nnil: case ninteger: case nreal: X case nchar: case nstring: case npredef: case nlabel: X case nempty: X break ; X default: X Caseerror(Line); X } X } X tp = tp->tnext; X } X} X X symptr Xmksym(vt) X ltypes vt; X{ X register symptr R93; X symptr mp; X X mp = (struct S62 *)malloc((unsigned)(sizeof(*mp))); X if (mp == (struct S62 *)NIL) X error(enew); X mp->lt = vt; X mp->lnext = (struct S62 *)NIL; X mp->lsymdecl = (struct S61 *)NIL; X mp->ldecl = (struct S60 *)NIL; X R93 = mp; X return R93; X} X X void Xdeclsym(sp) X symptr sp; X{ X hashtyp h; X X if (Member((unsigned)(sp->lt), Conset[1])) X h = sp->U.V6.lid->ihash; X else X h = hashmax; X sp->lnext = symtab->ddecl.A[h]; X symtab->ddecl.A[h] = sp; X sp->ldecl = symtab; X} X X treeptr Xmknode(nt) X treetyp nt; X{ X register treeptr R94; X treeptr tp; X X tp = (struct S61 *)NIL; X switch (nt) { X case npredef: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V12.tdef) + sizeof(tp->U.V12))); X break ; X case npgm: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V13.tsubid) + sizeof(tp->U.V13))); X break ; X case nfunc: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V13.tsubid) + sizeof(tp->U.V13))); X break ; X case nproc: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V13.tsubid) + sizeof(tp->U.V13))); X break ; X case nlabel: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case nconst: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case ntype: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case nvar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case nvalpar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case nvarpar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case nparproc: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V15.tparid) + sizeof(tp->U.V15))); X break ; X case nparfunc: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V15.tparid) + sizeof(tp->U.V15))); X break ; X case nsubrange: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V19.tlo) + sizeof(tp->U.V19))); X break ; X case nvariant: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V20.tselct) + sizeof(tp->U.V20))); X break ; X case nfield: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V14.tidl) + sizeof(tp->U.V14))); X break ; X case nrecord: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V21.tflist) + sizeof(tp->U.V21))); X break ; X case nconfarr: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V22.tcindx) + sizeof(tp->U.V22))); X break ; X case narray: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V23.taindx) + sizeof(tp->U.V23))); X break ; X case nfileof: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V18.tof) + sizeof(tp->U.V18))); X break ; X case nsetof: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V18.tof) + sizeof(tp->U.V18))); X break ; X case nbegin: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V24.tbegin) + sizeof(tp->U.V24))); X break ; X case nptr: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V16.tptrid) + sizeof(tp->U.V16))); X break ; X case nscalar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V17.tscalid) + sizeof(tp->U.V17))); X break ; X case nif: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V31.tifxp) + sizeof(tp->U.V31))); X break ; X case nwhile: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V32.twhixp) + sizeof(tp->U.V32))); X break ; X case nrepeat: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V33.treptstmt) + sizeof(tp->U.V33))); X break ; X case nfor: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V34.tforid) + sizeof(tp->U.V34))); X break ; X case ncase: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V35.tcasxp) + sizeof(tp->U.V35))); X break ; X case nchoise: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V36.tchocon) + sizeof(tp->U.V36))); X break ; X case ngoto: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V26.tlabel) + sizeof(tp->U.V26))); X break ; X case nwith: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V37.twithvar) + sizeof(tp->U.V37))); X break ; X case nwithvar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V38.texpw) + sizeof(tp->U.V38))); X break ; X case nempty: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V12.tdef))); X break ; X case nlabstmt: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V25.tlabno) + sizeof(tp->U.V25))); X break ; X case nassign: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V27.tlhs) + sizeof(tp->U.V27))); X break ; X case nformat: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nin: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case neq: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nne: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nlt: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nle: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case ngt: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nge: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nor: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nplus: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nminus: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nand: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nmul: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case ndiv: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nmod: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nquot: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nnot: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V42.texps) + sizeof(tp->U.V42))); X break ; X case numinus: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V42.texps) + sizeof(tp->U.V42))); X break ; X case nuplus: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V42.texps) + sizeof(tp->U.V42))); X break ; X case nset: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V42.texps) + sizeof(tp->U.V42))); X break ; X case nrange: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V41.texpl) + sizeof(tp->U.V41))); X break ; X case nindex: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V39.tvariable) + sizeof(tp->U.V39))); X break ; X case nselect: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V40.trecord) + sizeof(tp->U.V40))); X break ; X case nderef: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V42.texps) + sizeof(tp->U.V42))); X break ; X case ncall: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V30.tcall) + sizeof(tp->U.V30))); X break ; X case nid: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case nchar: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case ninteger: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case nreal: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case nstring: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V43.tsym) + sizeof(tp->U.V43))); X break ; X case nnil: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V12.tdef))); X break ; X case npush: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V28.tglob) + sizeof(tp->U.V28))); X break ; X case npop: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V28.tglob) + sizeof(tp->U.V28))); X break ; X case nbreak: X tp = (struct S61 *)malloc((unsigned)(Unionoffs(tp, U.V29.tbrkid) + sizeof(tp->U.V29))); X break ; X default: X Caseerror(Line); X } X if (tp == (struct S61 *)NIL) X error(enew); X tp->tt = nt; X tp->tnext = (struct S61 *)NIL; X tp->tup = (struct S61 *)NIL; X tp->ttype = (struct S61 *)NIL; X R94 = tp; X return R94; X} X X treeptr Xmklit() X{ X register treeptr R95; X symptr sp; X treeptr tp; X X switch (currsym.st) { X case sinteger: X sp = mksym(linteger); X sp->U.V10.linum = currsym.U.V3.vint; X tp = mknode(ninteger); X break ; X case sreal: X sp = mksym(lreal); X sp->U.V8.lfloat = currsym.U.V4.vflt; X tp = mknode(nreal); X break ; X case schar: X sp = mksym(lcharacter); X sp->U.V11.lchar = currsym.U.V2.vchr; X tp = mknode(nchar); X break ; X case sstring: X sp = mksym(lstring); X sp->U.V7.lstr = currsym.U.V5.vstr; X tp = mknode(nstring); X break ; X default: X Caseerror(Line); X } X tp->U.V43.tsym = sp; X sp->lsymdecl = tp; X R95 = tp; X return R95; X} X X symptr Xlookupid(ip, fieldok) X idptr ip; X boolean fieldok; X{ X register symptr R96; X symptr sp; X declptr dp; X struct { setword S[2]; } vs; X X R96 = (struct S62 *)NIL; X if (fieldok) X Setncpy(vs.S, Conset[2], sizeof(vs.S)); X else X Setncpy(vs.S, Conset[3], sizeof(vs.S)); X sp = (struct S62 *)NIL; X dp = symtab; X while (dp != (struct S60 *)NIL) { X sp = dp->ddecl.A[ip->ihash]; X while (sp != (struct S62 *)NIL) { X if ((Member((unsigned)(sp->lt), vs.S)) && (sp->U.V6.lid == ip)) X goto L999; X sp = sp->lnext; X } X dp = dp->dprev; X } XL999: X R96 = sp; X return R96; X} X X symptr Xlookuplabel(i) X integer i; X{ X register symptr R97; X symptr sp; X declptr dp; X X sp = (struct S62 *)NIL; X dp = symtab; X while (dp != (struct S60 *)NIL) { X sp = dp->ddecl.A[hashmax]; X while (sp != (struct S62 *)NIL) { X if ((Member((unsigned)(sp->lt), Conset[4])) && (sp->U.V9.lno == i)) X goto L999; X sp = sp->lnext; X } X dp = dp->dprev; X } XL999: X R97 = sp; X return R97; X} X X void Xenterscope(dp) X declptr dp; X{ X register hashtyp h; X X if (dp == (struct S60 *)NIL) { X dp = (struct S60 *)malloc((unsigned)(sizeof(*dp))); X { X hashtyp B47 = 0, X B48 = hashmax; X X if (B47 <= B48) X for (h = B47; ; h++) { X dp->ddecl.A[h] = (struct S62 *)NIL; X if (h == B48) break; X } X } X } X dp->dprev = symtab; X symtab = dp; X} X X declptr Xcurrscope() X{ X register declptr R98; X X R98 = symtab; X return R98; X} X X void Xleavescope() X{ X symtab = symtab->dprev; X} X X symptr Xmkid(ip) X idptr ip; X{ X register symptr R99; X symptr sp; X X sp = mksym(lidentifier); X sp->U.V6.lid = ip; X sp->U.V6.lused = false; X declsym(sp); X ip->inref = ip->inref + 1; X R99 = sp; X return R99; X} X X treeptr Xnewid(ip) X idptr ip; X{ X register treeptr R100; X symptr sp; X treeptr tp; X X sp = lookupid(ip, false); X if (sp != (struct S62 *)NIL) X if (sp->ldecl != symtab) X sp = (struct S62 *)NIL; X if (sp == (struct S62 *)NIL) { X tp = mknode(nid); X sp = mkid(ip); X sp->lsymdecl = tp; X tp->U.V43.tsym = sp; X } else X if (sp->lt == lpointer) { X tp = mknode(nid); X tp->U.V43.tsym = sp; X sp->lt = lidentifier; X sp->lsymdecl = tp; X } else X if (sp->lt == lforward) { X sp->lt = lidentifier; X tp = sp->lsymdecl; X } else X error(emultdeclid); X R100 = tp; X return R100; X} X X treeptr Xoldid(ip, l) X idptr ip; X ltypes l; X{ X register treeptr R101; X symptr sp; X treeptr tp; X X sp = lookupid(ip, true); X if (sp == (struct S62 *)NIL) { X if (Member((unsigned)(l), Conset[5])) { X tp = newid(ip); X tp->U.V43.tsym->lt = l; X } else X error(enotdeclid); X } else { X sp->U.V6.lused = true; X tp = mknode(nid); X tp->U.V43.tsym = sp; X if ((sp->lt == lpointer) && (l == lidentifier)) { X sp->lt = lidentifier; X sp->lsymdecl = tp; X } X } X R101 = tp; X return R101; X} X X treeptr Xoldfield(tp, ip) X treeptr tp; X idptr ip; X{ X register treeptr R102; X treeptr tq, ti, fp; X X fp = (struct S61 *)NIL; X tq = tp->U.V21.tflist; X while (tq != (struct S61 *)NIL) { X ti = tq->U.V14.tidl; X while (ti != (struct S61 *)NIL) { X if (ti->U.V43.tsym->U.V6.lid == ip) { X fp = mknode(nid); X fp->U.V43.tsym = ti->U.V43.tsym; X goto L999; X } X ti = ti->tnext; X } X tq = tq->tnext; X } X tq = tp->U.V21.tvlist; X while (tq != (struct S61 *)NIL) { X fp = oldfield(tq->U.V20.tvrnt, ip); X if (fp != (struct S61 *)NIL) X tq = (struct S61 *)NIL; X else X tq = tq->tnext; X } XL999: X R102 = fp; X return R102; X} X Xvoid parse(); X Xtreeptr plabel(); X Xtreeptr pidlist(); X X Xtreeptr pconst(); X Xtreeptr pconstant(); X Xtreeptr precord(); X Xtreeptr ptypedef(); X Xtreeptr ptype(); X Xtreeptr pvar(); X Xtreeptr psubs(); X Xtreeptr psubpar(); X Xtreeptr plabstmt(); X Xtreeptr pstmt(); X Xtreeptr psimple(); X Xtreeptr pvariable(); X Xtreeptr pexpr(); X Xtreeptr pcase(); X Xtreeptr pif(); X Xtreeptr pwhile(); X Xtreeptr prepeat(); X Xtreeptr pfor(); X Xtreeptr pwith(); X Xtreeptr pgoto(); X Xtreeptr pbegin(); X Xvoid scopeup(); X X void Xaddfields(rp) X treeptr rp; X{ X treeptr fp, ip, vp; X symptr sp; X X fp = rp->U.V21.tflist; X while (fp != (struct S61 *)NIL) { X ip = fp->U.V14.tidl; X while (ip != (struct S61 *)NIL) { X sp = mksym(lfield); X sp->U.V6.lid = ip->U.V43.tsym->U.V6.lid; X sp->U.V6.lused = false; X sp->lsymdecl = ip; X declsym(sp); X ip = ip->tnext; X } X fp = fp->tnext; X } X vp = rp->U.V21.tvlist; X while (vp != (struct S61 *)NIL) { X addfields(vp->U.V20.tvrnt); X vp = vp->tnext; X } X} X X void Xscopeup(tp) X treeptr tp; X{ X addfields(typeof(tp)); X} X X treeptr Xnewlbl() X{ X register treeptr R126; X symptr sp; X treeptr tp; X X tp = mknode(nlabel); X sp = lookuplabel(currsym.U.V3.vint); X if (sp != (struct S62 *)NIL) X if (sp->ldecl != symtab) X sp = (struct S62 *)NIL; X if (sp == (struct S62 *)NIL) { X sp = mksym(lforwlab); X sp->U.V9.lno = currsym.U.V3.vint; X sp->U.V9.lgo = false; X sp->lsymdecl = tp; X declsym(sp); X } else X error(emultdecllab); X tp->U.V43.tsym = sp; X R126 = tp; X return R126; X} X X treeptr Xoldlbl(defpt) X boolean defpt; X{ X register treeptr R127; X symptr sp; X treeptr tp; X X sp = lookuplabel(currsym.U.V3.vint); X if (sp == (struct S62 *)NIL) { X prtmsg(enotdecllab); X tp = newlbl(); X sp = tp->U.V43.tsym; X } else { X tp = mknode(nlabel); X tp->U.V43.tsym = sp; X } X if (defpt) { X if (sp->lt == lforwlab) X sp->lt = llabel; X else X error(emuldeflab); X } X R127 = tp; X return R127; X} X X void Xpbody(tp) X treeptr tp; X{ X treeptr tq; X X statlvl = statlvl + 1; X if (currsym.st == slabel) { X tp->U.V13.tsublab = plabel(); X linkup(tp, tp->U.V13.tsublab); X } else X tp->U.V13.tsublab = (struct S61 *)NIL; X if (currsym.st == sconst) { X tp->U.V13.tsubconst = pconst(); X linkup(tp, tp->U.V13.tsubconst); X } else X tp->U.V13.tsubconst = (struct S61 *)NIL; X if (currsym.st == stype) { X tp->U.V13.tsubtype = ptype(); X linkup(tp, tp->U.V13.tsubtype); X } else X tp->U.V13.tsubtype = (struct S61 *)NIL; X if (currsym.st == svar) { X tp->U.V13.tsubvar = pvar(); X linkup(tp, tp->U.V13.tsubvar); X } else X tp->U.V13.tsubvar = (struct S61 *)NIL; X tp->U.V13.tsubsub = (struct S61 *)NIL; X tq = (struct S61 *)NIL; X while ((currsym.st == sproc) || (currsym.st == sfunc)) { X if (tq == (struct S61 *)NIL) { X tq = psubs(); X tp->U.V13.tsubsub = tq; X } else { X tq->tnext = psubs(); X tq = tq->tnext; X } X } X linkup(tp, tp->U.V13.tsubsub); X checksymbol(*((symset *)Conset[6])); X if (currsym.st == sbegin) { X tp->U.V13.tsubstmt = pbegin(false); X linkup(tp, tp->U.V13.tsubstmt); X } X statlvl = statlvl - 1; X} X Xtreeptr pprogram(); X X treeptr Xpprmlist() X{ X register treeptr R129; X treeptr tp, tq; X idptr din, dut; X X tp = (struct S61 *)NIL; X din = deftab.A[(int)(dinput)]->U.V14.tidl->U.V43.tsym->U.V6.lid; X dut = deftab.A[(int)(doutput)]->U.V14.tidl->U.V43.tsym->U.V6.lid; X while ((currsym.U.V1.vid == din) || (currsym.U.V1.vid == dut)) { X if (currsym.U.V1.vid == din) X defnams.A[(int)(dinput)]->U.V6.lused = true; X else X defnams.A[(int)(doutput)]->U.V6.lused = true; X nextsymbol(*((symset *)Conset[7])); X if (currsym.st == srpar) X goto L999; X nextsymbol(*((symset *)Conset[8])); X } X tq = newid(currsym.U.V1.vid); X tq->U.V43.tsym->lt = lpointer; X tp = tq; X nextsymbol(*((symset *)Conset[9])); X while (currsym.st == scomma) { X nextsymbol(*((symset *)Conset[10])); X if (currsym.U.V1.vid == din) X defnams.A[(int)(dinput)]->U.V6.lused = true; X else X if (currsym.U.V1.vid == dut) X defnams.A[(int)(doutput)]->U.V6.lused = true; X else { X tq->tnext = newid(currsym.U.V1.vid); X tq = tq->tnext; X tq->U.V43.tsym->lt = lpointer; X } X nextsymbol(*((symset *)Conset[11])); X } XL999: X R129 = tp; X return R129; X} X X treeptr Xpprogram() X{ X register treeptr R128; X treeptr tp; X X enterscope((declptr)NIL); X tp = mknode(npgm); X nextsymbol(*((symset *)Conset[12])); X tp->U.V13.tstat = statlvl; X tp->U.V13.tsubid = mknode(nid); X tp->U.V13.tsubid->tup = tp; X tp->U.V13.tsubid->U.V43.tsym = mksym(lidentifier); X tp->U.V13.tsubid->U.V43.tsym->U.V6.lid = currsym.U.V1.vid; X tp->U.V13.tsubid->U.V43.tsym->lsymdecl = tp->U.V13.tsubid; X linkup(tp, tp->U.V13.tsubid); X nextsymbol(*((symset *)Conset[13])); X if (currsym.st == slpar) { X nextsymbol(*((symset *)Conset[14])); X tp->U.V13.tsubpar = pprmlist(); X linkup(tp, tp->U.V13.tsubpar); X nextsymbol(*((symset *)Conset[15])); X } else X tp->U.V13.tsubpar = (struct S61 *)NIL; X nextsymbol(*((symset *)Conset[16])); X pbody(tp); X checksymbol(*((symset *)Conset[17])); X tp->U.V13.tscope = currscope(); X leavescope(); X R128 = tp; X return R128; X} X X treeptr Xpmodule() X{ X register treeptr R130; X treeptr tp; X X enterscope((declptr)NIL); X tp = mknode(npgm); X tp->U.V13.tstat = statlvl; X tp->U.V13.tsubid = (struct S61 *)NIL; X tp->U.V13.tsubpar = (struct S61 *)NIL; X pbody(tp); X checksymbol(*((symset *)Conset[18])); X tp->U.V13.tscope = currscope(); X leavescope(); X R130 = tp; X return R130; X} X X treeptr Xplabel() X{ X register treeptr R131; X treeptr tp, tq; X X tq = (struct S61 *)NIL; X do { X nextsymbol(*((symset *)Conset[19])); X if (tq == (struct S61 *)NIL) { X tq = newlbl(); X tp = tq; X } else { X tq->tnext = newlbl(); X tq = tq->tnext; X } X nextsymbol(*((symset *)Conset[20])); X } while (!(currsym.st == ssemic)); X nextsymbol(*((symset *)Conset[21])); X R131 = tp; X return R131; X} X X treeptr Xpidlist(l) X ltypes l; X{ X register treeptr R132; X treeptr tp, tq; X X tq = newid(currsym.U.V1.vid); X tq->U.V43.tsym->lt = l; X tp = tq; X nextsymbol(*((symset *)Conset[22])); X while (currsym.st == scomma) { X nextsymbol(*((symset *)Conset[23])); X tq->tnext = newid(currsym.U.V1.vid); X tq = tq->tnext; X tq->U.V43.tsym->lt = l; X nextsymbol(*((symset *)Conset[24])); X } X R132 = tp; X return R132; X} X X treeptr Xpconst() X{ X register treeptr R133; X treeptr tp, tq; X X tq = (struct S61 *)NIL; X nextsymbol(*((symset *)Conset[25])); X do { X if (tq == (struct S61 *)NIL) { X tq = mknode(nconst); X tq->U.V14.tattr = anone; X tp = tq; X } else { X tq->tnext = mknode(nconst); X tq = tq->tnext; X tq->U.V14.tattr = anone; X } X tq->U.V14.tidl = pidlist(lidentifier); X checksymbol(*((symset *)Conset[26])); X nextsymbol(*((symset *)Conset[27])); X tq->U.V14.tbind = pconstant(true); X nextsymbol(*((symset *)Conset[28])); X nextsymbol(*((symset *)Conset[29])); X } while (!(currsym.st != sid)); X R133 = tp; X return R133; X} X X treeptr Xpconstant(realok) X boolean realok; X{ X register treeptr R134; X treeptr tp, tq; X boolean neg; X X neg = (boolean)(currsym.st == sminus); X if (Member((unsigned)(currsym.st), Conset[30])) X if (realok) X nextsymbol(*((symset *)Conset[31])); X else X nextsymbol(*((symset *)Conset[32])); X if (currsym.st == sid) X tp = oldid(currsym.U.V1.vid, lidentifier); X else X tp = mklit(); X if (neg) { X tq = mknode(numinus); X tq->U.V42.texps = tp; X tp = tq; X } X R134 = tp; X return R134; X} X X treeptr Xprecord(cs, dp) X symtyp cs; X declptr dp; X{ X register treeptr R135; X treeptr tp, tq, tl, tv; X lexsym tsym; X X tp = mknode(nrecord); X tp->U.V21.tflist = (struct S61 *)NIL; X tp->U.V21.tvlist = (struct S61 *)NIL; X tp->U.V21.tuid = (struct S59 *)NIL; X tp->U.V21.trscope = (struct S60 *)NIL; X if (cs == send) { X enterscope(dp); X dp = currscope(); X } X nextsymbol(*((symset *)Union(Conset[33], Saveset((Tmpset = Newset(), (void)Insmem((unsigned)(cs), Tmpset), Tmpset))))); X Claimset(); X tq = (struct S61 *)NIL; X while (currsym.st == sid) { X if (tq == (struct S61 *)NIL) { X tq = mknode(nfield); X tq->U.V14.tattr = anone; X tp->U.V21.tflist = tq; X } else { X tq->tnext = mknode(nfield); X tq = tq->tnext; X tq->U.V14.tattr = anone; X } X tq->U.V14.tidl = pidlist(lfield); X checksymbol(*((symset *)Conset[34])); X leavescope(); X tq->U.V14.tbind = ptypedef(); X enterscope(dp); X if (currsym.st == ssemic) X nextsymbol(*((symset *)Union(Conset[35], Saveset((Tmpset = Newset(), (void)Insmem((unsigned)(cs), Tmpset), Tmpset))))); X Claimset(); X } X if (currsym.st == scase) { X nextsymbol(*((symset *)Conset[36])); X tsym = currsym; X nextsymbol(*((symset *)Conset[37])); X if (currsym.st == scolon) { X tv = newid(tsym.U.V1.vid); X if (tq == (struct S61 *)NIL) { X tq = mknode(nfield); X tp->U.V21.tflist = tq; X } else { X tq->tnext = mknode(nfield); X tq = tq->tnext; X } X tq->U.V14.tidl = tv; X tv->U.V43.tsym->lt = lfield; X nextsymbol(*((symset *)Conset[38])); X leavescope(); X tq->U.V14.tbind = oldid(currsym.U.V1.vid, lidentifier); X enterscope(dp); X nextsymbol(*((symset *)Conset[39])); X } X tq = (struct S61 *)NIL; X do { X tv = (struct S61 *)NIL; X do { X nextsymbol(*((symset *)Union(Conset[40], Saveset((Tmpset = Newset(), (void)Insmem((unsigned)(cs), Tmpset), Tmpset))))); X Claimset(); X if (currsym.st == cs) X goto L999; X if (tv == (struct S61 *)NIL) { X tv = pconstant(false); X tl = tv; X } else { X tv->tnext = pconstant(false); X tv = tv->tnext; X } X nextsymbol(*((symset *)Conset[41])); X } while (!(currsym.st == scolon)); X nextsymbol(*((symset *)Conset[42])); X if (tq == (struct S61 *)NIL) { X tq = mknode(nvariant); X tp->U.V21.tvlist = tq; X } else { X tq->tnext = mknode(nvariant); X tq = tq->tnext; X } X tq->U.V20.tselct = tl; X tq->U.V20.tvrnt = precord(srpar, dp); X } while (!(currsym.st == cs)); X } XL999: X if (cs == send) { X tp->U.V21.trscope = dp; X leavescope(); X } X nextsymbol(*((symset *)Conset[43])); X R135 = tp; X return R135; X} X X treeptr Xptypedef() X{ X register treeptr R136; X treeptr tp, tq; X symtyp st; X symset ss; X X nextsymbol(*((symset *)Conset[44])); X if (currsym.st == spacked) X nextsymbol(*((symset *)Conset[45])); X Setncpy(ss.S, Conset[46], sizeof(ss.S)); X switch (currsym.st) { X case splus: case sminus: case schar: case sinteger: X case sid: X st = currsym.st; X tp = pconstant(false); X if (st == sid) X nextsymbol(*((symset *)Union(Conset[47], ss.S))); X else X nextsymbol(*((symset *)Conset[48])); X Claimset(); X if (currsym.st == sdotdot) { X nextsymbol(*((symset *)Conset[49])); X tq = mknode(nsubrange); X tq->U.V19.tlo = tp; X tq->U.V19.thi = pconstant(false); X tp = tq; X nextsymbol(ss); X } X break ; X case slpar: X tp = mknode(nscalar); X nextsymbol(*((symset *)Conset[50])); X tp->U.V17.tscalid = pidlist(lidentifier); X checksymbol(*((symset *)Conset[51])); X nextsymbol(ss); X break ; X case sarrow: X tp = mknode(nptr); X nextsymbol(*((symset *)Conset[52])); X tp->U.V16.tptrid = oldid(currsym.U.V1.vid, lpointer); X tp->U.V16.tptrflag = false; X nextsymbol(*((symset *)Conset[53])); X break ; X case sarray: X nextsymbol(*((symset *)Conset[54])); X tp = mknode(narray); X tp->U.V23.taindx = ptypedef(); X tq = tp; X while (currsym.st == scomma) { X tq->U.V23.taelem = mknode(narray); X tq = tq->U.V23.taelem; X tq->U.V23.taindx = ptypedef(); X } X checksymbol(*((symset *)Conset[55])); X nextsymbol(*((symset *)Conset[56])); X tq->U.V23.taelem = ptypedef(); X break ; X case srecord: X tp = precord(send, (declptr)NIL); X break ; X case sfile: case sset: X if (currsym.st == sfile) X tp = mknode(nfileof); X else { X tp = mknode(nsetof); X usesets = true; X } X nextsymbol(*((symset *)Conset[57])); X tp->U.V18.tof = ptypedef(); X break ; X default: X Caseerror(Line); X } X R136 = tp; X return R136; X} X X treeptr Xptype() X{ X register treeptr R137; X treeptr tp, tq; X X tq = (struct S61 *)NIL; X nextsymbol(*((symset *)Conset[58])); X do { X if (tq == (struct S61 *)NIL) { X tq = mknode(ntype); X tq->U.V14.tattr = anone; X tp = tq; X } else { X tq->tnext = mknode(ntype); X tq = tq->tnext; X tq->U.V14.tattr = anone; X } X tq->U.V14.tidl = pidlist(lidentifier); X checksymbol(*((symset *)Conset[59])); X tq->U.V14.tbind = ptypedef(); X nextsymbol(*((symset *)Conset[60])); X } while (!(currsym.st != sid)); X R137 = tp; X return R137; X} X X treeptr Xpvar() X{ X register treeptr R138; X treeptr ti, tp, tq; X X tq = (struct S61 *)NIL; X nextsymbol(*((symset *)Conset[61])); X do { X if (tq == (struct S61 *)NIL) { X tq = mknode(nvar); X tq->U.V14.tattr = anone; X tp = tq; X } else { X tq->tnext = mknode(nvar); X tq = tq->tnext; X tq->U.V14.tattr = anone; X } X ti = newid(currsym.U.V1.vid); X tq->U.V14.tidl = ti; X nextsymbol(*((symset *)Conset[62])); X while (currsym.st == scomma) { X nextsymbol(*((symset *)Conset[63])); X ti->tnext = newid(currsym.U.V1.vid); X ti = ti->tnext; X nextsymbol(*((symset *)Conset[64])); X } X tq->U.V14.tbind = ptypedef(); X nextsymbol(*((symset *)Conset[65])); X } while (!(currsym.st != sid)); X R138 = tp; X return R138; X} X X treeptr Xpsubs() X{ X register treeptr R139; X treeptr tp, tv, tq; X boolean func; X symtyp colsem; X X func = (boolean)(currsym.st == sfunc); X if (func) X colsem = scolon; X else X colsem = ssemic; X nextsymbol(*((symset *)Conset[66])); X tq = newid(currsym.U.V1.vid); X if (tq->tup == (struct S61 *)NIL) { X enterscope((declptr)NIL); X if (func) X tp = mknode(nfunc); X else X tp = mknode(nproc); X tp->U.V13.tstat = statlvl; X tp->U.V13.tsubid = tq; X linkup(tp, tq); X nextsymbol(*((symset *)(Tmpset = Newset(), (void)Insmem((unsigned)(slpar), Tmpset), X (void)Insmem((unsigned)(colsem), Tmpset), Tmpset))); X if (currsym.st == slpar) { X tp->U.V13.tsubpar = psubpar(); X linkup(tp, tp->U.V13.tsubpar); X nextsymbol(*((symset *)(Tmpset = Newset(), (void)Insmem((unsigned)(colsem), Tmpset), Tmpset))); X } else X tp->U.V13.tsubpar = (struct S61 *)NIL; X if (func) { X nextsymbol(*((symset *)Conset[67])); X tp->U.V13.tfuntyp = oldid(currsym.U.V1.vid, lidentifier); X nextsymbol(*((symset *)Conset[68])); X } else X tp->U.V13.tfuntyp = mknode(nempty); X linkup(tp, tp->U.V13.tfuntyp); X nextsymbol(*((symset *)Conset[69])); X } else { X enterscope(tq->tup->U.V13.tscope); X if (func) X tp = mknode(nfunc); X else X tp = mknode(nproc); X tp->U.V13.tfuntyp = tq->tup->U.V13.tfuntyp; X tv = tq->tup->U.V13.tsubpar; X tp->U.V13.tsubpar = tv; X while (tv != (struct S61 *)NIL) { X tv->tup = tp; X tv = tv->tnext; X } X tp->U.V13.tsubid = tq; X tq->tup = tp; X nextsymbol(*((symset *)Conset[70])); X nextsymbol(*((symset *)Conset[71])); X } X if (Member((unsigned)(currsym.st), Conset[72])) { X tp->U.V13.tsubid->U.V43.tsym->lt = lforward; X nextsymbol(*((symset *)Conset[73])); X tp->U.V13.tsublab = (struct S61 *)NIL; X tp->U.V13.tsubconst = (struct S61 *)NIL; X tp->U.V13.tsubtype = (struct S61 *)NIL; X tp->U.V13.tsubvar = (struct S61 *)NIL; X tp->U.V13.tsubsub = (struct S61 *)NIL; X tp->U.V13.tsubstmt = (struct S61 *)NIL; X } else X pbody(tp); X nextsymbol(*((symset *)Conset[74])); X tp->U.V13.tscope = currscope(); X leavescope(); X R139 = tp; X return R139; X} X X treeptr Xpconfsub() X{ X register treeptr R140; X treeptr tp; X X tp = mknode(nsubrange); X nextsymbol(*((symset *)Conset[75])); X tp->U.V19.tlo = newid(currsym.U.V1.vid); X nextsymbol(*((symset *)Conset[76])); X nextsymbol(*((symset *)Conset[77])); X tp->U.V19.thi = newid(currsym.U.V1.vid); X nextsymbol(*((symset *)Conset[78])); X R140 = tp; X return R140; X} X X treeptr Xpconform() X{ X register treeptr R141; X treeptr tp, tq; X X nextsymbol(*((symset *)Conset[79])); X tp = mknode(nconfarr); X tp->U.V22.tcuid = mkvariable('S'); X tp->U.V22.tcindx = pconfsub(); X nextsymbol(*((symset *)Conset[80])); X tp->U.V22.tindtyp = oldid(currsym.U.V1.vid, lidentifier); X nextsymbol(*((symset *)Conset[81])); X tq = tp; X while (currsym.st == ssemic) { X error(econfconf); X tq->U.V22.tcelem = mknode(nconfarr); X tq = tq->U.V22.tcelem; X tq->U.V22.tcindx = pconfsub(); X nextsymbol(*((symset *)Conset[82])); X tq->U.V22.tindtyp = oldid(currsym.U.V1.vid, lidentifier); X nextsymbol(*((symset *)Conset[83])); X } X nextsymbol(*((symset *)Conset[84])); X nextsymbol(*((symset *)Conset[85])); X switch (currsym.st) { X case sid: X tq->U.V22.tcelem = oldid(currsym.U.V1.vid, lidentifier); X break ; X case sarray: X error(econfconf); X tq->U.V22.tcelem = pconform(); X break ; X default: X Caseerror(Line); X } X R141 = tp; X return R141; X} X X treeptr Xpsubpar() X{ X register treeptr R142; X treeptr tp, tq; X treetyp nt; X X tq = (struct S61 *)NIL; X do { X nextsymbol(*((symset *)Conset[86])); X switch (currsym.st) { X case sid: X nt = nvalpar; X break ; X case svar: X nt = nvarpar; X break ; X case sfunc: X nt = nparfunc; X break ; X case sproc: X nt = nparproc; X break ; X default: X Caseerror(Line); X } X if (nt != nvalpar) X nextsymbol(*((symset *)Conset[87])); X if (tq == (struct S61 *)NIL) { X tq = mknode(nt); X tp = tq; X } else { X tq->tnext = mknode(nt); X tq = tq->tnext; X } X switch (nt) { X case nvarpar: case nvalpar: X tq->U.V14.tidl = pidlist(lidentifier); X tq->U.V14.tattr = anone; X checksymbol(*((symset *)Conset[88])); X if (nt == nvalpar) X nextsymbol(*((symset *)Conset[89])); X else X nextsymbol(*((symset *)Conset[90])); X switch (currsym.st) { X case sid: X tq->U.V14.tbind = oldid(currsym.U.V1.vid, lidentifier); X break ; X case sarray: X tq->U.V14.tbind = pconform(); END_OF_FILE if test 34509 -ne `wc -c <'ptc.c.2'`; then echo shar: \"'ptc.c.2'\" unpacked with wrong size! fi # end of 'ptc.c.2' fi echo shar: End of archive 4 \(of 12\). cp /dev/null ark4isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 12 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Rich $alz "Anger is an energy" Cronus Project, BBN Labs rsalz@bbn.com Moderator, comp.sources.unix sources@uunet.uu.net