Return to 1.fort.c CVS log

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

Annotation of 43BSDTahoe/usr.bin/struct/1.fort.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char sccsid[] = "@(#)1.fort.c   4.1     (Berkeley)      2/11/83";
        !             3: #endif not lint
        !             4: 
        !             5: #include <stdio.h>
        !             6: #include "1.incl.h"
        !             7: #include  "1.defs.h"
        !             8: #include "def.h"
        !             9: 
        !            10: 
        !            11: act(k,c,bufptr)
        !            12: int k,bufptr;
        !            13: char c;
        !            14:        {
        !            15:        long ftemp;
        !            16:        struct lablist *makelab();
        !            17:        switch(k)
        !            18:                /*handle labels */
        !            19:                {case 1:
        !            20:                        if (c != ' ')
        !            21:                                {
        !            22:                        ftemp = c - '0';
        !            23:                                newlab->labelt = 10L * newlab->labelt + ftemp;
        !            24: 
        !            25:                                if (newlab->labelt > 99999L)
        !            26:                                        {
        !            27:                                error("in syntax:\n","","");
        !            28:                                        fprintf(stderr,"line %d: label beginning %D too long\n%s\n",
        !            29:                                                begline,newlab->labelt,buffer);
        !            30:                                        fprintf(stderr,"treating line as straight line code\n");
        !            31:                                        return(ABORT);
        !            32:                                        }
        !            33:                                }
        !            34:                        break;
        !            35: 
        !            36:                case 3:  nlabs++;
        !            37:                        newlab = newlab->nxtlab = makelab(0L);
        !            38:                        break;
        !            39: 
        !            40:                /* handle labsw- switches and labels */
        !            41:                /* handle if statements */
        !            42:                case 30:  counter++;  break;
        !            43: 
        !            44:                case 31:
        !            45:                        counter--;
        !            46:                        if (counter)  return(_if1);
        !            47:                        else
        !            48:                                {
        !            49:                                pred = remtilda(stralloc(&buffer[p1],bufptr - p1));
        !            50:                                p3 = bufptr + 1;        /* p3 pts. to 1st symbol after ) */
        !            51:                                flag = 1;
        !            52:                                return(_if2);  }
        !            53: 
        !            54:                case 45:                        /* set p1 to pt.to 1st symbol of pred */
        !            55:                        p1 = bufptr + 1;
        !            56:                        act(30,c,bufptr);  break;
        !            57: 
        !            58:                /* handle do loops */
        !            59:                case 61:  p1 = bufptr;  break;   /* p1 pts. to 1st symbol of increment  string */
        !            60: 
        !            61:                case 62:  counter ++;  break;
        !            62: 
        !            63:                case 63:  counter --; break;
        !            64: 
        !            65:                case 64: 
        !            66:                        if (counter != 0) break;
        !            67:                        act(162,c,bufptr);
        !            68:                        return(ABORT);
        !            69: 
        !            70:                case 70:  if (counter)  return(_rwp);
        !            71:                        r1 = bufptr;
        !            72:                        return(_rwlab);
        !            73: 
        !            74:                case 72:        exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1));  break;
        !            75: 
        !            76:                case 73:  endlab = newlab;  
        !            77:                        break;
        !            78: 
        !            79:                case 74:  errlab = newlab;  
        !            80:                        break;
        !            81: 
        !            82:                case 75:  reflab = newlab;
        !            83:                        act(3,c,bufptr);
        !            84:                        break;
        !            85: 
        !            86:                case 76:  r1 = bufptr;  break;
        !            87: 
        !            88:                case 77:
        !            89:                        if (!counter)
        !            90:                        {
        !            91:                                act(111,c,bufptr);
        !            92:                                return(ABORT);
        !            93:                                }
        !            94:                        counter--;
        !            95:                        break;
        !            96:                /* generate nodes of all types */
        !            97:                case 111:               /* st. line code */
        !            98:                        stcode = remtilda(stralloc(&buffer[p3],endbuf - p3));
        !            99:                        recognize(STLNVX,flag);
        !           100:                        return(ABORT);
        !           101: 
        !           102:                case 122:                       /* uncond. goto */
        !           103:                        recognize(ungo,flag);
        !           104:                        break;
        !           105: 
        !           106:                case 123:                       /* assigned goto */
        !           107:                        act(72,c,bufptr);
        !           108:                        faterr("in parsing:\n","assigned goto must have list of labels","");
        !           109: 
        !           110:                case 124:                       /* ass. goto, labels */
        !           111:                        recognize(ASGOVX, flag);
        !           112:                        break;
        !           113: 
        !           114:                case 125:                       /* computed goto*/
        !           115:                        exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1));
        !           116:                        recognize(COMPVX, flag);
        !           117:                        return(ABORT);
        !           118: 
        !           119:                case 133:                       /* if() =  is a simple statement, so reset flag to 0 */
        !           120:                        flag = 0;
        !           121:                        act(111,c,bufptr);
        !           122:                        return(ABORT);
        !           123: 
        !           124:                case 141:                       /* arith. if */
        !           125:                        recognize(arithif, 0);
        !           126:                        break;
        !           127: 
        !           128:                case 150:                       /* label assignment */
        !           129:                        exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1));
        !           130:                        recognize(ASVX, flag);
        !           131:                        break;
        !           132: 
        !           133:                case 162:                       /*  do node */
        !           134:                        inc = remtilda(stralloc(&buffer[p1],endbuf - p1));
        !           135:                        recognize(DOVX, 0);
        !           136:                        break;
        !           137: 
        !           138:                case 180:                       /* continue statement */
        !           139:                        recognize(contst, 0);
        !           140:                        break;
        !           141: 
        !           142:                case 200:               /* function or subroutine statement */
        !           143:                        progtype = sub;
        !           144:                        nameline = begline;
        !           145:                        recognize(STLNVX,0);
        !           146:                        break;
        !           147: 
        !           148: 
        !           149:                case 210:               /* block data statement */
        !           150:                        progtype = blockdata;
        !           151:                        act(111,c,bufptr);
        !           152:                        return(ABORT);
        !           153: 
        !           154:                case 300:                       /* return statement */
        !           155:                        recognize(RETVX,flag);
        !           156:                        break;
        !           157: 
        !           158: 
        !           159:                case 350:                       /* stop statement */
        !           160:                        recognize(STOPVX, flag);
        !           161:                        break;
        !           162: 
        !           163: 
        !           164:                case 400:                       /* end statement */
        !           165:                        if (progtype == sub)
        !           166:                                act(300, c, bufptr);
        !           167:                        else
        !           168:                                act(350, c, bufptr);
        !           169:                        return(endrt);
        !           170: 
        !           171:                case 500:
        !           172:                        prerw = remtilda(stralloc(&buffer[p3],r1 - p3 + 1));
        !           173:                        postrw = remtilda(stralloc(&buffer[r2],endbuf - r2));
        !           174:                        if (reflab || endlab || errlab)  recognize(IOVX,flag);
        !           175:                        else recognize(STLNVX,flag);
        !           176:                        return(ABORT);
        !           177: 
        !           178:                case 510:  r2 = bufptr;
        !           179:                        act(3,c,bufptr);
        !           180:                        act(500,c,bufptr);
        !           181:                        return(ABORT);
        !           182: 
        !           183:                case 520:               r2 = bufptr;
        !           184:                        reflab = newlab;
        !           185:                        act(3,c,bufptr);
        !           186:                        act(500,c,bufptr);
        !           187:                        return(ABORT);
        !           188: 
        !           189: 
        !           190:                case 600:
        !           191:                        recognize(FMTVX,0);  return(ABORT);
        !           192: 
        !           193:                case 700:
        !           194:                        stcode = remtilda(stralloc(&buffer[p3],endbuf - p3));
        !           195:                        recognize(entry,0);  return(ABORT);
        !           196:                /* error */
        !           197:                case 999:
        !           198:                        printf("error: symbol '%c' should not occur as %d'th symbol of: \n%s\n",
        !           199:                                c,bufptr, buffer);
        !           200:                        return(ABORT);
        !           201:                }
        !           202:        return(nulls);
        !           203:        }
        !           204: 
        !           205: 
        !           206: 
        !           207: struct lablist *makelab(x)
        !           208: long x;
        !           209:        {
        !           210:        struct lablist *p;
        !           211:        p = challoc (sizeof(*p));
        !           212:        p->labelt = x;
        !           213:        p->nxtlab = 0;
        !           214:        return(p);
        !           215:        }
        !           216: 
        !           217: 
        !           218: long label(i)
        !           219: int i;
        !           220:        {
        !           221:        struct lablist *j;
        !           222:        for (j = linelabs; i > 0; i--)
        !           223:                {
        !           224:                if (j == 0) return(0L);
        !           225:                j = j->nxtlab;
        !           226:                }
        !           227:        if (j)
        !           228:                return(j->labelt);
        !           229:        else
        !           230:                return(0L);
        !           231:        }
        !           232: 
        !           233: 
        !           234: freelabs()
        !           235:        {
        !           236:        struct lablist *j,*k;
        !           237:        j = linelabs;
        !           238:        while(j != 0)
        !           239:                {
        !           240:                k = j->nxtlab;
        !           241:                chfree(j,sizeof(*j));
        !           242:                j = k;
        !           243:                }
        !           244:        }
        !           245: 
        !           246: 
        !           247: stralloc(ad,n)                 /* allocate space, copy n chars from address ad, add '0' */
        !           248: int n; char *ad;
        !           249:        {
        !           250:        char *cp;
        !           251:        cp = galloc(n+1);
        !           252:        copycs(ad,cp,n);
        !           253:        return(cp);
        !           254:        }
        !           255: 
        !           256: 
        !           257: remtilda(s)                    /* change ~ to blank */
        !           258: char *s;
        !           259:        {
        !           260:        int i;
        !           261:        for (i = 0; s[i] != '\0'; i++)
        !           262:                if (s[i] == '~') s[i] = ' ';
        !           263:        return(s);
        !           264:        }

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