Return to r1.c CVS log

Up to [Research Unix] / researchv10dc / cmd / ratfor

Annotation of researchv10dc/cmd/ratfor/r1.c, revision 1.1

1.1     ! root        1: #include "r.h"
        !             2: 
        !             3: #define        wasbreak        brkused[brkptr]==1 || brkused[brkptr]==3
        !             4: #define        wasnext brkused[brkptr]==2 || brkused[brkptr]==3
        !             5: 
        !             6: int    transfer        = 0;    /* 1 if just finished retrun, break, next */
        !             7: 
        !             8: char   fcname[200];
        !             9: char   scrat[500];
        !            10: 
        !            11: int    brkptr  = -1;
        !            12: int    brkstk[50];     /* break label */
        !            13: int    typestk[50];    /* type of loop construct */
        !            14: int    brkused[50];    /* loop contains BREAK or NEXT */
        !            15: 
        !            16: int    forptr  = 0;
        !            17: char   *forstk[50];
        !            18: 
        !            19: repcode() {
        !            20:        transfer = 0;
        !            21:        outcont(0);
        !            22:        putcom("repeat");
        !            23:        yyval = genlab(3);
        !            24:        indent++;
        !            25:        outcont(yyval);
        !            26:        brkstk[++brkptr] = yyval+1;
        !            27:        typestk[brkptr] = REPEAT;
        !            28:        brkused[brkptr] = 0;
        !            29: }
        !            30: 
        !            31: untils(p1,un) int p1,un; {
        !            32:        outnum(p1+1);
        !            33:        outtab();
        !            34:        if (un > 0) {
        !            35:                outcode("if(.not.");
        !            36:                balpar();
        !            37:                outcode(")");
        !            38:        }
        !            39:        transfer = 0;
        !            40:        outgoto(p1);
        !            41:        indent--;
        !            42:        if (wasbreak)
        !            43:                outcont(p1+2);
        !            44:        brkptr--;
        !            45: }
        !            46: 
        !            47: ifcode() {
        !            48:        transfer = 0;
        !            49:        outtab();
        !            50:        if (f77) {
        !            51:                outtab();
        !            52:                outcode("if");
        !            53:                balpar();
        !            54:                outcode("then");
        !            55:                outdon();
        !            56:        } else {
        !            57:                outcode("if(.not.");
        !            58:                balpar();
        !            59:                outcode(")");
        !            60:                outgoto(yyval=genlab(2));
        !            61:        }
        !            62:        indent++;
        !            63: }
        !            64: 
        !            65: elsecode(p1) {
        !            66:        if (f77) {
        !            67:                outtab();
        !            68:                outcode("else");
        !            69:                outdon();
        !            70:        } else {
        !            71:                outgoto(p1+1);
        !            72:                indent--;
        !            73:                putcom("else");
        !            74:                indent++;
        !            75:                outcont(p1);
        !            76:        }
        !            77: }
        !            78: 
        !            79: endif(s) char *s; {
        !            80:        outtab();
        !            81:        outcode("endif");
        !            82:        outdon();
        !            83: }
        !            84: 
        !            85: whilecode() {
        !            86:        transfer = 0;
        !            87:        outcont(0);
        !            88:        putcom("while");
        !            89:        brkstk[++brkptr] = yyval = genlab(2);
        !            90:        typestk[brkptr] = WHILE;
        !            91:        brkused[brkptr] = 0;
        !            92:        outnum(yyval);
        !            93:        outtab();
        !            94:        outcode("if(.not.");
        !            95:        balpar();
        !            96:        outcode(")");
        !            97:        outgoto(yyval+1);
        !            98:        indent++;
        !            99: }
        !           100: 
        !           101: whilestat(p1) int p1; {
        !           102:        outgoto(p1);
        !           103:        indent--;
        !           104:        putcom("endwhile");
        !           105:        outcont(p1+1);
        !           106:        brkptr--;
        !           107: }
        !           108: 
        !           109: balpar() {
        !           110:        register c, lpar;
        !           111:        while ((c=gtok(scrat)) == ' ' || c == '\t')
        !           112:                ;
        !           113:        if (c != '(') {
        !           114:                error("missing left paren");
        !           115:                return;
        !           116:        }
        !           117:        outcode(scrat);
        !           118:        lpar = 1;
        !           119:        do {
        !           120:                c = gtok(scrat);
        !           121:                if (c==';' || c=='{' || c=='}' || c==EOF) {
        !           122:                        pbstr(scrat);
        !           123:                        break;
        !           124:                }
        !           125:                if (c=='(')
        !           126:                        lpar++;
        !           127:                else if (c==')')
        !           128:                        lpar--;
        !           129:                else if (c == '\n') {
        !           130:                        while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n')
        !           131:                                ;
        !           132:                        pbstr(scrat);
        !           133:                        continue;
        !           134:                }
        !           135:                else if (c == '=' && scrat[1] == '\0')
        !           136:                        error("assigment inside conditional");
        !           137:                outcode(scrat);
        !           138:        } while (lpar > 0);
        !           139:        if (lpar != 0)
        !           140:                error("missing parenthesis");
        !           141: }
        !           142: 
        !           143: int    labval  = 23000;
        !           144: 
        !           145: genlab(n){
        !           146:        labval += n;
        !           147:        return(labval-n);
        !           148: }
        !           149: 
        !           150: gokcode(p1) {
        !           151:        transfer = 0;
        !           152:        outtab();
        !           153:        outcode(p1);
        !           154:        eatup();
        !           155:        outdon();
        !           156: }
        !           157: 
        !           158: eatup() {
        !           159:        int t, lpar;
        !           160:        char temp[100];
        !           161:        lpar = 0;
        !           162:        do {
        !           163:                if ((t = gtok(scrat)) == ';' || t == '\n')
        !           164:                        break;
        !           165:                if (t == '{' || t == '}' || t == EOF) {
        !           166:                        pbstr(scrat);
        !           167:                        break;
        !           168:                }
        !           169:                if (t == ',' || t == '+' || t == '-' || t == '*' || t == '('
        !           170:                  || t == '&' || t == '|' || t == '=') {
        !           171:                        while (gtok(temp) == '\n')
        !           172:                                ;
        !           173:                        pbstr(temp);
        !           174:                }
        !           175:                if (t == '(')
        !           176:                        lpar++;
        !           177:                else if (t==')') {
        !           178:                        lpar--;
        !           179:                        if (lpar < 0) {
        !           180:                                error("missing left paren");
        !           181:                                return(1);
        !           182:                        }
        !           183:                }
        !           184:                outcode(scrat);
        !           185:        } while (lpar >= 0);
        !           186:        if (lpar > 0) {
        !           187:                error("missing right paren");
        !           188:                return(1);
        !           189:        }
        !           190:        return(0);
        !           191: }
        !           192: 
        !           193: forcode(){
        !           194:        int lpar, t;
        !           195:        char *ps, *qs;
        !           196: 
        !           197:        transfer = 0;
        !           198:        outcont(0);
        !           199:        putcom("for");
        !           200:        yyval = genlab(3);
        !           201:        brkstk[++brkptr] = yyval+1;
        !           202:        typestk[brkptr] = FOR;
        !           203:        brkused[brkptr] = 0;
        !           204:        forstk[forptr++] = malloc(1);
        !           205:        if ((t = gnbtok(scrat)) != '(') {
        !           206:                error("missing left paren in FOR");
        !           207:                pbstr(scrat);
        !           208:                return;
        !           209:        }
        !           210:        if (gnbtok(scrat) != ';') {     /* real init clause */
        !           211:                pbstr(scrat);
        !           212:                outtab();
        !           213:                if (eatup() > 0) {
        !           214:                        error("illegal FOR clause");
        !           215:                        return;
        !           216:                }
        !           217:                outdon();
        !           218:        }
        !           219:        if (gnbtok(scrat) == ';')       /* empty condition */
        !           220:                outcont(yyval);
        !           221:        else {  /* non-empty condition */
        !           222:                pbstr(scrat);
        !           223:                outnum(yyval);
        !           224:                outtab();
        !           225:                outcode("if(.not.(");
        !           226:                for (lpar=0; lpar >= 0;) {
        !           227:                        if ((t = gnbtok(scrat)) == ';')
        !           228:                                break;
        !           229:                        if (t == '(')
        !           230:                                lpar++;
        !           231:                        else if (t == ')') {
        !           232:                                lpar--;
        !           233:                                if (lpar < 0) {
        !           234:                                        error("missing left paren in FOR clause");
        !           235:                                        return;
        !           236:                                }
        !           237:                        }
        !           238:                        if (t != '\n')
        !           239:                                outcode(scrat);
        !           240:                }
        !           241:                outcode("))");
        !           242:                outgoto(yyval+2);
        !           243:                if (lpar < 0)
        !           244:                        error("invalid FOR clause");
        !           245:        }
        !           246:        ps = scrat;
        !           247:        for (lpar=0; lpar >= 0;) {
        !           248:                if ((t = gtok(ps)) == '(')
        !           249:                        lpar++;
        !           250:                else if (t == ')')
        !           251:                        lpar--;
        !           252:                if (lpar >= 0 && t != '\n')
        !           253:                        while(*ps)
        !           254:                                ps++;
        !           255:        }
        !           256:        *ps = '\0';
        !           257:        qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
        !           258:        ps = scrat;
        !           259:        while (*qs++ = *ps++)
        !           260:                ;
        !           261:        indent++;
        !           262: }
        !           263: 
        !           264: forstat(p1) int p1; {
        !           265:        char *bp, *q;
        !           266:        bp = forstk[--forptr];
        !           267:        if (wasnext)
        !           268:                outnum(p1+1);
        !           269:        if (nonblank(bp)){
        !           270:                outtab();
        !           271:                outcode(bp);
        !           272:                outdon();
        !           273:        }
        !           274:        transfer = 0;
        !           275:        outgoto(p1);
        !           276:        indent--;
        !           277:        putcom("endfor");
        !           278:        outcont(p1+2);
        !           279:        for (q=bp; *q++;);
        !           280:        free(bp);
        !           281:        brkptr--;
        !           282: }
        !           283: 
        !           284: retcode() {
        !           285:        register c;
        !           286:        if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
        !           287:                pbstr(scrat);
        !           288:                outtab();
        !           289:                outcode(fcname);
        !           290:                outcode(" = ");
        !           291:                eatup();
        !           292:                outdon();
        !           293:        }
        !           294:        else if (c == '}')
        !           295:                pbstr(scrat);
        !           296:        outtab();
        !           297:        outcode("return");
        !           298:        outdon();
        !           299:        transfer = 1;
        !           300: }
        !           301: 
        !           302: docode() {
        !           303:        transfer = 0;
        !           304:        outtab();
        !           305:        outcode("do ");
        !           306:        yyval = genlab(2);
        !           307:        brkstk[++brkptr] = yyval;
        !           308:        typestk[brkptr] = DO;
        !           309:        brkused[brkptr] = 0;
        !           310:        outnum(yyval);
        !           311:        eatup();
        !           312:        outdon();
        !           313:        indent++;
        !           314: }
        !           315: 
        !           316: dostat(p1) int p1; {
        !           317:        outcont(p1);
        !           318:        indent--;
        !           319:        if (wasbreak)
        !           320:                outcont(p1+1);
        !           321:        brkptr--;
        !           322: }
        !           323: 
        !           324: breakcode() {
        !           325:        int level, t;
        !           326: 
        !           327:        level = 0;
        !           328:        if ((t=gnbtok(scrat)) == DIG)
        !           329:                level = atoi(scrat) - 1;
        !           330:        else if (t != ';')
        !           331:                pbstr(scrat);
        !           332:        if (brkptr-level < 0)
        !           333:                error("illegal BREAK");
        !           334:        else {
        !           335:                outgoto(brkstk[brkptr-level]+1);
        !           336:                brkused[brkptr-level] |= 1;
        !           337:        }
        !           338:        transfer = 1;
        !           339: }
        !           340: 
        !           341: nextcode() {
        !           342:        int level, t;
        !           343: 
        !           344:        level = 0;
        !           345:        if ((t=gnbtok(scrat)) == DIG)
        !           346:                level = atoi(scrat) - 1;
        !           347:        else if (t != ';')
        !           348:                pbstr(scrat);
        !           349:        if (brkptr-level < 0)
        !           350:                error("illegal NEXT");
        !           351:        else {
        !           352:                outgoto(brkstk[brkptr-level]);
        !           353:                brkused[brkptr-level] |= 2;
        !           354:        }
        !           355:        transfer = 1;
        !           356: }
        !           357: 
        !           358: nonblank(s) char *s; {
        !           359:        int c;
        !           360:        while (c = *s++)
        !           361:                if (c!=' ' && c!='\t' && c!='\n')
        !           362:                        return(1);
        !           363:        return(0);
        !           364: }
        !           365: 
        !           366: int    errorflag       = 0;
        !           367: 
        !           368: error(s1) char *s1; {
        !           369:        if (errorflag == 0)
        !           370:                fprintf(stderr, "ratfor:");
        !           371:        fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
        !           372:        fprintf(stderr, s1);
        !           373:        fprintf(stderr, "\n");
        !           374:        errorflag = 1;
        !           375: }
        !           376: 
        !           377: errcode() {
        !           378:        int c;
        !           379:        if (errorflag == 0)
        !           380:                fprintf(stderr, "******\n");
        !           381:        fprintf(stderr, "*****F ratfor:");
        !           382:        fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
        !           383:        while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
        !           384:                ;
        !           385:        if (c == EOF || c == '\0')
        !           386:                putbak(c);
        !           387:        errorflag = 1;
        !           388: }

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