home *** CD-ROM | disk | FTP | other *** search
Text File | 1987-07-26 | 30.1 KB | 1,501 lines |
- break ;
- default:
- Caseerror(Line);
- }
- nextsymbol(*((symset *)Conset[91]));
- break ;
- case nparproc:
- tq->U.V15.tparid = newid(currsym.U.V1.vid);
- nextsymbol(*((symset *)Conset[92]));
- if (currsym.st == slpar) {
- enterscope((declptr)NIL);
- tq->U.V15.tparparm = psubpar();
- nextsymbol(*((symset *)Conset[93]));
- leavescope();
- } else
- tq->U.V15.tparparm = (struct S61 *)NIL;
- tq->U.V15.tpartyp = (struct S61 *)NIL;
- break ;
- case nparfunc:
- tq->U.V15.tparid = newid(currsym.U.V1.vid);
- nextsymbol(*((symset *)Conset[94]));
- if (currsym.st == slpar) {
- enterscope((declptr)NIL);
- tq->U.V15.tparparm = psubpar();
- nextsymbol(*((symset *)Conset[95]));
- leavescope();
- } else
- tq->U.V15.tparparm = (struct S61 *)NIL;
- nextsymbol(*((symset *)Conset[96]));
- tq->U.V15.tpartyp = oldid(currsym.U.V1.vid, lidentifier);
- nextsymbol(*((symset *)Conset[97]));
- break ;
- default:
- Caseerror(Line);
- }
- } while (!(currsym.st == srpar));
- R142 = tp;
- return R142;
- }
-
- treeptr
- plabstmt()
- {
- register treeptr R143;
- treeptr tp;
-
- nextsymbol(*((symset *)Conset[98]));
- if (currsym.st == sinteger) {
- tp = mknode(nlabstmt);
- tp->U.V25.tlabno = oldlbl(true);
- nextsymbol(*((symset *)Conset[99]));
- nextsymbol(*((symset *)Conset[100]));
- tp->U.V25.tstmt = pstmt();
- } else
- tp = pstmt();
- R143 = tp;
- return R143;
- }
-
- treeptr
- pstmt()
- {
- register treeptr R144;
- treeptr tp;
-
- switch (currsym.st) {
- case sid:
- tp = psimple();
- break ;
- case sif:
- tp = pif();
- break ;
- case swhile:
- tp = pwhile();
- break ;
- case srepeat:
- tp = prepeat();
- break ;
- case sfor:
- tp = pfor();
- break ;
- case scase:
- tp = pcase();
- break ;
- case swith:
- tp = pwith();
- break ;
- case sbegin:
- tp = pbegin(true);
- break ;
- case sgoto:
- tp = pgoto();
- break ;
- case send: case selse: case suntil: case ssemic:
- tp = mknode(nempty);
- break ;
- default:
- Caseerror(Line);
- }
- R144 = tp;
- return R144;
- }
-
- treeptr
- psimple()
- {
- register treeptr R145;
- treeptr tq, tp;
-
- tp = pvariable(oldid(currsym.U.V1.vid, lidentifier));
- if (currsym.st == sassign) {
- tq = mknode(nassign);
- tq->U.V27.tlhs = tp;
- tq->U.V27.trhs = pexpr((treeptr)NIL);
- tp = tq;
- }
- R145 = tp;
- return R145;
- }
-
- treeptr
- pvariable(varptr)
- treeptr varptr;
- {
- register treeptr R146;
- treeptr tp, tq;
-
- nextsymbol(*((symset *)Conset[101]));
- if (Member((unsigned)(currsym.st), Conset[102])) {
- switch (currsym.st) {
- case slpar:
- tp = mknode(ncall);
- tp->U.V30.tcall = varptr;
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = pexpr((treeptr)NIL);
- tp->U.V30.taparm = tq;
- } else {
- tq->tnext = pexpr((treeptr)NIL);
- tq = tq->tnext;
- }
- } while (!(currsym.st == srpar));
- break ;
- case slbrack:
- tq = varptr;
- do {
- tp = mknode(nindex);
- tp->U.V39.tvariable = tq;
- tp->U.V39.toffset = pexpr((treeptr)NIL);
- tq = tp;
- } while (!(currsym.st == srbrack));
- break ;
- case sdot:
- tp = mknode(nselect);
- tp->U.V40.trecord = varptr;
- nextsymbol(*((symset *)Conset[103]));
- tq = typeof(varptr);
- enterscope(tq->U.V21.trscope);
- tp->U.V40.tfield = oldid(currsym.U.V1.vid, lfield);
- leavescope();
- break ;
- case sarrow:
- tp = mknode(nderef);
- tp->U.V42.texps = varptr;
- break ;
- default:
- Caseerror(Line);
- }
- tp = pvariable(tp);
- } else {
- tp = varptr;
- if (tp->tt == nid) {
- tq = idup(tp);
- if (tq != (struct S61 *)NIL)
- if (Member((unsigned)(tq->tt), Conset[104])) {
- tp = mknode(ncall);
- tp->U.V30.tcall = varptr;
- tp->U.V30.taparm = (struct S61 *)NIL;
- }
- }
- }
- R146 = tp;
- return R146;
- }
-
- treeptr pexpr();
-
- treeptr
- padjust(tu, tr)
- treeptr tu, tr;
- {
- register treeptr R148;
-
- if (pprio.A[(int)(tu->tt) - (int)(nassign)] >= pprio.A[(int)(tr->tt) - (int)(nassign)]) {
- if (Member((unsigned)(tr->tt), Conset[105]))
- tr->U.V42.texps = padjust(tu, tr->U.V42.texps);
- else
- tr->U.V41.texpl = padjust(tu, tr->U.V41.texpl);
- R148 = tr;
- } else {
- if (Member((unsigned)(tu->tt), Conset[106]))
- tu->U.V42.texps = tr;
- else
- tu->U.V41.texpr = tr;
- R148 = tu;
- }
- return R148;
- }
-
- treeptr
- pexpr(tnp)
- treeptr tnp;
- {
- register treeptr R147;
- treeptr tp, tq;
- treetyp nt;
- boolean next;
-
- nextsymbol(*((symset *)Conset[107]));
- next = true;
- switch (currsym.st) {
- case splus:
- tp = mknode(nuplus);
- tp->U.V42.texps = (struct S61 *)NIL;
- tp = pexpr(tp);
- next = false;
- break ;
- case sminus:
- tp = mknode(numinus);
- tp->U.V42.texps = (struct S61 *)NIL;
- tp = pexpr(tp);
- next = false;
- break ;
- case snot:
- tp = mknode(nnot);
- tp->U.V42.texps = (struct S61 *)NIL;
- tp = pexpr(tp);
- next = false;
- break ;
- case schar: case sinteger: case sreal: case sstring:
- tp = mklit();
- break ;
- case snil:
- usenilp = true;
- tp = mknode(nnil);
- break ;
- case sid:
- tp = pvariable(oldid(currsym.U.V1.vid, lidentifier));
- next = false;
- break ;
- case slpar:
- tp = mknode(nuplus);
- tp->U.V42.texps = pexpr((treeptr)NIL);
- break ;
- case slbrack:
- usesets = true;
- tp = mknode(nset);
- tp->U.V42.texps = (struct S61 *)NIL;
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = pexpr((treeptr)NIL);
- tp->U.V42.texps = tq;
- } else {
- tq->tnext = pexpr((treeptr)NIL);
- tq = tq->tnext;
- }
- } while (!(currsym.st == srbrack));
- break ;
- case srbrack:
- tp = mknode(nempty);
- next = false;
- break ;
- default:
- Caseerror(Line);
- }
- if (next)
- nextsymbol(*((symset *)Conset[108]));
- switch (currsym.st) {
- case sdotdot:
- nt = nrange;
- break ;
- case splus:
- nt = nplus;
- break ;
- case sminus:
- nt = nminus;
- break ;
- case smul:
- nt = nmul;
- break ;
- case sdiv:
- nt = ndiv;
- break ;
- case smod:
- nt = nmod;
- break ;
- case squot:
- defnams.A[(int)(dreal)]->U.V6.lused = true;
- nt = nquot;
- break ;
- case sand:
- nt = nand;
- break ;
- case sor:
- nt = nor;
- break ;
- case sinn:
- nt = nin;
- usesets = true;
- break ;
- case sle:
- nt = nle;
- break ;
- case slt:
- nt = nlt;
- break ;
- case seq:
- nt = neq;
- break ;
- case sge:
- nt = nge;
- break ;
- case sgt:
- nt = ngt;
- break ;
- case sne:
- nt = nne;
- break ;
- case scolon:
- nt = nformat;
- break ;
- case sid: case schar: case sinteger: case sreal:
- case sstring: case snil: case ssemic: case scomma:
- case slpar: case slbrack: case srpar: case srbrack:
- case send: case suntil: case sthen: case selse:
- case sdo: case sdownto: case sto: case sof:
- nt = nnil;
- break ;
- default:
- Caseerror(Line);
- }
- if (Member((unsigned)(nt), Conset[109]))
- defnams.A[(int)(dboolean)]->U.V6.lused = true;
- if (nt != nnil) {
- tq = mknode(nt);
- tq->U.V41.texpl = tp;
- tq->U.V41.texpr = (struct S61 *)NIL;
- tp = pexpr(tq);
- }
- if (tnp != (struct S61 *)NIL)
- tp = padjust(tnp, tp);
- R147 = tp;
- return R147;
- }
-
- treeptr
- pcase()
- {
- register treeptr R149;
- treeptr tp, tq, tv;
-
- tp = mknode(ncase);
- tp->U.V35.tcasxp = pexpr((treeptr)NIL);
- checksymbol(*((symset *)Conset[110]));
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = mknode(nchoise);
- tp->U.V35.tcaslst = tq;
- } else {
- tq->tnext = mknode(nchoise);
- tq = tq->tnext;
- }
- tv = (struct S61 *)NIL;
- do {
- nextsymbol(*((symset *)Conset[111]));
- if (Member((unsigned)(currsym.st), Conset[112]))
- goto L999;
- if (tv == (struct S61 *)NIL) {
- tv = pconstant(false);
- tq->U.V36.tchocon = tv;
- } else {
- tv->tnext = pconstant(false);
- tv = tv->tnext;
- }
- nextsymbol(*((symset *)Conset[113]));
- } while (!(currsym.st == scolon));
- tq->U.V36.tchostmt = plabstmt();
- } while (!(currsym.st == send));
- L999:
- if (currsym.st == sother) {
- nextsymbol(*((symset *)Conset[114]));
- if (currsym.st == scolon)
- nextsymbol(*((symset *)Conset[115]));
- tp->U.V35.tcasother = pstmt();
- } else {
- tp->U.V35.tcasother = (struct S61 *)NIL;
- usecase = true;
- }
- nextsymbol(*((symset *)Conset[116]));
- R149 = tp;
- return R149;
- }
-
- treeptr
- pif()
- {
- register treeptr R150;
- treeptr tp;
-
- tp = mknode(nif);
- tp->U.V31.tifxp = pexpr((treeptr)NIL);
- checksymbol(*((symset *)Conset[117]));
- tp->U.V31.tthen = plabstmt();
- if (currsym.st == selse)
- tp->U.V31.telse = plabstmt();
- else
- tp->U.V31.telse = (struct S61 *)NIL;
- R150 = tp;
- return R150;
- }
-
- treeptr
- pwhile()
- {
- register treeptr R151;
- treeptr tp;
-
- tp = mknode(nwhile);
- tp->U.V32.twhixp = pexpr((treeptr)NIL);
- checksymbol(*((symset *)Conset[118]));
- tp->U.V32.twhistmt = plabstmt();
- R151 = tp;
- return R151;
- }
-
- treeptr
- prepeat()
- {
- register treeptr R152;
- treeptr tp, tq;
-
- tp = mknode(nrepeat);
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = plabstmt();
- tp->U.V33.treptstmt = tq;
- } else {
- tq->tnext = plabstmt();
- tq = tq->tnext;
- }
- checksymbol(*((symset *)Conset[119]));
- } while (!(currsym.st == suntil));
- tp->U.V33.treptxp = pexpr((treeptr)NIL);
- R152 = tp;
- return R152;
- }
-
- treeptr
- pfor()
- {
- register treeptr R153;
- treeptr tp;
-
- tp = mknode(nfor);
- nextsymbol(*((symset *)Conset[120]));
- tp->U.V34.tforid = oldid(currsym.U.V1.vid, lidentifier);
- nextsymbol(*((symset *)Conset[121]));
- tp->U.V34.tfrom = pexpr((treeptr)NIL);
- checksymbol(*((symset *)Conset[122]));
- tp->U.V34.tincr = (boolean)(currsym.st == sto);
- tp->U.V34.tto = pexpr((treeptr)NIL);
- checksymbol(*((symset *)Conset[123]));
- tp->U.V34.tforstmt = plabstmt();
- R153 = tp;
- return R153;
- }
-
- treeptr
- pwith()
- {
- register treeptr R154;
- treeptr tp, tq;
-
- tp = mknode(nwith);
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = mknode(nwithvar);
- tp->U.V37.twithvar = tq;
- } else {
- tq->tnext = mknode(nwithvar);
- tq = tq->tnext;
- }
- enterscope((declptr)NIL);
- tq->U.V38.tenv = currscope();
- tq->U.V38.texpw = pexpr((treeptr)NIL);
- scopeup(tq->U.V38.texpw);
- checksymbol(*((symset *)Conset[124]));
- } while (!(currsym.st == sdo));
- tp->U.V37.twithstmt = plabstmt();
- tq = tp->U.V37.twithvar;
- while (tq != (struct S61 *)NIL) {
- leavescope();
- tq = tq->tnext;
- }
- R154 = tp;
- return R154;
- }
-
- treeptr
- pgoto()
- {
- register treeptr R155;
- treeptr tp;
-
- nextsymbol(*((symset *)Conset[125]));
- tp = mknode(ngoto);
- tp->U.V26.tlabel = oldlbl(false);
- nextsymbol(*((symset *)Conset[126]));
- R155 = tp;
- return R155;
- }
-
- treeptr
- pbegin(retain)
- boolean retain;
- {
- register treeptr R156;
- treeptr tp, tq;
-
- tq = (struct S61 *)NIL;
- do {
- if (tq == (struct S61 *)NIL) {
- tq = plabstmt();
- tp = tq;
- } else {
- tq->tnext = plabstmt();
- tq = tq->tnext;
- }
- } while (!(currsym.st == send));
- if (retain) {
- tq = mknode(nbegin);
- tq->U.V24.tbegin = tp;
- tp = tq;
- }
- nextsymbol(*((symset *)Conset[127]));
- R156 = tp;
- return R156;
- }
-
- void
- parse()
- {
- nextsymbol(*((symset *)Conset[128]));
- if (currsym.st == spgm)
- top = pprogram();
- else
- top = pmodule();
- nextsymbol(*((symset *)Conset[129]));
- }
-
- integer
- cvalof(tp)
- treeptr tp;
- {
- register integer R157;
- integer v;
- treeptr tq;
-
- switch (tp->tt) {
- case nuplus:
- R157 = cvalof(tp->U.V42.texps);
- break ;
- case numinus:
- R157 = -cvalof(tp->U.V42.texps);
- break ;
- case nnot:
- R157 = 1 - cvalof(tp->U.V42.texps);
- break ;
- case nid:
- tq = idup(tp);
- if (tq == (struct S61 *)NIL)
- fatal(etree);
- tp = tp->U.V43.tsym->lsymdecl;
- switch (tq->tt) {
- case nscalar:
- v = 0;
- tq = tq->U.V17.tscalid;
- while (tq != (struct S61 *)NIL)
- if (tq == tp)
- tq = (struct S61 *)NIL;
- else {
- v = v + 1;
- tq = tq->tnext;
- }
- R157 = v;
- break ;
- case nconst:
- R157 = cvalof(tq->U.V14.tbind);
- break ;
- default:
- Caseerror(Line);
- }
- break ;
- case ninteger:
- R157 = tp->U.V43.tsym->U.V10.linum;
- break ;
- case nchar:
- R157 = (unsigned)(tp->U.V43.tsym->U.V11.lchar);
- break ;
- default:
- Caseerror(Line);
- }
- return R157;
- }
-
- integer
- clower(tp)
- treeptr tp;
- {
- register integer R158;
- treeptr tq;
-
- tq = typeof(tp);
- if (tq->tt == nscalar)
- R158 = scalbase;
- else
- if (tq->tt == nsubrange)
- if (tq->tup->tt == nconfarr)
- R158 = 0;
- else
- R158 = cvalof(tq->U.V19.tlo);
- else
- if (tq == typnods.A[(int)(tchar)])
- R158 = 0;
- else
- if (tq == typnods.A[(int)(tinteger)])
- R158 = -maxint;
- else
- fatal(etree);
- return R158;
- }
-
- integer
- cupper(tp)
- treeptr tp;
- {
- register integer R159;
- treeptr tq;
- integer i;
-
- tq = typeof(tp);
- if (tq->tt == nscalar) {
- tq = tq->U.V17.tscalid;
- i = scalbase;
- while (tq->tnext != (struct S61 *)NIL) {
- i = i + 1;
- tq = tq->tnext;
- }
- R159 = i;
- } else
- if (tq->tt == nsubrange)
- if (tq->tup->tt == nconfarr)
- fatal(euprconf);
- else
- R159 = cvalof(tq->U.V19.thi);
- else
- if (tq == typnods.A[(int)(tchar)])
- R159 = maxchar;
- else
- if (tq == typnods.A[(int)(tinteger)])
- R159 = maxint;
- else
- fatal(etree);
- return R159;
- }
-
- integer
- crange(tp)
- treeptr tp;
- {
- register integer R160;
-
- R160 = cupper(tp) - clower(tp) + 1;
- return R160;
- }
-
- integer
- csetwords(i)
- integer i;
- {
- register integer R161;
-
- i = (i + (C37_setbits)) / (C37_setbits + 1);
- if (i > maxsetrange)
- error(esetsize);
- R161 = i;
- return R161;
- }
-
- integer
- csetsize(tp)
- treeptr tp;
- {
- register integer R162;
- treeptr tq;
- integer i;
-
- tq = typeof(tp->U.V18.tof);
- i = clower(tq);
- if ((i < 0) || (i >= 6 * (C37_setbits + 1)))
- error(esetbase);
- R162 = csetwords(crange(tq)) + 1;
- return R162;
- }
-
- boolean
- islocal(tp)
- treeptr tp;
- {
- register boolean R163;
- treeptr tq;
-
- tq = tp->U.V43.tsym->lsymdecl;
- while (!(Member((unsigned)(tq->tt), Conset[130])))
- tq = tq->tup;
- while (!(Member((unsigned)(tp->tt), Conset[131])))
- tp = tp->tup;
- R163 = (boolean)(tp == tq);
- return R163;
- }
-
- void transform();
-
- void renamf();
-
- void
- crtnvar(tp)
- treeptr tp;
- {
- while (tp != (struct S61 *)NIL) {
- switch (tp->tt) {
- case npgm:
- crtnvar(tp->U.V13.tsubsub);
- break ;
- case nfunc: case nproc:
- crtnvar(tp->U.V13.tsubsub);
- crtnvar(tp->U.V13.tsubstmt);
- break ;
- case nbegin:
- crtnvar(tp->U.V24.tbegin);
- break ;
- case nif:
- crtnvar(tp->U.V31.tthen);
- crtnvar(tp->U.V31.telse);
- break ;
- case nwhile:
- crtnvar(tp->U.V32.twhistmt);
- break ;
- case nrepeat:
- crtnvar(tp->U.V33.treptstmt);
- break ;
- case nfor:
- crtnvar(tp->U.V34.tforstmt);
- break ;
- case ncase:
- crtnvar(tp->U.V35.tcaslst);
- crtnvar(tp->U.V35.tcasother);
- break ;
- case nchoise:
- crtnvar(tp->U.V36.tchostmt);
- break ;
- case nwith:
- crtnvar(tp->U.V37.twithstmt);
- break ;
- case nlabstmt:
- crtnvar(tp->U.V25.tstmt);
- break ;
- case nassign:
- if (tp->U.V27.tlhs->tt == ncall) {
- tp->U.V27.tlhs = tp->U.V27.tlhs->U.V30.tcall;
- tp->U.V27.tlhs->tup = tp;
- }
- (*G187_tv) = tp->U.V27.tlhs;
- if ((*G187_tv)->tt == nid)
- if ((*G187_tv)->U.V43.tsym == (*G183_ip))
- (*G187_tv)->U.V43.tsym = (*G185_iq);
- break ;
- case nbreak: case npush: case npop: case ngoto:
- case nempty: case ncall:
- break ;
- default:
- Caseerror(Line);
- }
- tp = tp->tnext;
- }
- }
-
- void
- renamf(tp)
- treeptr tp;
- {
- symptr ip, iq;
- treeptr tq, tv;
- symptr *F184;
- symptr *F186;
- treeptr *F188;
-
- F188 = G187_tv;
- G187_tv = &tv;
- F186 = G185_iq;
- G185_iq = &iq;
- F184 = G183_ip;
- G183_ip = &ip;
- while (tp != (struct S61 *)NIL) {
- switch (tp->tt) {
- case npgm: case nproc:
- renamf(tp->U.V13.tsubsub);
- break ;
- case nfunc:
- tq = mknode(nvar);
- tq->U.V14.tattr = aregister;
- tq->tup = tp;
- tq->U.V14.tidl = newid(mkvariable('R'));
- tq->U.V14.tidl->tup = tq;
- tq->U.V14.tbind = tp->U.V13.tfuntyp;
- tq->tnext = tp->U.V13.tsubvar;
- tp->U.V13.tsubvar = tq;
- (*G185_iq) = tq->U.V14.tidl->U.V43.tsym;
- (*G183_ip) = tp->U.V13.tsubid->U.V43.tsym;
- crtnvar(tp->U.V13.tsubsub);
- crtnvar(tp->U.V13.tsubstmt);
- renamf(tp->U.V13.tsubsub);
- break ;
- default:
- Caseerror(Line);
- }
- tp = tp->tnext;
- }
- G183_ip = F184;
- G185_iq = F186;
- G187_tv = F188;
- }
-
- void extract();
-
- treeptr
- xtrit(tp, pp, last)
- treeptr tp, pp;
- boolean last;
- {
- register treeptr R164;
- treeptr np, rp;
- idptr ip;
-
- np = mknode(ntype);
- ip = mkvariable('T');
- np->U.V14.tidl = newid(ip);
- np->U.V14.tidl->tup = np;
- rp = oldid(ip, lidentifier);
- rp->tup = tp->tup;
- rp->tnext = tp->tnext;
- np->U.V14.tbind = tp;
- tp->tup = np;
- tp->tnext = (struct S61 *)NIL;
- np->tup = pp;
- if (last && (pp->U.V13.tsubtype != (struct S61 *)NIL)) {
- pp = pp->U.V13.tsubtype;
- while (pp->tnext != (struct S61 *)NIL)
- pp = pp->tnext;
- pp->tnext = np;
- } else {
- np->tnext = pp->U.V13.tsubtype;
- pp->U.V13.tsubtype = np;
- }
- R164 = rp;
- return R164;
- }
-
- treeptr xtrenum();
-
- void
- nametype(tp)
- treeptr tp;
- {
- tp = typeof(tp);
- if (tp->tt == nrecord)
- if (tp->U.V21.tuid == (struct S59 *)NIL)
- tp->U.V21.tuid = mkvariable('S');
- }
-
- treeptr
- xtrenum(tp, pp)
- treeptr tp, pp;
- {
- register treeptr R165;
-
- if (tp != (struct S61 *)NIL) {
- switch (tp->tt) {
- case nfield: case ntype: case nvar:
- tp->U.V14.tbind = xtrenum(tp->U.V14.tbind, pp);
- break ;
- case nscalar:
- if (tp->tup->tt != ntype)
- tp = xtrit(tp, pp, false);
- break ;
- case narray:
- tp->U.V23.taindx = xtrenum(tp->U.V23.taindx, pp);
- tp->U.V23.taelem = xtrenum(tp->U.V23.taelem, pp);
- break ;
- case nrecord:
- tp->U.V21.tflist = xtrenum(tp->U.V21.tflist, pp);
- tp->U.V21.tvlist = xtrenum(tp->U.V21.tvlist, pp);
- break ;
- case nvariant:
- tp->U.V20.tvrnt = xtrenum(tp->U.V20.tvrnt, pp);
- break ;
- case nfileof:
- tp->U.V18.tof = xtrenum(tp->U.V18.tof, pp);
- break ;
- case nptr:
- nametype(tp->U.V16.tptrid);
- break ;
- case nid: case nsubrange: case npredef: case nempty:
- case nsetof:
- break ;
- default:
- Caseerror(Line);
- }
- tp->tnext = xtrenum(tp->tnext, pp);
- }
- R165 = tp;
- return R165;
- }
-
- void
- extract(tp)
- treeptr tp;
- {
- treeptr vp;
-
- while (tp != (struct S61 *)NIL) {
- tp->U.V13.tsubtype = xtrenum(tp->U.V13.tsubtype, tp);
- tp->U.V13.tsubvar = xtrenum(tp->U.V13.tsubvar, tp);
- vp = tp->U.V13.tsubvar;
- while (vp != (struct S61 *)NIL) {
- if (Member((unsigned)(vp->U.V14.tbind->tt), Conset[132]))
- vp->U.V14.tbind = xtrit(vp->U.V14.tbind, tp, true);
- vp = vp->tnext;
- }
- extract(tp->U.V13.tsubsub);
- tp = tp->tnext;
- }
- }
-
- void global();
-
- void
- markdecl(xp)
- treeptr xp;
- {
- while (xp != (struct S61 *)NIL) {
- switch (xp->tt) {
- case nid:
- xp->U.V43.tsym->U.V6.lused = false;
- break ;
- case nconst:
- markdecl(xp->U.V14.tidl);
- break ;
- case ntype: case nvar: case nvalpar: case nvarpar:
- case nfield:
- markdecl(xp->U.V14.tidl);
- if (xp->U.V14.tbind->tt != nid)
- markdecl(xp->U.V14.tbind);
- break ;
- case nscalar:
- markdecl(xp->U.V17.tscalid);
- break ;
- case nrecord:
- markdecl(xp->U.V21.tflist);
- markdecl(xp->U.V21.tvlist);
- break ;
- case nvariant:
- markdecl(xp->U.V20.tvrnt);
- break ;
- case nconfarr:
- if (xp->U.V22.tcelem->tt != nid)
- markdecl(xp->U.V22.tcelem);
- break ;
- case narray:
- if (xp->U.V23.taelem->tt != nid)
- markdecl(xp->U.V23.taelem);
- break ;
- case nsetof: case nfileof:
- if (xp->U.V18.tof->tt != nid)
- markdecl(xp->U.V18.tof);
- break ;
- case nparproc: case nparfunc:
- markdecl(xp->U.V15.tparid);
- break ;
- case nptr: case nsubrange:
- break ;
- default:
- Caseerror(Line);
- }
- xp = xp->tnext;
- }
- }
-
- treeptr
- movedecl(tp)
- treeptr tp;
- {
- register treeptr R166;
- treeptr ip, np;
- symptr sp;
- boolean move;
-
- if (tp != (struct S61 *)NIL) {
- move = false;
- switch (tp->tt) {
- case nconst: case ntype:
- ip = tp->U.V14.tidl;
- break ;
- default:
- Caseerror(Line);
- }
- while (ip != (struct S61 *)NIL) {
- if (ip->U.V43.tsym->U.V6.lused) {
- move = true;
- sp = ip->U.V43.tsym;
- if (sp->U.V6.lid->inref > 1) {
- sp->U.V6.lid = mkrename('M', sp->U.V6.lid);
- sp->U.V6.lid->inref = sp->U.V6.lid->inref - 1;
- }
- ip = (struct S61 *)NIL;
- } else
- ip = ip->tnext;
- }
- if (move) {
- np = tp->tnext;
- tp->tnext = (struct S61 *)NIL;
- ip = tp;
- while (ip->tt != npgm)
- ip = ip->tup;
- tp->tup = ip;
- switch (tp->tt) {
- case nconst:
- if (ip->U.V13.tsubconst == (struct S61 *)NIL)
- ip->U.V13.tsubconst = tp;
- else {
- ip = ip->U.V13.tsubconst;
- while (ip->tnext != (struct S61 *)NIL)
- ip = ip->tnext;
- ip->tnext = tp;
- }
- break ;
- case ntype:
- if (ip->U.V13.tsubtype == (struct S61 *)NIL)
- ip->U.V13.tsubtype = tp;
- else {
- ip = ip->U.V13.tsubtype;
- while (ip->tnext != (struct S61 *)NIL)
- ip = ip->tnext;
- ip->tnext = tp;
- }
- break ;
- default:
- Caseerror(Line);
- }
- tp = movedecl(np);
- } else
- tp->tnext = movedecl(tp->tnext);
- }
- R166 = tp;
- return R166;
- }
-
- void movevars();
-
- void
- moveglob(tp, dp)
- treeptr tp, dp;
- {
- while (tp->tt != npgm)
- tp = tp->tup;
- dp->tup = tp;
- dp->tnext = tp->U.V13.tsubvar;
- tp->U.V13.tsubvar = dp;
- }
-
- treeptr
- stackop(decl, glob, loc)
- treeptr decl, glob, loc;
- {
- register treeptr R167;
- treeptr op, ip, dp, tp;
-
- ip = newid(mkvariable('F'));
- switch ((*G189_vp)->tt) {
- case nvarpar: case nvalpar: case nvar:
- dp = mknode(nvarpar);
- dp->U.V14.tattr = areference;
- dp->U.V14.tidl = ip;
- dp->U.V14.tbind = decl->U.V14.tbind;
- break ;
- case nparproc: case nparfunc:
- dp = mknode((*G189_vp)->tt);
- dp->U.V15.tparid = ip;
- dp->U.V15.tparparm = (struct S61 *)NIL;
- dp->U.V15.tpartyp = (*G189_vp)->U.V15.tpartyp;
- break ;
- default:
- Caseerror(Line);
- }
- ip->tup = dp;
- tp = decl;
- while (!(Member((unsigned)(tp->tt), Conset[133])))
- tp = tp->tup;
- dp->tup = tp;
- if (tp->U.V13.tsubvar == (struct S61 *)NIL)
- tp->U.V13.tsubvar = dp;
- else {
- tp = tp->U.V13.tsubvar;
- while (tp->tnext != (struct S61 *)NIL)
- tp = tp->tnext;
- tp->tnext = dp;
- }
- dp->tnext = (struct S61 *)NIL;
- op = mknode(npush);
- op->U.V28.tglob = glob;
- op->U.V28.tloc = loc;
- op->U.V28.ttmp = ip;
- R167 = op;
- return R167;
- }
-
- void
- addcode(tp, push)
- treeptr tp, push;
- {
- treeptr pop;
-
- pop = mknode(npop);
- pop->U.V28.tglob = push->U.V28.tglob;
- pop->U.V28.ttmp = push->U.V28.ttmp;
- pop->U.V28.tloc = (struct S61 *)NIL;
- push->tnext = tp->U.V13.tsubstmt;
- tp->U.V13.tsubstmt = push;
- push->tup = tp;
- while (push->tnext != (struct S61 *)NIL)
- push = push->tnext;
- push->tnext = pop;
- pop->tup = tp;
- }
-
- void
- movevars(tp, vp)
- treeptr tp, vp;
- {
- treeptr ep, dp, np;
- idptr ip;
- symptr sp;
- treeptr *F190;
-
- F190 = G189_vp;
- G189_vp = &vp;
- while ((*G189_vp) != (struct S61 *)NIL) {
- switch ((*G189_vp)->tt) {
- case nvar: case nvalpar: case nvarpar:
- dp = (*G189_vp)->U.V14.tidl;
- break ;
- case nparproc: case nparfunc:
- dp = (*G189_vp)->U.V15.tparid;
- if (dp->U.V43.tsym->U.V6.lused) {
- ep = mknode((*G189_vp)->tt);
- ep->U.V15.tparparm = (struct S61 *)NIL;
- ep->U.V15.tpartyp = (*G189_vp)->U.V15.tpartyp;
- np = newid(mkrename('G', dp->U.V43.tsym->U.V6.lid));
- ep->U.V15.tparid = np;
- np->tup = ep;
- sp = np->U.V43.tsym;
- ip = sp->U.V6.lid;
- np->U.V43.tsym->U.V6.lid = dp->U.V43.tsym->U.V6.lid;
- dp->U.V43.tsym->U.V6.lid = ip;
- np->U.V43.tsym = dp->U.V43.tsym;
- dp->U.V43.tsym = sp;
- np->U.V43.tsym->lsymdecl = np;
- dp->U.V43.tsym->lsymdecl = dp;
- moveglob(tp, ep);
- addcode(tp, stackop((*G189_vp), np, dp));
- }
- goto L555;
- break ;
- default:
- Caseerror(Line);
- }
- while (dp != (struct S61 *)NIL) {
- if (dp->U.V43.tsym->U.V6.lused) {
- ep = mknode(nvarpar);
- ep->U.V14.tattr = areference;
- np = newid(mkrename('G', dp->U.V43.tsym->U.V6.lid));
- ep->U.V14.tidl = np;
- np->tup = ep;
- ep->U.V14.tbind = (*G189_vp)->U.V14.tbind;
- if (ep->U.V14.tbind->tt == nid)
- ep->U.V14.tbind->U.V43.tsym->U.V6.lused = true;
- sp = np->U.V43.tsym;
- ip = sp->U.V6.lid;
- np->U.V43.tsym->U.V6.lid = dp->U.V43.tsym->U.V6.lid;
- dp->U.V43.tsym->U.V6.lid = ip;
- np->U.V43.tsym = dp->U.V43.tsym;
- dp->U.V43.tsym = sp;
- np->U.V43.tsym->lsymdecl = np;
- dp->U.V43.tsym->lsymdecl = dp;
- dp->tup->U.V14.tattr = aextern;
- moveglob(tp, ep);
- addcode(tp, stackop((*G189_vp), np, dp));
- }
- dp = dp->tnext;
- }
- L555:
- (*G189_vp) = (*G189_vp)->tnext;
- }
- G189_vp = F190;
- }
-
- void
- registervar(tp)
- treeptr tp;
- {
- treeptr vp, xp;
-
- vp = idup(tp);
- tp = tp->U.V43.tsym->lsymdecl;
- if ((vp->U.V14.tidl != tp) || (tp->tnext != (struct S61 *)NIL)) {
- xp = mknode(nvar);
- xp->U.V14.tattr = anone;
- xp->U.V14.tidl = tp;
- tp->tup = xp;
- xp->tup = vp->tup;
- xp->U.V14.tbind = vp->U.V14.tbind;
- xp->tnext = vp->tnext;
- vp->tnext = xp;
- if (vp->U.V14.tidl == tp)
- vp->U.V14.tidl = tp->tnext;
- else {
- vp = vp->U.V14.tidl;
- while (vp->tnext != tp)
- vp = vp->tnext;
- vp->tnext = tp->tnext;
- }
- tp->tnext = (struct S61 *)NIL;
- }
- if (tp->tup->U.V14.tattr == anone)
- tp->tup->U.V14.tattr = aregister;
- }
-
- void
- cklevel(tp)
- treeptr tp;
- {
- tp = tp->U.V43.tsym->lsymdecl;
- while (!(Member((unsigned)(tp->tt), Conset[134])))
- tp = tp->tup;
- if (tp->U.V13.tstat > maxlevel)
- maxlevel = tp->U.V13.tstat;
- }
-
- void
- global(tp, dp, depend)
- treeptr tp, dp;
- boolean depend;
- {
- treeptr ip;
- boolean dep;
-
- while (tp != (struct S61 *)NIL) {
- switch (tp->tt) {
- case nproc: case nfunc:
- markdecl(tp->U.V13.tsubid);
- markdecl(tp->U.V13.tsubpar);
- markdecl(tp->U.V13.tsubconst);
- markdecl(tp->U.V13.tsubtype);
- markdecl(tp->U.V13.tsubvar);
- global(tp->U.V13.tsubsub, tp, false);
- movevars(tp, tp->U.V13.tsubpar);
- movevars(tp, tp->U.V13.tsubvar);
- tp->U.V13.tsubtype = movedecl(tp->U.V13.tsubtype);
- tp->U.V13.tsubconst = movedecl(tp->U.V13.tsubconst);
- global(tp->U.V13.tsubstmt, tp, true);
- global(tp->U.V13.tsubpar, tp, false);
- global(tp->U.V13.tsubvar, tp, false);
- global(tp->U.V13.tsubtype, tp, false);
- global(tp->U.V13.tfuntyp, tp, false);
- break ;
- case npgm:
- markdecl(tp->U.V13.tsubconst);
- markdecl(tp->U.V13.tsubtype);
- markdecl(tp->U.V13.tsubvar);
- global(tp->U.V13.tsubsub, tp, false);
- global(tp->U.V13.tsubstmt, tp, true);
- break ;
- case nconst: case ntype: case nvar: case nfield:
- case nvalpar: case nvarpar:
- ip = tp->U.V14.tidl;
- dep = depend;
- while ((ip != (struct S61 *)NIL) && !dep) {
- if (ip->U.V43.tsym->U.V6.lused)
- dep = true;
- ip = ip->tnext;
- }
- global(tp->U.V14.tbind, dp, dep);
- break ;
- case nparproc: case nparfunc:
- global(tp->U.V15.tparparm, dp, depend);
- global(tp->U.V15.tpartyp, dp, depend);
- break ;
- case nsubrange:
- global(tp->U.V19.tlo, dp, depend);
- global(tp->U.V19.thi, dp, depend);
- break ;
- case nvariant:
- global(tp->U.V20.tselct, dp, depend);
- global(tp->U.V20.tvrnt, dp, depend);
- break ;
- case nrecord:
- global(tp->U.V21.tflist, dp, depend);
- global(tp->U.V21.tvlist, dp, depend);
- break ;
- case nconfarr:
- global(tp->U.V22.tcindx, dp, depend);
- global(tp->U.V22.tcelem, dp, depend);
- break ;
- case narray:
- global(tp->U.V23.taindx, dp, depend);
- global(tp->U.V23.taelem, dp, depend);
- break ;
- case nfileof: case nsetof:
- global(tp->U.V18.tof, dp, depend);
- break ;
- case nptr:
- global(tp->U.V16.tptrid, dp, depend);
- break ;
- case nscalar:
- global(tp->U.V17.tscalid, dp, depend);
- break ;
- case nbegin:
- global(tp->U.V24.tbegin, dp, depend);
- break ;
- case nif:
- global(tp->U.V31.tifxp, dp, depend);
- global(tp->U.V31.tthen, dp, depend);
- global(tp->U.V31.telse, dp, depend);
- break ;
- case nwhile:
- global(tp->U.V32.twhixp, dp, depend);
- global(tp->U.V32.twhistmt, dp, depend);
- break ;
- case nrepeat:
- global(tp->U.V33.treptstmt, dp, depend);
- global(tp->U.V33.treptxp, dp, depend);
- break ;
- case nfor:
- ip = idup(tp->U.V34.tforid);
- if (Member((unsigned)(ip->tup->tt), Conset[135]))
- registervar(tp->U.V34.tforid);
- global(tp->U.V34.tforid, dp, depend);
- global(tp->U.V34.tfrom, dp, depend);
- global(tp->U.V34.tto, dp, depend);
- global(tp->U.V34.tforstmt, dp, depend);
- break ;
- case ncase:
- global(tp->U.V35.tcasxp, dp, depend);
- global(tp->U.V35.tcaslst, dp, depend);
- global(tp->U.V35.tcasother, dp, depend);
- break ;
- case nchoise:
- global(tp->U.V36.tchocon, dp, depend);
- global(tp->U.V36.tchostmt, dp, depend);
- break ;
- case nwith:
- global(tp->U.V37.twithvar, dp, depend);
- global(tp->U.V37.twithstmt, dp, depend);
- break ;
- case nwithvar:
- ip = typeof(tp->U.V38.texpw);
- if (ip->U.V21.tuid == (struct S59 *)NIL)
- ip->U.V21.tuid = mkvariable('S');
- global(tp->U.V38.texpw, dp, depend);
- break ;
- case nlabstmt:
- global(tp->U.V25.tstmt, dp, depend);
- break ;
- case neq: case nne: case nlt: case nle:
- case ngt: case nge:
- global(tp->U.V41.texpl, dp, depend);
-
- global(tp->U.V41.texpr, dp, depend);
- ip = typeof(tp->U.V41.texpl);
- if ((ip == typnods.A[(int)(tstring)]) || (ip->tt == narray))
- usecomp = true;
- ip = typeof(tp->U.V41.texpr);
- if ((ip == typnods.A[(int)(tstring)]) || (ip->tt == narray))
- usecomp = true;
- break ;
- case nin: case nor: case nplus: case nminus:
- case nand: case nmul: case ndiv: case nmod:
- case nquot: case nformat: case nrange:
- global(tp->U.V41.texpl, dp, depend);
- global(tp->U.V41.texpr, dp, depend);
- break ;
- case nassign:
- global(tp->U.V27.tlhs, dp, depend);
- global(tp->U.V27.trhs, dp, depend);
- break ;
- case nnot: case numinus: case nuplus: case nderef:
- global(tp->U.V42.texps, dp, depend);
- break ;
- case nset:
- global(tp->U.V42.texps, dp, depend);
- break ;
- case nindex:
- global(tp->U.V39.tvariable, dp, depend);
- global(tp->U.V39.toffset, dp, depend);
- break ;
- case nselect:
- global(tp->U.V40.trecord, dp, depend);
- break ;
- case ncall:
- global(tp->U.V30.tcall, dp, depend);
- global(tp->U.V30.taparm, dp, depend);
- break ;
- case nid:
- ip = idup(tp);
- if (ip == (struct S61 *)NIL)
- goto L555;
- do {
- ip = ip->tup;
- if (ip == (struct S61 *)NIL)
- goto L555;
- } while (!(Member((unsigned)(ip->tt), Conset[136])));
- if (dp == ip) {
- if (depend)
- tp->U.V43.tsym->U.V6.lused = true;
- } else {
- tp->U.V43.tsym->U.V6.lused = true;
- }
- L555:
- ;
- break ;
- case ngoto:
- if (!islocal(tp->U.V26.tlabel)) {
- tp->U.V26.tlabel->U.V43.tsym->U.V9.lgo = true;
- usejmps = true;
- cklevel(tp->U.V26.tlabel);
- }
- break ;
- case nbreak: case npush: case npop: case npredef:
- case nempty: case nchar: case ninteger: case nreal:
- case nstring: case nnil:
- break ;
- default:
- Caseerror(Line);
- }
- tp = tp->tnext;
- }
- }
-
- void
- renamc()
- {
- idptr ip;
- register cnames cn;
-
- {
- cnames B49 = cabort,
- B50 = cwrite;
-
- if ((int)(B49) <= (int)(B50))
- for (cn = B49; ; cn = (cnames)((int)(cn)+1)) {
- ip = mkrename('C', ctable.A[(int)(cn)]);
- ctable.A[(int)(cn)]->istr = ip->istr;
- if (cn == B50) break;
- }
- }
- }
-
- void
- renamp(tp, on)
- treeptr tp;
- boolean on;
- {
- symptr sp;
-
- while (tp != (struct S61 *)NIL) {
-