2.9BSD - /usr/src/cmd/struct/1.fort.c

   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:     }

Defined functions