home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / struct / 1.fort.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-01-12  |  4.8 KB  |  261 lines
  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.     }
  261.