Return to 1.fort.c CVS log

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

Annotation of researchv10no/cmd/struct/1.fort.c, revision 1.1

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

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