Return to exec.c CVS log

Up to [Research Unix] / researchv10no / cmd / efl

Annotation of researchv10no/cmd/efl/exec.c, revision 1.1

1.1     ! root        1: #include "defs"
        !             2: 
        !             3: exlab(n)
        !             4: register int n;
        !             5: {
        !             6: if(n==0 && thisexec->labelno && !(thisexec->labused))
        !             7:        {
        !             8:        thisexec->labused = 1;
        !             9:        n = thisexec->labelno;
        !            10:        }
        !            11: 
        !            12: if(!prevbg || n!=0)  /* avoid empty statement */
        !            13:        {
        !            14:        if(comments && !afterif) putcomment();
        !            15:        putic(ICBEGIN, n);
        !            16:        putic(ICINDENT, ctllevel);
        !            17:        if(n != 0)
        !            18:                if(stnos[n] != 0)
        !            19:                        fatal("statement number changed");
        !            20:                else    stnos[n] = ( nxtstno += tailor.deltastno) ;
        !            21:        TEST fprintf(diagfile, "LABEL %d\n", n);
        !            22:        thisexec->nftnst++;
        !            23:        afterif = 0;
        !            24:        }
        !            25: }
        !            26: 
        !            27: 
        !            28: exgoto(n)
        !            29: int n;
        !            30: {
        !            31: exlab(0);
        !            32: exgo1(n);
        !            33: }
        !            34: 
        !            35: exgoind(n)
        !            36: int n;
        !            37: {
        !            38: exlab(0);
        !            39: putic(ICKEYWORD,FGOTO);
        !            40: putic(ICINDPTR,n);
        !            41: TEST fprintf(diagfile, "goto indirect %o\n", n);
        !            42: }
        !            43: 
        !            44: 
        !            45: 
        !            46: exgo1(n)
        !            47: int n;
        !            48: {
        !            49: putic(ICKEYWORD,FGOTO);
        !            50: putic(ICLABEL,n);
        !            51: TEST fprintf(diagfile, "goto %d\n", n);
        !            52: }
        !            53: 
        !            54: 
        !            55: excompgoto(labs,index)
        !            56: ptr labs;
        !            57: register ptr index;
        !            58: {
        !            59: register int first;
        !            60: register ptr p;
        !            61: 
        !            62: index = simple(LVAL,index);
        !            63: if(tailor.ftn77)
        !            64:        exlab(0);
        !            65: else
        !            66:        {
        !            67:        int ncases = 0;
        !            68:        for(p = labs ; p ; p = p->nextp)
        !            69:                ++ncases;
        !            70:        exif1( mknode(TLOGOP, OPAND,
        !            71:                mknode(TRELOP,OPGT, cpexpr(index), mkint(0)),
        !            72:                mknode(TRELOP,OPLE, cpexpr(index), mkint(ncases)) ));
        !            73:        }
        !            74: 
        !            75: putic(ICKEYWORD, FGOTO);
        !            76: putic(ICOP,OPLPAR);
        !            77: 
        !            78: first = 1;
        !            79: for(p = labs ; p ; p = p->nextp)
        !            80:        {
        !            81:        if(first)   first = 0;
        !            82:        else   putic(ICOP,OPCOMMA);
        !            83:        putic(ICLABEL,p->datap);
        !            84:        }
        !            85: putic(ICOP,OPRPAR);
        !            86: frchain(&labs);
        !            87: 
        !            88: putic(ICOP,OPCOMMA);
        !            89: prexpr(index);
        !            90: frexpr(index);
        !            91: TEST fprintf(diagfile, "computed goto\n");
        !            92: }
        !            93: 
        !            94: 
        !            95: 
        !            96: 
        !            97: excall(p)
        !            98: register ptr p;
        !            99: {
        !           100: register ptr q1, q2, q3;
        !           101: ptr mkholl(), exioop();
        !           102: 
        !           103: if(p->tag==TNAME || p->tag==TFTNBLOCK)
        !           104:        p = mkcall(p, PNULL);
        !           105: 
        !           106: if(p->tag == TERROR)
        !           107:        {
        !           108:        frexpr(p);
        !           109:        return;
        !           110:        }
        !           111: if(p->tag != TCALL)
        !           112:        badtag("excall", p->tag);
        !           113: 
        !           114: q1 = p->leftp;
        !           115: q2 = (q1->tag==TFTNBLOCK ? q1 : ((struct stentry *)q1->sthead)->varp);
        !           116: if(q2->vtype!=TYUNDEFINED && q2->vtype!=TYSUBR)
        !           117:        {
        !           118:        dclerr("attempt to use a variable as a subroutine", ((struct stentry *)p->sthead)->namep);
        !           119:        frexpr(p);
        !           120:        return;
        !           121:        }
        !           122: q1->vtype = q2->vtype = TYSUBR;
        !           123: if(q1->vdcldone==0)
        !           124:        dclit(q1);
        !           125: 
        !           126: if(q1->tag == TNAME)
        !           127:        {
        !           128:        if( equals(((struct stentry *)q2->sthead)->namep, "stop") )
        !           129:                {
        !           130:                exlab(0);
        !           131:                putic(ICKEYWORD, FSTOP);
        !           132:                TEST fprintf(diagfile,"stop ");
        !           133:                if( (q1 = p->rightp) && (q1 = q1->leftp) )
        !           134:                        prexpr( simple(RVAL, q1->datap) );
        !           135:                goto done;
        !           136:                }
        !           137:        if( ioop(((struct stentry *)q2->sthead)->namep) )
        !           138:                {
        !           139:                exioop(p,NO);
        !           140:                goto done;
        !           141:                }
        !           142:        }
        !           143: 
        !           144: p = simple(RVAL,p);
        !           145: exlab(0);
        !           146: putic(ICKEYWORD,FCALL);
        !           147: TEST fprintf(diagfile, "call ");
        !           148: /* replace character constant arguments with holleriths */
        !           149: if( (q1=p->rightp) && tailor.hollincall)
        !           150:        for(q1 = q1->leftp ; q1 ; q1 = q1->nextp)
        !           151:                if( ((struct headbits *)(q2 = q1->datap))->tag==TCONST
        !           152:                    && q2->vtype==TYCHAR)
        !           153:                        {
        !           154:                        q2->vtype = TYHOLLERITH;
        !           155:                        frexpr(q2->vtypep);
        !           156:                        q2->vtypep = 0;
        !           157:                        q2->leftp = mkholl(q3 = q2->leftp);
        !           158:                        cfree(q3);
        !           159:                        }
        !           160: prexpr( p );
        !           161: 
        !           162: done:  frexpr(p);
        !           163: }
        !           164: 
        !           165: 
        !           166: 
        !           167: 
        !           168: ptr mkholl(p)
        !           169: register char *p;
        !           170: {
        !           171: register char *q, *t, *s;
        !           172: int n;
        !           173: 
        !           174: n = strlen(p);
        !           175: q = convic(n);
        !           176: s = t = (char *)calloc(n + 2 + strlen(q) , 1);
        !           177: while(*q)
        !           178:        *t++ = *q++;
        !           179: *t++ = 'h';
        !           180: while(*t++ = *p++ )
        !           181:        ;
        !           182: return((int *)s);
        !           183: }
        !           184: 
        !           185: 
        !           186: ptr ifthen()
        !           187: {
        !           188: ptr p;
        !           189: ptr addexec();
        !           190: 
        !           191: p = addexec();
        !           192: thisexec->brnchend = 0;
        !           193: if(thisexec->nftnst == 0)
        !           194:        {
        !           195:        exlab(0);
        !           196:        putic(ICKEYWORD,FCONTINUE);
        !           197:        thisexec->nftnst = 1;
        !           198:        }
        !           199: if(thisexec->nftnst>1 || thisexec->labeled || thisexec->uniffable )
        !           200:        {
        !           201:        if(thisctl->breaklab == 0)
        !           202:                thisctl->breaklab = nextlab();
        !           203:        indifs[thisctl->indifn] = thisctl->breaklab;
        !           204:        }
        !           205: else   thisctl->breaklab = 0;
        !           206: return(p);
        !           207: }
        !           208: 
        !           209: 
        !           210: 
        !           211: exasgn(l,o,r)
        !           212: ptr l;
        !           213: int o;
        !           214: ptr r;
        !           215: {
        !           216: exlab(0);
        !           217: if(l->vdcldone == 0)
        !           218:        dclit(l);
        !           219: frexpr( simple(LVAL , mknode(TASGNOP,o,l,r)) );
        !           220: }
        !           221: 
        !           222: exretn(p)
        !           223: ptr p;
        !           224: {
        !           225: if(p)
        !           226:        {
        !           227:        if(procname && procname->vtype && procname->vtype!=TYCHAR &&
        !           228:          (procname->vtype!=TYLCOMPLEX || tailor.lngcxtype!=NULL) )
        !           229:                {
        !           230:                if(p->tag!=TNAME || p->sthead!=procname->sthead)
        !           231:                        exasgn( cpexpr(procname) , OPASGN, p);
        !           232:                }
        !           233:        else execerr("can only return values in a function", PNULL);
        !           234:        }
        !           235: else if(procname && procname->vtype)
        !           236:         warn("function return without data value");
        !           237: exlab(0);
        !           238: putic(ICKEYWORD, FRETURN);
        !           239: 
        !           240: TEST {fprintf(diagfile, "exec: return( " );  prexpr(p);  fprintf(diagfile, ")\n" );  }
        !           241: }
        !           242: 
        !           243: 
        !           244: exnull()
        !           245: {
        !           246: if(thisexec->labelno && !(thisexec->labused) )
        !           247:        {
        !           248:        exlab(0);
        !           249:        putic(ICKEYWORD,FCONTINUE);
        !           250:        }
        !           251: }
        !           252: 
        !           253: 
        !           254: 
        !           255: 
        !           256: exbrk(opnext,levskip,btype)
        !           257: int opnext;
        !           258: ptr levskip;
        !           259: int btype;
        !           260: {
        !           261: 
        !           262: if(opnext && (btype==STSWITCH || btype==STPROC))
        !           263:        execerr("illegal next", PNULL);
        !           264: else if(!opnext && btype==STPROC)
        !           265:        exretn(PNULL);
        !           266: else  brknxtlab(opnext,levskip,btype);
        !           267: TEST fprintf(diagfile, "exec: %s\n", (opnext ? "next" : "exit"));
        !           268: 
        !           269: }
        !           270: 
        !           271: 
        !           272: 
        !           273: exif(e)
        !           274: register ptr e;
        !           275: {
        !           276: int tag;
        !           277: 
        !           278: if( (tag = e->tag)==TERROR || e->vtype!=TYLOG)
        !           279:        {
        !           280:        frexpr(e);
        !           281:        e = mkconst(TYLOG, ".true.");
        !           282:        if(tag != TERROR)
        !           283:                execerr("non-logical conditional expression in if", PNULL);
        !           284:        }
        !           285: TEST fprintf(diagfile, "exif called\n");
        !           286: e = simple(RVAL,e);
        !           287: exlab(0);
        !           288: putic(ICKEYWORD,FIF2);
        !           289: indifs[thisctl->indifn = nextindif()] = 0;
        !           290: putic(ICINDPTR, thisctl->indifn);
        !           291: putic(ICOP,OPLPAR);
        !           292: prexpr(e);
        !           293: putic(ICOP,OPRPAR);
        !           294: putic(ICMARK,0);
        !           295: putic(ICOP,OPLPAR);
        !           296: prexpr(e = simple(RVAL, mknode(TNOTOP,OPNOT,e,PNULL)));
        !           297: putic(ICOP,OPRPAR);
        !           298: putic(ICMARK,0);
        !           299: afterif = 1;
        !           300: frexpr(e);
        !           301: }
        !           302: 
        !           303: 
        !           304: exifgo(e,l)
        !           305: ptr e;
        !           306: int l;
        !           307: {
        !           308: exlab(0);
        !           309: exif1(e);
        !           310: exgo1(l);
        !           311: }
        !           312: 
        !           313: 
        !           314: exif1(e)
        !           315: register ptr e;
        !           316: {
        !           317: e = simple(RVAL,e);
        !           318: exlab(0);
        !           319: putic(ICKEYWORD,FIF1);
        !           320: putic(ICOP,OPLPAR);
        !           321: TEST fprintf(diagfile, "if1 ");
        !           322: prexpr( e );
        !           323: frexpr(e);
        !           324: putic(ICOP,OPRPAR);
        !           325: putic(ICBLANK, 1);
        !           326: }
        !           327: 
        !           328: 
        !           329: 
        !           330: 
        !           331: 
        !           332: 
        !           333: 
        !           334: brkcase()
        !           335: {
        !           336: ptr bgnexec();
        !           337: 
        !           338: if(ncases==0 /* && thisexec->prevexec->brnchend==0 */ )
        !           339:        {
        !           340:        exbrk(0, PNULL, 0);
        !           341:        addexec();
        !           342:        bgnexec();
        !           343:        }
        !           344: ncases = 1;
        !           345: }
        !           346: 
        !           347: 
        !           348: brknxtlab(opnext, levp, btype)
        !           349: int opnext;
        !           350: ptr levp;
        !           351: int btype;
        !           352: {
        !           353: register ptr p;
        !           354: int levskip;
        !           355: 
        !           356: levskip = ( levp ? convci(levp->leftp) : 1);
        !           357: if(levskip <= 0)
        !           358:        {
        !           359:        execerr("illegal break count %d", levskip);
        !           360:        return;
        !           361:        }
        !           362: 
        !           363: for(p = thisctl ; p!=0 ; p = p->prevctl)
        !           364:        if( (btype==0 || p->subtype==btype) &&
        !           365:            p->subtype!=STIF && p->subtype!=STPROC &&
        !           366:            (!opnext || p->subtype!=STSWITCH) )
        !           367:                if(--levskip == 0) break;
        !           368: 
        !           369: if(p == 0)
        !           370:        {
        !           371:        execerr("invalid break/next", PNULL);
        !           372:        return;
        !           373:        }
        !           374: 
        !           375: if(p->subtype==STREPEAT && opnext)
        !           376:        exgoind(p->indifn);
        !           377: else if(opnext)
        !           378:        exgoto(p->nextlab);
        !           379: else   {
        !           380:        if(p->breaklab == 0)
        !           381:                p->breaklab = nextlab();
        !           382:        exgoto(p->breaklab);
        !           383:        }
        !           384: }
        !           385: 
        !           386: 
        !           387: 
        !           388: ptr doloop(p1,p2,p3)
        !           389: ptr p1;
        !           390: ptr p2;
        !           391: ptr p3;
        !           392: {
        !           393: register ptr p, q;
        !           394: register int i;
        !           395: int val[3];
        !           396: 
        !           397: p = (int *)ALLOC(doblock);
        !           398: p->tag = TDOBLOCK;
        !           399: 
        !           400: if(p1->tag!=TASGNOP || p1->subtype!=OPASGN || ((struct headbits *)p1->leftp)->tag!=TNAME)
        !           401:        {
        !           402:        p->dovar = gent(TYINT, PNULL);
        !           403:        p->dopar[0] = p1;
        !           404:        }
        !           405: else   {
        !           406:        p->dovar = p1->leftp;
        !           407:        p->dopar[0] = p1->rightp;
        !           408:        frexpblock(p1);
        !           409:        }
        !           410: if(p2 == 0)
        !           411:        {
        !           412:        p->dopar[1] = p->dopar[0];
        !           413:        p->dopar[0] = mkint(1);
        !           414:        }
        !           415: else   p->dopar[1] = p2;
        !           416: p->dopar[2] = p3;
        !           417: 
        !           418: for(i = 0; i<3 ; ++i)
        !           419:        {
        !           420:        if(q = p->dopar[i])
        !           421:                {
        !           422:                if( (q->tag==TNAME || q->tag==TTEMP) &&
        !           423:                   (q->vsubs || q->voffset) )
        !           424:                        p->dopar[i] = simple(RVAL,mknode(TASGNOP,0,
        !           425:                                gent(TYINT,PNULL), q));
        !           426:                else
        !           427:                        p->dopar[i] = simple(LVAL, coerce(TYINT, q) );
        !           428: 
        !           429:                if(isicon(p->dopar[i], &val[i]))
        !           430:                        {
        !           431:                        if(val[i] <= 0)
        !           432:                                execerr("do parameter out of range", PNULL);
        !           433:                        }
        !           434:                else    val[i] = -1;
        !           435:                }
        !           436:        }
        !           437: 
        !           438: if(val[0]>0 && val[1]>0 && val[0]>val[1])
        !           439:        execerr("do parameters out of order", PNULL);
        !           440: return(p);
        !           441: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.