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

Defined functions

act defined in line 12; used 14 times
freelabs defined in line 235; used 1 times
label defined in line 219; used 49 times
makelab defined in line 208; used 4 times
remtilda defined in line 258; used 10 times
stralloc defined in line 248; used 10 times

Defined variables

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