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