Return to r2.c CVS log

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

Annotation of researchv10no/cmd/ratfor/r2.c, revision 1.1

1.1     ! root        1: #include "r.h"
        !             2: 
        !             3: extern int hollerith;
        !             4: extern int uppercase;
        !             5: 
        !             6: char   outbuf[80];
        !             7: int    outp    = 0;
        !             8: int    cont    = 0;
        !             9: int    contchar        = '&';
        !            10: 
        !            11: char   comment[320];
        !            12: int    comptr  = 0;
        !            13: int    indent  = 0;
        !            14: 
        !            15: outdon() {
        !            16:        outbuf[outp] = '\0';
        !            17:        if (outp > 0)
        !            18:                fprintf(outfil, "%s\n", outbuf);
        !            19:        outp = cont = 0;
        !            20: }
        !            21: 
        !            22: putcom(s) char *s; {
        !            23:        if (printcom) {
        !            24:                ptc(uppercase? 'C' : 'c');
        !            25:                outtab();
        !            26:                pts(s);
        !            27:                outdon();
        !            28:        }
        !            29: }
        !            30: 
        !            31: outcode(xp) char *xp; {
        !            32:        register c, c1, j;
        !            33:        char *q, *p, *s;
        !            34: 
        !            35:        p = (char *) xp;        /* shut lint up */
        !            36:        if (cont == 0 && comptr > 0)    /* flush comment if not on continuation */
        !            37:                flushcom();
        !            38:        while( (c = *p++) ){
        !            39:                c1 = *p;
        !            40:                if (isalpha(c) || isdigit(c)) {
        !            41:                        if (uppercase)
        !            42:                                foldup(p-1);
        !            43:                        pts(p-1);
        !            44:                        break;
        !            45:                }
        !            46:                s = NULL;       /* generally set to something like .ge. */
        !            47:                switch(c){
        !            48: 
        !            49:                case '"': case '\'':
        !            50:                        j = 0;
        !            51:                        for (q=p; *q; q++) {
        !            52:                                if (*q == '\\')
        !            53:                                        q++;
        !            54:                                j++;
        !            55:                        }
        !            56:                        if (outp+j+2 > 71)
        !            57:                                contcard();
        !            58:                        if (hollerith) {
        !            59:                                outnum(--j);
        !            60:                                ptc(uppercase ? 'H' : 'h');
        !            61:                        } else
        !            62:                                ptc(c);
        !            63:                        while (*p != c) {
        !            64:                                if (*p == '\\')
        !            65:                                        p++;
        !            66:                                ptc(*p++);
        !            67:                        }
        !            68:                        if (!hollerith)
        !            69:                                ptc(c);
        !            70:                        p++;
        !            71:                        break;
        !            72:                case '$': case '\\':
        !            73:                        if (strlen(p-1)+outp > 71)
        !            74:                                contcard();
        !            75:                        if (c1 == '"' || c1 == '\'') {
        !            76:                                ptc(c1);
        !            77:                                p++;
        !            78:                        } else
        !            79:                                for (p--; *p; p++)
        !            80:                                        ptc(*p);
        !            81:                        break;
        !            82:                case '%':
        !            83:                        outp = 0;
        !            84:                        while (*p)
        !            85:                                ptc(*p++);
        !            86:                        break;
        !            87:                case '>':
        !            88:                        if( c1=='=' ){
        !            89:                                s = ".ge."; p++;
        !            90:                        } else
        !            91:                                s = ".gt.";
        !            92:                        break;
        !            93:                case '<':
        !            94:                        if( c1=='=' ){
        !            95:                                s = ".le."; p++;
        !            96:                        } else if( c1=='>' ){
        !            97:                                s = ".ne."; p++;
        !            98:                        } else
        !            99:                                s = ".lt.";
        !           100:                        break;
        !           101:                case '=':
        !           102:                        if( c1=='=' ){
        !           103:                                s = ".eq."; p++;
        !           104:                        } else
        !           105:                                s = "=";
        !           106:                        break;
        !           107:                case '!': case '^':
        !           108:                        if( c1=='=' ){
        !           109:                                s = ".ne."; p++;
        !           110:                        } else
        !           111:                                s = ".not.";
        !           112:                        break;
        !           113:                case '&':
        !           114:                        if( c1=='&' )
        !           115:                                p++;
        !           116:                        s = ".and.";
        !           117:                        break;
        !           118:                case '|':
        !           119:                        if( c1=='|' )
        !           120:                                p++;
        !           121:                        s = ".or.";
        !           122:                        break;
        !           123:                case '\t':
        !           124:                        outtab();
        !           125:                        break;
        !           126:                case '\n':
        !           127:                        ptc(' ');
        !           128:                        break;
        !           129:                default:
        !           130:                        ptc(c);
        !           131:                        break;
        !           132:                }
        !           133:                if (s != NULL) {
        !           134:                        if (uppercase)
        !           135:                                foldup(s);
        !           136:                        pts(s);
        !           137:                }
        !           138:        }
        !           139: }
        !           140: 
        !           141: foldup(s)      /* convert s to upper case */
        !           142: char *s;
        !           143: {
        !           144:        while (*s) {
        !           145:                if (islower(*s))
        !           146:                        *s = toupper(*s);
        !           147:                s++;
        !           148:        }
        !           149: }
        !           150: 
        !           151: ptc(c) char c; {
        !           152:        if( outp > 71 )
        !           153:                contcard();
        !           154:        outbuf[outp++] = c;
        !           155: }
        !           156: 
        !           157: pts(s) char *s; {
        !           158:        if (strlen(s)+outp > 71)
        !           159:                contcard();
        !           160:        while(*s)
        !           161:                ptc(*s++);
        !           162: }
        !           163: 
        !           164: contcard(){
        !           165:        int n;
        !           166:        outbuf[outp] = '\0';
        !           167:        fprintf(outfil, "%s\n", outbuf);
        !           168:        n = 6;
        !           169:        if (printcom) {
        !           170:                n += INDENT * indent + 1;
        !           171:                if (n > 35) n = 35;
        !           172:        }
        !           173:        for( outp=0; outp<n; outbuf[outp++] = ' ' );
        !           174:        outbuf[contfld-1] = contchar;
        !           175:        cont++;
        !           176:        if (cont > 19)
        !           177:                error("more than 19 continuation cards");
        !           178: }
        !           179: 
        !           180: outtab(){
        !           181:        int n;
        !           182:        n = 6;
        !           183:        if (printcom) {
        !           184:                n += INDENT * indent;
        !           185:                if (n > 35) n = 35;
        !           186:        }
        !           187:        while (outp < n)
        !           188:                ptc(' ');
        !           189: }
        !           190: 
        !           191: outnum(n) int n; {
        !           192:        int a;
        !           193:        if( a = n/10 )
        !           194:                outnum(a);
        !           195:        ptc(n%10 + '0');
        !           196: }
        !           197: 
        !           198: outcont(n) int n; {
        !           199:        transfer = 0;
        !           200:        if (n == 0 && outp == 0)
        !           201:                return;
        !           202:        if( n > 0 )
        !           203:                outnum(n);
        !           204:        outcode("\tcontinue");
        !           205:        outdon();
        !           206: }
        !           207: 
        !           208: outgoto(n) int n; {
        !           209:        if (transfer != 0)
        !           210:                return;
        !           211:        outcode("\tgoto ");
        !           212:        outnum(n);
        !           213:        outdon();
        !           214: }
        !           215: 
        !           216: flushcom() {
        !           217:        int i, j;
        !           218:        if (printcom == 0)
        !           219:                comptr = 0;
        !           220:        else if (cont == 0 && comptr > 0) {
        !           221:                for (i=j=0; i < comptr; i++)
        !           222:                        if (comment[i] == '\n') {
        !           223:                                comment[i] = '\0';
        !           224:                                fprintf(outfil, "%s\n", &comment[j]);
        !           225:                                j = i + 1;
        !           226:                        }
        !           227:                comptr = 0;
        !           228:        }
        !           229: }

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