Return to r1.c CVS log

Up to [CSRG BSD Unix] / 43BSD / usr.bin / ratfor

Annotation of 43BSD/usr.bin/ratfor/r1.c, revision 1.1

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

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