Return to r1.c CVS log

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

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

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