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

Defined functions

act defined in line 11; used 14 times
freelabs defined in line 234; used 1 times
label defined in line 218; used 49 times
makelab defined in line 207; used 4 times
remtilda defined in line 257; used 9 times
stralloc defined in line 247; used 10 times

Defined variables

sccsid defined in line 2; never used
Last modified: 1983-02-12
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 911
Valid CSS Valid XHTML 1.0 Strict