rs@uunet.UU.NET (Rich Salz) (07/28/87)
Submitted-by: Per Bergsten <mcvax!enea!chalmers!holtec!perb> Posting-number: Volume 10, Issue 66 Archive-name: ptoc/Part02 #! /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 2 (of 12)." # Contents: ptc.c.3 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'ptc.c.3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ptc.c.3'\" else echo shar: Extracting \"'ptc.c.3'\" \(30864 characters\) sed "s/^X//" >'ptc.c.3' <<'END_OF_FILE' X break ; X default: X Caseerror(Line); X } X nextsymbol(*((symset *)Conset[91])); X break ; X case nparproc: X tq->U.V15.tparid = newid(currsym.U.V1.vid); X nextsymbol(*((symset *)Conset[92])); X if (currsym.st == slpar) { X enterscope((declptr)NIL); X tq->U.V15.tparparm = psubpar(); X nextsymbol(*((symset *)Conset[93])); X leavescope(); X } else X tq->U.V15.tparparm = (struct S61 *)NIL; X tq->U.V15.tpartyp = (struct S61 *)NIL; X break ; X case nparfunc: X tq->U.V15.tparid = newid(currsym.U.V1.vid); X nextsymbol(*((symset *)Conset[94])); X if (currsym.st == slpar) { X enterscope((declptr)NIL); X tq->U.V15.tparparm = psubpar(); X nextsymbol(*((symset *)Conset[95])); X leavescope(); X } else X tq->U.V15.tparparm = (struct S61 *)NIL; X nextsymbol(*((symset *)Conset[96])); X tq->U.V15.tpartyp = oldid(currsym.U.V1.vid, lidentifier); X nextsymbol(*((symset *)Conset[97])); X break ; X default: X Caseerror(Line); X } X } while (!(currsym.st == srpar)); X R142 = tp; X return R142; X} X X treeptr Xplabstmt() X{ X register treeptr R143; X treeptr tp; X X nextsymbol(*((symset *)Conset[98])); X if (currsym.st == sinteger) { X tp = mknode(nlabstmt); X tp->U.V25.tlabno = oldlbl(true); X nextsymbol(*((symset *)Conset[99])); X nextsymbol(*((symset *)Conset[100])); X tp->U.V25.tstmt = pstmt(); X } else X tp = pstmt(); X R143 = tp; X return R143; X} X X treeptr Xpstmt() X{ X register treeptr R144; X treeptr tp; X X switch (currsym.st) { X case sid: X tp = psimple(); X break ; X case sif: X tp = pif(); X break ; X case swhile: X tp = pwhile(); X break ; X case srepeat: X tp = prepeat(); X break ; X case sfor: X tp = pfor(); X break ; X case scase: X tp = pcase(); X break ; X case swith: X tp = pwith(); X break ; X case sbegin: X tp = pbegin(true); X break ; X case sgoto: X tp = pgoto(); X break ; X case send: case selse: case suntil: case ssemic: X tp = mknode(nempty); X break ; X default: X Caseerror(Line); X } X R144 = tp; X return R144; X} X X treeptr Xpsimple() X{ X register treeptr R145; X treeptr tq, tp; X X tp = pvariable(oldid(currsym.U.V1.vid, lidentifier)); X if (currsym.st == sassign) { X tq = mknode(nassign); X tq->U.V27.tlhs = tp; X tq->U.V27.trhs = pexpr((treeptr)NIL); X tp = tq; X } X R145 = tp; X return R145; X} X X treeptr Xpvariable(varptr) X treeptr varptr; X{ X register treeptr R146; X treeptr tp, tq; X X nextsymbol(*((symset *)Conset[101])); X if (Member((unsigned)(currsym.st), Conset[102])) { X switch (currsym.st) { X case slpar: X tp = mknode(ncall); X tp->U.V30.tcall = varptr; X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = pexpr((treeptr)NIL); X tp->U.V30.taparm = tq; X } else { X tq->tnext = pexpr((treeptr)NIL); X tq = tq->tnext; X } X } while (!(currsym.st == srpar)); X break ; X case slbrack: X tq = varptr; X do { X tp = mknode(nindex); X tp->U.V39.tvariable = tq; X tp->U.V39.toffset = pexpr((treeptr)NIL); X tq = tp; X } while (!(currsym.st == srbrack)); X break ; X case sdot: X tp = mknode(nselect); X tp->U.V40.trecord = varptr; X nextsymbol(*((symset *)Conset[103])); X tq = typeof(varptr); X enterscope(tq->U.V21.trscope); X tp->U.V40.tfield = oldid(currsym.U.V1.vid, lfield); X leavescope(); X break ; X case sarrow: X tp = mknode(nderef); X tp->U.V42.texps = varptr; X break ; X default: X Caseerror(Line); X } X tp = pvariable(tp); X } else { X tp = varptr; X if (tp->tt == nid) { X tq = idup(tp); X if (tq != (struct S61 *)NIL) X if (Member((unsigned)(tq->tt), Conset[104])) { X tp = mknode(ncall); X tp->U.V30.tcall = varptr; X tp->U.V30.taparm = (struct S61 *)NIL; X } X } X } X R146 = tp; X return R146; X} X Xtreeptr pexpr(); X X treeptr Xpadjust(tu, tr) X treeptr tu, tr; X{ X register treeptr R148; X X if (pprio.A[(int)(tu->tt) - (int)(nassign)] >= pprio.A[(int)(tr->tt) - (int)(nassign)]) { X if (Member((unsigned)(tr->tt), Conset[105])) X tr->U.V42.texps = padjust(tu, tr->U.V42.texps); X else X tr->U.V41.texpl = padjust(tu, tr->U.V41.texpl); X R148 = tr; X } else { X if (Member((unsigned)(tu->tt), Conset[106])) X tu->U.V42.texps = tr; X else X tu->U.V41.texpr = tr; X R148 = tu; X } X return R148; X} X X treeptr Xpexpr(tnp) X treeptr tnp; X{ X register treeptr R147; X treeptr tp, tq; X treetyp nt; X boolean next; X X nextsymbol(*((symset *)Conset[107])); X next = true; X switch (currsym.st) { X case splus: X tp = mknode(nuplus); X tp->U.V42.texps = (struct S61 *)NIL; X tp = pexpr(tp); X next = false; X break ; X case sminus: X tp = mknode(numinus); X tp->U.V42.texps = (struct S61 *)NIL; X tp = pexpr(tp); X next = false; X break ; X case snot: X tp = mknode(nnot); X tp->U.V42.texps = (struct S61 *)NIL; X tp = pexpr(tp); X next = false; X break ; X case schar: case sinteger: case sreal: case sstring: X tp = mklit(); X break ; X case snil: X usenilp = true; X tp = mknode(nnil); X break ; X case sid: X tp = pvariable(oldid(currsym.U.V1.vid, lidentifier)); X next = false; X break ; X case slpar: X tp = mknode(nuplus); X tp->U.V42.texps = pexpr((treeptr)NIL); X break ; X case slbrack: X usesets = true; X tp = mknode(nset); X tp->U.V42.texps = (struct S61 *)NIL; X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = pexpr((treeptr)NIL); X tp->U.V42.texps = tq; X } else { X tq->tnext = pexpr((treeptr)NIL); X tq = tq->tnext; X } X } while (!(currsym.st == srbrack)); X break ; X case srbrack: X tp = mknode(nempty); X next = false; X break ; X default: X Caseerror(Line); X } X if (next) X nextsymbol(*((symset *)Conset[108])); X switch (currsym.st) { X case sdotdot: X nt = nrange; X break ; X case splus: X nt = nplus; X break ; X case sminus: X nt = nminus; X break ; X case smul: X nt = nmul; X break ; X case sdiv: X nt = ndiv; X break ; X case smod: X nt = nmod; X break ; X case squot: X defnams.A[(int)(dreal)]->U.V6.lused = true; X nt = nquot; X break ; X case sand: X nt = nand; X break ; X case sor: X nt = nor; X break ; X case sinn: X nt = nin; X usesets = true; X break ; X case sle: X nt = nle; X break ; X case slt: X nt = nlt; X break ; X case seq: X nt = neq; X break ; X case sge: X nt = nge; X break ; X case sgt: X nt = ngt; X break ; X case sne: X nt = nne; X break ; X case scolon: X nt = nformat; X break ; X case sid: case schar: case sinteger: case sreal: X case sstring: case snil: case ssemic: case scomma: X case slpar: case slbrack: case srpar: case srbrack: X case send: case suntil: case sthen: case selse: X case sdo: case sdownto: case sto: case sof: X nt = nnil; X break ; X default: X Caseerror(Line); X } X if (Member((unsigned)(nt), Conset[109])) X defnams.A[(int)(dboolean)]->U.V6.lused = true; X if (nt != nnil) { X tq = mknode(nt); X tq->U.V41.texpl = tp; X tq->U.V41.texpr = (struct S61 *)NIL; X tp = pexpr(tq); X } X if (tnp != (struct S61 *)NIL) X tp = padjust(tnp, tp); X R147 = tp; X return R147; X} X X treeptr Xpcase() X{ X register treeptr R149; X treeptr tp, tq, tv; X X tp = mknode(ncase); X tp->U.V35.tcasxp = pexpr((treeptr)NIL); X checksymbol(*((symset *)Conset[110])); X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = mknode(nchoise); X tp->U.V35.tcaslst = tq; X } else { X tq->tnext = mknode(nchoise); X tq = tq->tnext; X } X tv = (struct S61 *)NIL; X do { X nextsymbol(*((symset *)Conset[111])); X if (Member((unsigned)(currsym.st), Conset[112])) X goto L999; X if (tv == (struct S61 *)NIL) { X tv = pconstant(false); X tq->U.V36.tchocon = tv; X } else { X tv->tnext = pconstant(false); X tv = tv->tnext; X } X nextsymbol(*((symset *)Conset[113])); X } while (!(currsym.st == scolon)); X tq->U.V36.tchostmt = plabstmt(); X } while (!(currsym.st == send)); XL999: X if (currsym.st == sother) { X nextsymbol(*((symset *)Conset[114])); X if (currsym.st == scolon) X nextsymbol(*((symset *)Conset[115])); X tp->U.V35.tcasother = pstmt(); X } else { X tp->U.V35.tcasother = (struct S61 *)NIL; X usecase = true; X } X nextsymbol(*((symset *)Conset[116])); X R149 = tp; X return R149; X} X X treeptr Xpif() X{ X register treeptr R150; X treeptr tp; X X tp = mknode(nif); X tp->U.V31.tifxp = pexpr((treeptr)NIL); X checksymbol(*((symset *)Conset[117])); X tp->U.V31.tthen = plabstmt(); X if (currsym.st == selse) X tp->U.V31.telse = plabstmt(); X else X tp->U.V31.telse = (struct S61 *)NIL; X R150 = tp; X return R150; X} X X treeptr Xpwhile() X{ X register treeptr R151; X treeptr tp; X X tp = mknode(nwhile); X tp->U.V32.twhixp = pexpr((treeptr)NIL); X checksymbol(*((symset *)Conset[118])); X tp->U.V32.twhistmt = plabstmt(); X R151 = tp; X return R151; X} X X treeptr Xprepeat() X{ X register treeptr R152; X treeptr tp, tq; X X tp = mknode(nrepeat); X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = plabstmt(); X tp->U.V33.treptstmt = tq; X } else { X tq->tnext = plabstmt(); X tq = tq->tnext; X } X checksymbol(*((symset *)Conset[119])); X } while (!(currsym.st == suntil)); X tp->U.V33.treptxp = pexpr((treeptr)NIL); X R152 = tp; X return R152; X} X X treeptr Xpfor() X{ X register treeptr R153; X treeptr tp; X X tp = mknode(nfor); X nextsymbol(*((symset *)Conset[120])); X tp->U.V34.tforid = oldid(currsym.U.V1.vid, lidentifier); X nextsymbol(*((symset *)Conset[121])); X tp->U.V34.tfrom = pexpr((treeptr)NIL); X checksymbol(*((symset *)Conset[122])); X tp->U.V34.tincr = (boolean)(currsym.st == sto); X tp->U.V34.tto = pexpr((treeptr)NIL); X checksymbol(*((symset *)Conset[123])); X tp->U.V34.tforstmt = plabstmt(); X R153 = tp; X return R153; X} X X treeptr Xpwith() X{ X register treeptr R154; X treeptr tp, tq; X X tp = mknode(nwith); X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = mknode(nwithvar); X tp->U.V37.twithvar = tq; X } else { X tq->tnext = mknode(nwithvar); X tq = tq->tnext; X } X enterscope((declptr)NIL); X tq->U.V38.tenv = currscope(); X tq->U.V38.texpw = pexpr((treeptr)NIL); X scopeup(tq->U.V38.texpw); X checksymbol(*((symset *)Conset[124])); X } while (!(currsym.st == sdo)); X tp->U.V37.twithstmt = plabstmt(); X tq = tp->U.V37.twithvar; X while (tq != (struct S61 *)NIL) { X leavescope(); X tq = tq->tnext; X } X R154 = tp; X return R154; X} X X treeptr Xpgoto() X{ X register treeptr R155; X treeptr tp; X X nextsymbol(*((symset *)Conset[125])); X tp = mknode(ngoto); X tp->U.V26.tlabel = oldlbl(false); X nextsymbol(*((symset *)Conset[126])); X R155 = tp; X return R155; X} X X treeptr Xpbegin(retain) X boolean retain; X{ X register treeptr R156; X treeptr tp, tq; X X tq = (struct S61 *)NIL; X do { X if (tq == (struct S61 *)NIL) { X tq = plabstmt(); X tp = tq; X } else { X tq->tnext = plabstmt(); X tq = tq->tnext; X } X } while (!(currsym.st == send)); X if (retain) { X tq = mknode(nbegin); X tq->U.V24.tbegin = tp; X tp = tq; X } X nextsymbol(*((symset *)Conset[127])); X R156 = tp; X return R156; X} X X void Xparse() X{ X nextsymbol(*((symset *)Conset[128])); X if (currsym.st == spgm) X top = pprogram(); X else X top = pmodule(); X nextsymbol(*((symset *)Conset[129])); X} X X integer Xcvalof(tp) X treeptr tp; X{ X register integer R157; X integer v; X treeptr tq; X X switch (tp->tt) { X case nuplus: X R157 = cvalof(tp->U.V42.texps); X break ; X case numinus: X R157 = -cvalof(tp->U.V42.texps); X break ; X case nnot: X R157 = 1 - cvalof(tp->U.V42.texps); X break ; X case nid: X tq = idup(tp); X if (tq == (struct S61 *)NIL) X fatal(etree); X tp = tp->U.V43.tsym->lsymdecl; X switch (tq->tt) { X case nscalar: X v = 0; X tq = tq->U.V17.tscalid; X while (tq != (struct S61 *)NIL) X if (tq == tp) X tq = (struct S61 *)NIL; X else { X v = v + 1; X tq = tq->tnext; X } X R157 = v; X break ; X case nconst: X R157 = cvalof(tq->U.V14.tbind); X break ; X default: X Caseerror(Line); X } X break ; X case ninteger: X R157 = tp->U.V43.tsym->U.V10.linum; X break ; X case nchar: X R157 = (unsigned)(tp->U.V43.tsym->U.V11.lchar); X break ; X default: X Caseerror(Line); X } X return R157; X} X X integer Xclower(tp) X treeptr tp; X{ X register integer R158; X treeptr tq; X X tq = typeof(tp); X if (tq->tt == nscalar) X R158 = scalbase; X else X if (tq->tt == nsubrange) X if (tq->tup->tt == nconfarr) X R158 = 0; X else X R158 = cvalof(tq->U.V19.tlo); X else X if (tq == typnods.A[(int)(tchar)]) X R158 = 0; X else X if (tq == typnods.A[(int)(tinteger)]) X R158 = -maxint; X else X fatal(etree); X return R158; X} X X integer Xcupper(tp) X treeptr tp; X{ X register integer R159; X treeptr tq; X integer i; X X tq = typeof(tp); X if (tq->tt == nscalar) { X tq = tq->U.V17.tscalid; X i = scalbase; X while (tq->tnext != (struct S61 *)NIL) { X i = i + 1; X tq = tq->tnext; X } X R159 = i; X } else X if (tq->tt == nsubrange) X if (tq->tup->tt == nconfarr) X fatal(euprconf); X else X R159 = cvalof(tq->U.V19.thi); X else X if (tq == typnods.A[(int)(tchar)]) X R159 = maxchar; X else X if (tq == typnods.A[(int)(tinteger)]) X R159 = maxint; X else X fatal(etree); X return R159; X} X X integer Xcrange(tp) X treeptr tp; X{ X register integer R160; X X R160 = cupper(tp) - clower(tp) + 1; X return R160; X} X X integer Xcsetwords(i) X integer i; X{ X register integer R161; X X i = (i + (C37_setbits)) / (C37_setbits + 1); X if (i > maxsetrange) X error(esetsize); X R161 = i; X return R161; X} X X integer Xcsetsize(tp) X treeptr tp; X{ X register integer R162; X treeptr tq; X integer i; X X tq = typeof(tp->U.V18.tof); X i = clower(tq); X if ((i < 0) || (i >= 6 * (C37_setbits + 1))) X error(esetbase); X R162 = csetwords(crange(tq)) + 1; X return R162; X} X X boolean Xislocal(tp) X treeptr tp; X{ X register boolean R163; X treeptr tq; X X tq = tp->U.V43.tsym->lsymdecl; X while (!(Member((unsigned)(tq->tt), Conset[130]))) X tq = tq->tup; X while (!(Member((unsigned)(tp->tt), Conset[131]))) X tp = tp->tup; X R163 = (boolean)(tp == tq); X return R163; X} X Xvoid transform(); X Xvoid renamf(); X X void Xcrtnvar(tp) X treeptr tp; X{ X while (tp != (struct S61 *)NIL) { X switch (tp->tt) { X case npgm: X crtnvar(tp->U.V13.tsubsub); X break ; X case nfunc: case nproc: X crtnvar(tp->U.V13.tsubsub); X crtnvar(tp->U.V13.tsubstmt); X break ; X case nbegin: X crtnvar(tp->U.V24.tbegin); X break ; X case nif: X crtnvar(tp->U.V31.tthen); X crtnvar(tp->U.V31.telse); X break ; X case nwhile: X crtnvar(tp->U.V32.twhistmt); X break ; X case nrepeat: X crtnvar(tp->U.V33.treptstmt); X break ; X case nfor: X crtnvar(tp->U.V34.tforstmt); X break ; X case ncase: X crtnvar(tp->U.V35.tcaslst); X crtnvar(tp->U.V35.tcasother); X break ; X case nchoise: X crtnvar(tp->U.V36.tchostmt); X break ; X case nwith: X crtnvar(tp->U.V37.twithstmt); X break ; X case nlabstmt: X crtnvar(tp->U.V25.tstmt); X break ; X case nassign: X if (tp->U.V27.tlhs->tt == ncall) { X tp->U.V27.tlhs = tp->U.V27.tlhs->U.V30.tcall; X tp->U.V27.tlhs->tup = tp; X } X (*G187_tv) = tp->U.V27.tlhs; X if ((*G187_tv)->tt == nid) X if ((*G187_tv)->U.V43.tsym == (*G183_ip)) X (*G187_tv)->U.V43.tsym = (*G185_iq); X break ; X case nbreak: case npush: case npop: case ngoto: X case nempty: case ncall: X break ; X default: X Caseerror(Line); X } X tp = tp->tnext; X } X} X X void Xrenamf(tp) X treeptr tp; X{ X symptr ip, iq; X treeptr tq, tv; X symptr *F184; X symptr *F186; X treeptr *F188; X X F188 = G187_tv; X G187_tv = &tv; X F186 = G185_iq; X G185_iq = &iq; X F184 = G183_ip; X G183_ip = &ip; X while (tp != (struct S61 *)NIL) { X switch (tp->tt) { X case npgm: case nproc: X renamf(tp->U.V13.tsubsub); X break ; X case nfunc: X tq = mknode(nvar); X tq->U.V14.tattr = aregister; X tq->tup = tp; X tq->U.V14.tidl = newid(mkvariable('R')); X tq->U.V14.tidl->tup = tq; X tq->U.V14.tbind = tp->U.V13.tfuntyp; X tq->tnext = tp->U.V13.tsubvar; X tp->U.V13.tsubvar = tq; X (*G185_iq) = tq->U.V14.tidl->U.V43.tsym; X (*G183_ip) = tp->U.V13.tsubid->U.V43.tsym; X crtnvar(tp->U.V13.tsubsub); X crtnvar(tp->U.V13.tsubstmt); X renamf(tp->U.V13.tsubsub); X break ; X default: X Caseerror(Line); X } X tp = tp->tnext; X } X G183_ip = F184; X G185_iq = F186; X G187_tv = F188; X} X Xvoid extract(); X X treeptr Xxtrit(tp, pp, last) X treeptr tp, pp; X boolean last; X{ X register treeptr R164; X treeptr np, rp; X idptr ip; X X np = mknode(ntype); X ip = mkvariable('T'); X np->U.V14.tidl = newid(ip); X np->U.V14.tidl->tup = np; X rp = oldid(ip, lidentifier); X rp->tup = tp->tup; X rp->tnext = tp->tnext; X np->U.V14.tbind = tp; X tp->tup = np; X tp->tnext = (struct S61 *)NIL; X np->tup = pp; X if (last && (pp->U.V13.tsubtype != (struct S61 *)NIL)) { X pp = pp->U.V13.tsubtype; X while (pp->tnext != (struct S61 *)NIL) X pp = pp->tnext; X pp->tnext = np; X } else { X np->tnext = pp->U.V13.tsubtype; X pp->U.V13.tsubtype = np; X } X R164 = rp; X return R164; X} X Xtreeptr xtrenum(); X X void Xnametype(tp) X treeptr tp; X{ X tp = typeof(tp); X if (tp->tt == nrecord) X if (tp->U.V21.tuid == (struct S59 *)NIL) X tp->U.V21.tuid = mkvariable('S'); X} X X treeptr Xxtrenum(tp, pp) X treeptr tp, pp; X{ X register treeptr R165; X X if (tp != (struct S61 *)NIL) { X switch (tp->tt) { X case nfield: case ntype: case nvar: X tp->U.V14.tbind = xtrenum(tp->U.V14.tbind, pp); X break ; X case nscalar: X if (tp->tup->tt != ntype) X tp = xtrit(tp, pp, false); X break ; X case narray: X tp->U.V23.taindx = xtrenum(tp->U.V23.taindx, pp); X tp->U.V23.taelem = xtrenum(tp->U.V23.taelem, pp); X break ; X case nrecord: X tp->U.V21.tflist = xtrenum(tp->U.V21.tflist, pp); X tp->U.V21.tvlist = xtrenum(tp->U.V21.tvlist, pp); X break ; X case nvariant: X tp->U.V20.tvrnt = xtrenum(tp->U.V20.tvrnt, pp); X break ; X case nfileof: X tp->U.V18.tof = xtrenum(tp->U.V18.tof, pp); X break ; X case nptr: X nametype(tp->U.V16.tptrid); X break ; X case nid: case nsubrange: case npredef: case nempty: X case nsetof: X break ; X default: X Caseerror(Line); X } X tp->tnext = xtrenum(tp->tnext, pp); X } X R165 = tp; X return R165; X} X X void Xextract(tp) X treeptr tp; X{ X treeptr vp; X X while (tp != (struct S61 *)NIL) { X tp->U.V13.tsubtype = xtrenum(tp->U.V13.tsubtype, tp); X tp->U.V13.tsubvar = xtrenum(tp->U.V13.tsubvar, tp); X vp = tp->U.V13.tsubvar; X while (vp != (struct S61 *)NIL) { X if (Member((unsigned)(vp->U.V14.tbind->tt), Conset[132])) X vp->U.V14.tbind = xtrit(vp->U.V14.tbind, tp, true); X vp = vp->tnext; X } X extract(tp->U.V13.tsubsub); X tp = tp->tnext; X } X} X Xvoid global(); X X void Xmarkdecl(xp) X treeptr xp; X{ X while (xp != (struct S61 *)NIL) { X switch (xp->tt) { X case nid: X xp->U.V43.tsym->U.V6.lused = false; X break ; X case nconst: X markdecl(xp->U.V14.tidl); X break ; X case ntype: case nvar: case nvalpar: case nvarpar: X case nfield: X markdecl(xp->U.V14.tidl); X if (xp->U.V14.tbind->tt != nid) X markdecl(xp->U.V14.tbind); X break ; X case nscalar: X markdecl(xp->U.V17.tscalid); X break ; X case nrecord: X markdecl(xp->U.V21.tflist); X markdecl(xp->U.V21.tvlist); X break ; X case nvariant: X markdecl(xp->U.V20.tvrnt); X break ; X case nconfarr: X if (xp->U.V22.tcelem->tt != nid) X markdecl(xp->U.V22.tcelem); X break ; X case narray: X if (xp->U.V23.taelem->tt != nid) X markdecl(xp->U.V23.taelem); X break ; X case nsetof: case nfileof: X if (xp->U.V18.tof->tt != nid) X markdecl(xp->U.V18.tof); X break ; X case nparproc: case nparfunc: X markdecl(xp->U.V15.tparid); X break ; X case nptr: case nsubrange: X break ; X default: X Caseerror(Line); X } X xp = xp->tnext; X } X} X X treeptr Xmovedecl(tp) X treeptr tp; X{ X register treeptr R166; X treeptr ip, np; X symptr sp; X boolean move; X X if (tp != (struct S61 *)NIL) { X move = false; X switch (tp->tt) { X case nconst: case ntype: X ip = tp->U.V14.tidl; X break ; X default: X Caseerror(Line); X } X while (ip != (struct S61 *)NIL) { X if (ip->U.V43.tsym->U.V6.lused) { X move = true; X sp = ip->U.V43.tsym; X if (sp->U.V6.lid->inref > 1) { X sp->U.V6.lid = mkrename('M', sp->U.V6.lid); X sp->U.V6.lid->inref = sp->U.V6.lid->inref - 1; X } X ip = (struct S61 *)NIL; X } else X ip = ip->tnext; X } X if (move) { X np = tp->tnext; X tp->tnext = (struct S61 *)NIL; X ip = tp; X while (ip->tt != npgm) X ip = ip->tup; X tp->tup = ip; X switch (tp->tt) { X case nconst: X if (ip->U.V13.tsubconst == (struct S61 *)NIL) X ip->U.V13.tsubconst = tp; X else { X ip = ip->U.V13.tsubconst; X while (ip->tnext != (struct S61 *)NIL) X ip = ip->tnext; X ip->tnext = tp; X } X break ; X case ntype: X if (ip->U.V13.tsubtype == (struct S61 *)NIL) X ip->U.V13.tsubtype = tp; X else { X ip = ip->U.V13.tsubtype; X while (ip->tnext != (struct S61 *)NIL) X ip = ip->tnext; X ip->tnext = tp; X } X break ; X default: X Caseerror(Line); X } X tp = movedecl(np); X } else X tp->tnext = movedecl(tp->tnext); X } X R166 = tp; X return R166; X} X Xvoid movevars(); X X void Xmoveglob(tp, dp) X treeptr tp, dp; X{ X while (tp->tt != npgm) X tp = tp->tup; X dp->tup = tp; X dp->tnext = tp->U.V13.tsubvar; X tp->U.V13.tsubvar = dp; X} X X treeptr Xstackop(decl, glob, loc) X treeptr decl, glob, loc; X{ X register treeptr R167; X treeptr op, ip, dp, tp; X X ip = newid(mkvariable('F')); X switch ((*G189_vp)->tt) { X case nvarpar: case nvalpar: case nvar: X dp = mknode(nvarpar); X dp->U.V14.tattr = areference; X dp->U.V14.tidl = ip; X dp->U.V14.tbind = decl->U.V14.tbind; X break ; X case nparproc: case nparfunc: X dp = mknode((*G189_vp)->tt); X dp->U.V15.tparid = ip; X dp->U.V15.tparparm = (struct S61 *)NIL; X dp->U.V15.tpartyp = (*G189_vp)->U.V15.tpartyp; X break ; X default: X Caseerror(Line); X } X ip->tup = dp; X tp = decl; X while (!(Member((unsigned)(tp->tt), Conset[133]))) X tp = tp->tup; X dp->tup = tp; X if (tp->U.V13.tsubvar == (struct S61 *)NIL) X tp->U.V13.tsubvar = dp; X else { X tp = tp->U.V13.tsubvar; X while (tp->tnext != (struct S61 *)NIL) X tp = tp->tnext; X tp->tnext = dp; X } X dp->tnext = (struct S61 *)NIL; X op = mknode(npush); X op->U.V28.tglob = glob; X op->U.V28.tloc = loc; X op->U.V28.ttmp = ip; X R167 = op; X return R167; X} X X void Xaddcode(tp, push) X treeptr tp, push; X{ X treeptr pop; X X pop = mknode(npop); X pop->U.V28.tglob = push->U.V28.tglob; X pop->U.V28.ttmp = push->U.V28.ttmp; X pop->U.V28.tloc = (struct S61 *)NIL; X push->tnext = tp->U.V13.tsubstmt; X tp->U.V13.tsubstmt = push; X push->tup = tp; X while (push->tnext != (struct S61 *)NIL) X push = push->tnext; X push->tnext = pop; X pop->tup = tp; X} X X void Xmovevars(tp, vp) X treeptr tp, vp; X{ X treeptr ep, dp, np; X idptr ip; X symptr sp; X treeptr *F190; X X F190 = G189_vp; X G189_vp = &vp; X while ((*G189_vp) != (struct S61 *)NIL) { X switch ((*G189_vp)->tt) { X case nvar: case nvalpar: case nvarpar: X dp = (*G189_vp)->U.V14.tidl; X break ; X case nparproc: case nparfunc: X dp = (*G189_vp)->U.V15.tparid; X if (dp->U.V43.tsym->U.V6.lused) { X ep = mknode((*G189_vp)->tt); X ep->U.V15.tparparm = (struct S61 *)NIL; X ep->U.V15.tpartyp = (*G189_vp)->U.V15.tpartyp; X np = newid(mkrename('G', dp->U.V43.tsym->U.V6.lid)); X ep->U.V15.tparid = np; X np->tup = ep; X sp = np->U.V43.tsym; X ip = sp->U.V6.lid; X np->U.V43.tsym->U.V6.lid = dp->U.V43.tsym->U.V6.lid; X dp->U.V43.tsym->U.V6.lid = ip; X np->U.V43.tsym = dp->U.V43.tsym; X dp->U.V43.tsym = sp; X np->U.V43.tsym->lsymdecl = np; X dp->U.V43.tsym->lsymdecl = dp; X moveglob(tp, ep); X addcode(tp, stackop((*G189_vp), np, dp)); X } X goto L555; X break ; X default: X Caseerror(Line); X } X while (dp != (struct S61 *)NIL) { X if (dp->U.V43.tsym->U.V6.lused) { X ep = mknode(nvarpar); X ep->U.V14.tattr = areference; X np = newid(mkrename('G', dp->U.V43.tsym->U.V6.lid)); X ep->U.V14.tidl = np; X np->tup = ep; X ep->U.V14.tbind = (*G189_vp)->U.V14.tbind; X if (ep->U.V14.tbind->tt == nid) X ep->U.V14.tbind->U.V43.tsym->U.V6.lused = true; X sp = np->U.V43.tsym; X ip = sp->U.V6.lid; X np->U.V43.tsym->U.V6.lid = dp->U.V43.tsym->U.V6.lid; X dp->U.V43.tsym->U.V6.lid = ip; X np->U.V43.tsym = dp->U.V43.tsym; X dp->U.V43.tsym = sp; X np->U.V43.tsym->lsymdecl = np; X dp->U.V43.tsym->lsymdecl = dp; X dp->tup->U.V14.tattr = aextern; X moveglob(tp, ep); X addcode(tp, stackop((*G189_vp), np, dp)); X } X dp = dp->tnext; X } X L555: X (*G189_vp) = (*G189_vp)->tnext; X } X G189_vp = F190; X} X X void Xregistervar(tp) X treeptr tp; X{ X treeptr vp, xp; X X vp = idup(tp); X tp = tp->U.V43.tsym->lsymdecl; X if ((vp->U.V14.tidl != tp) || (tp->tnext != (struct S61 *)NIL)) { X xp = mknode(nvar); X xp->U.V14.tattr = anone; X xp->U.V14.tidl = tp; X tp->tup = xp; X xp->tup = vp->tup; X xp->U.V14.tbind = vp->U.V14.tbind; X xp->tnext = vp->tnext; X vp->tnext = xp; X if (vp->U.V14.tidl == tp) X vp->U.V14.tidl = tp->tnext; X else { X vp = vp->U.V14.tidl; X while (vp->tnext != tp) X vp = vp->tnext; X vp->tnext = tp->tnext; X } X tp->tnext = (struct S61 *)NIL; X } X if (tp->tup->U.V14.tattr == anone) X tp->tup->U.V14.tattr = aregister; X} X X void Xcklevel(tp) X treeptr tp; X{ X tp = tp->U.V43.tsym->lsymdecl; X while (!(Member((unsigned)(tp->tt), Conset[134]))) X tp = tp->tup; X if (tp->U.V13.tstat > maxlevel) X maxlevel = tp->U.V13.tstat; X} X X void Xglobal(tp, dp, depend) X treeptr tp, dp; X boolean depend; X{ X treeptr ip; X boolean dep; X X while (tp != (struct S61 *)NIL) { X switch (tp->tt) { X case nproc: case nfunc: X markdecl(tp->U.V13.tsubid); X markdecl(tp->U.V13.tsubpar); X markdecl(tp->U.V13.tsubconst); X markdecl(tp->U.V13.tsubtype); X markdecl(tp->U.V13.tsubvar); X global(tp->U.V13.tsubsub, tp, false); X movevars(tp, tp->U.V13.tsubpar); X movevars(tp, tp->U.V13.tsubvar); X tp->U.V13.tsubtype = movedecl(tp->U.V13.tsubtype); X tp->U.V13.tsubconst = movedecl(tp->U.V13.tsubconst); X global(tp->U.V13.tsubstmt, tp, true); X global(tp->U.V13.tsubpar, tp, false); X global(tp->U.V13.tsubvar, tp, false); X global(tp->U.V13.tsubtype, tp, false); X global(tp->U.V13.tfuntyp, tp, false); X break ; X case npgm: X markdecl(tp->U.V13.tsubconst); X markdecl(tp->U.V13.tsubtype); X markdecl(tp->U.V13.tsubvar); X global(tp->U.V13.tsubsub, tp, false); X global(tp->U.V13.tsubstmt, tp, true); X break ; X case nconst: case ntype: case nvar: case nfield: X case nvalpar: case nvarpar: X ip = tp->U.V14.tidl; X dep = depend; X while ((ip != (struct S61 *)NIL) && !dep) { X if (ip->U.V43.tsym->U.V6.lused) X dep = true; X ip = ip->tnext; X } X global(tp->U.V14.tbind, dp, dep); X break ; X case nparproc: case nparfunc: X global(tp->U.V15.tparparm, dp, depend); X global(tp->U.V15.tpartyp, dp, depend); X break ; X case nsubrange: X global(tp->U.V19.tlo, dp, depend); X global(tp->U.V19.thi, dp, depend); X break ; X case nvariant: X global(tp->U.V20.tselct, dp, depend); X global(tp->U.V20.tvrnt, dp, depend); X break ; X case nrecord: X global(tp->U.V21.tflist, dp, depend); X global(tp->U.V21.tvlist, dp, depend); X break ; X case nconfarr: X global(tp->U.V22.tcindx, dp, depend); X global(tp->U.V22.tcelem, dp, depend); X break ; X case narray: X global(tp->U.V23.taindx, dp, depend); X global(tp->U.V23.taelem, dp, depend); X break ; X case nfileof: case nsetof: X global(tp->U.V18.tof, dp, depend); X break ; X case nptr: X global(tp->U.V16.tptrid, dp, depend); X break ; X case nscalar: X global(tp->U.V17.tscalid, dp, depend); X break ; X case nbegin: X global(tp->U.V24.tbegin, dp, depend); X break ; X case nif: X global(tp->U.V31.tifxp, dp, depend); X global(tp->U.V31.tthen, dp, depend); X global(tp->U.V31.telse, dp, depend); X break ; X case nwhile: X global(tp->U.V32.twhixp, dp, depend); X global(tp->U.V32.twhistmt, dp, depend); X break ; X case nrepeat: X global(tp->U.V33.treptstmt, dp, depend); X global(tp->U.V33.treptxp, dp, depend); X break ; X case nfor: X ip = idup(tp->U.V34.tforid); X if (Member((unsigned)(ip->tup->tt), Conset[135])) X registervar(tp->U.V34.tforid); X global(tp->U.V34.tforid, dp, depend); X global(tp->U.V34.tfrom, dp, depend); X global(tp->U.V34.tto, dp, depend); X global(tp->U.V34.tforstmt, dp, depend); X break ; X case ncase: X global(tp->U.V35.tcasxp, dp, depend); X global(tp->U.V35.tcaslst, dp, depend); X global(tp->U.V35.tcasother, dp, depend); X break ; X case nchoise: X global(tp->U.V36.tchocon, dp, depend); X global(tp->U.V36.tchostmt, dp, depend); X break ; X case nwith: X global(tp->U.V37.twithvar, dp, depend); X global(tp->U.V37.twithstmt, dp, depend); X break ; X case nwithvar: X ip = typeof(tp->U.V38.texpw); X if (ip->U.V21.tuid == (struct S59 *)NIL) X ip->U.V21.tuid = mkvariable('S'); X global(tp->U.V38.texpw, dp, depend); X break ; X case nlabstmt: X global(tp->U.V25.tstmt, dp, depend); X break ; X case neq: case nne: case nlt: case nle: X case ngt: case nge: X global(tp->U.V41.texpl, dp, depend); X X global(tp->U.V41.texpr, dp, depend); X ip = typeof(tp->U.V41.texpl); X if ((ip == typnods.A[(int)(tstring)]) || (ip->tt == narray)) X usecomp = true; X ip = typeof(tp->U.V41.texpr); X if ((ip == typnods.A[(int)(tstring)]) || (ip->tt == narray)) X usecomp = true; X break ; X case nin: case nor: case nplus: case nminus: X case nand: case nmul: case ndiv: case nmod: X case nquot: case nformat: case nrange: X global(tp->U.V41.texpl, dp, depend); X global(tp->U.V41.texpr, dp, depend); X break ; X case nassign: X global(tp->U.V27.tlhs, dp, depend); X global(tp->U.V27.trhs, dp, depend); X break ; X case nnot: case numinus: case nuplus: case nderef: X global(tp->U.V42.texps, dp, depend); X break ; X case nset: X global(tp->U.V42.texps, dp, depend); X break ; X case nindex: X global(tp->U.V39.tvariable, dp, depend); X global(tp->U.V39.toffset, dp, depend); X break ; X case nselect: X global(tp->U.V40.trecord, dp, depend); X break ; X case ncall: X global(tp->U.V30.tcall, dp, depend); X global(tp->U.V30.taparm, dp, depend); X break ; X case nid: X ip = idup(tp); X if (ip == (struct S61 *)NIL) X goto L555; X do { X ip = ip->tup; X if (ip == (struct S61 *)NIL) X goto L555; X } while (!(Member((unsigned)(ip->tt), Conset[136]))); X if (dp == ip) { X if (depend) X tp->U.V43.tsym->U.V6.lused = true; X } else { X tp->U.V43.tsym->U.V6.lused = true; X } X L555: X ; X break ; X case ngoto: X if (!islocal(tp->U.V26.tlabel)) { X tp->U.V26.tlabel->U.V43.tsym->U.V9.lgo = true; X usejmps = true; X cklevel(tp->U.V26.tlabel); X } X break ; X case nbreak: case npush: case npop: case npredef: X case nempty: case nchar: case ninteger: case nreal: X case nstring: case nnil: X break ; X default: X Caseerror(Line); X } X tp = tp->tnext; X } X} X X void Xrenamc() X{ X idptr ip; X register cnames cn; X X { X cnames B49 = cabort, X B50 = cwrite; X X if ((int)(B49) <= (int)(B50)) X for (cn = B49; ; cn = (cnames)((int)(cn)+1)) { X ip = mkrename('C', ctable.A[(int)(cn)]); X ctable.A[(int)(cn)]->istr = ip->istr; X if (cn == B50) break; X } X } X} X X void Xrenamp(tp, on) X treeptr tp; X boolean on; X{ X symptr sp; X X while (tp != (struct S61 *)NIL) { END_OF_FILE if test 30864 -ne `wc -c <'ptc.c.3'`; then echo shar: \"'ptc.c.3'\" unpacked with wrong size! fi # end of 'ptc.c.3' fi echo shar: End of archive 2 \(of 12\). cp /dev/null ark2isdone 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