home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / F2C_SRC.ZIP / F2C / GRAM.EXC < prev    next >
Encoding:
Text File  |  1991-06-10  |  3.1 KB  |  144 lines
  1. exec:      iffable
  2.     | SDO end_spec intonlyon label intonlyoff opt_comma dospecw
  3.         {
  4.         if($4->labdefined)
  5.             execerr("no backward DO loops", CNULL);
  6.         $4->blklevel = blklevel+1;
  7.         exdo($4->labelno, NPNULL, $7);
  8.         }
  9.     | SDO end_spec opt_comma dospecw
  10.         {
  11.         exdo((int)(ctls - ctlstack - 2), NPNULL, $4);
  12.         NOEXT("DO without label");
  13.         }
  14.     | SENDDO
  15.         { exenddo(NPNULL); }
  16.     | logif iffable
  17.         { exendif();  thiswasbranch = NO; }
  18.     | logif STHEN
  19.     | SELSEIF end_spec SLPAR expr SRPAR STHEN
  20.         { exelif($4); lastwasbranch = NO; }
  21.     | SELSE end_spec
  22.         { exelse(); lastwasbranch = NO; }
  23.     | SENDIF end_spec
  24.         { exendif(); lastwasbranch = NO; }
  25.     ;
  26.  
  27. logif:      SLOGIF end_spec SLPAR expr SRPAR
  28.         { exif($4); }
  29.     ;
  30.  
  31. dospec:      name SEQUALS exprlist
  32.         { $$ = mkchain((char *)$1, $3); }
  33.     ;
  34.  
  35. dospecw:  dospec
  36.     | SWHILE SLPAR expr SRPAR
  37.         { $$ = mkchain(CNULL, (chainp)$3); }
  38.     ;
  39.  
  40. iffable:  let lhs SEQUALS expr
  41.         { exequals((struct Primblock *)$2, $4); }
  42.     | SASSIGN end_spec assignlabel STO name
  43.         { exassign($5, $3); }
  44.     | SCONTINUE end_spec
  45.     | goto
  46.     | io
  47.         { inioctl = NO; }
  48.     | SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
  49.         { exarif($4, $6, $8, $10);  thiswasbranch = YES; }
  50.     | call
  51.         { excall($1, LBNULL, 0, labarray); }
  52.     | call SLPAR SRPAR
  53.         { excall($1, LBNULL, 0, labarray); }
  54.     | call SLPAR callarglist SRPAR
  55.         { if(nstars < MAXLABLIST)
  56.             excall($1, mklist(revchain($3)), nstars, labarray);
  57.           else
  58.             err("too many alternate returns");
  59.         }
  60.     | SRETURN end_spec opt_expr
  61.         { exreturn($3);  thiswasbranch = YES; }
  62.     | stop end_spec opt_expr
  63.         { exstop($1, $3);  thiswasbranch = $1; }
  64.     ;
  65.  
  66. assignlabel:   SICON
  67.         { $$ = mklabel( convci(toklen, token) ); }
  68.     ;
  69.  
  70. let:      SLET
  71.         { if(parstate == OUTSIDE)
  72.             {
  73.             newproc();
  74.             startproc(ESNULL, CLMAIN);
  75.             }
  76.         }
  77.     ;
  78.  
  79. goto:      SGOTO end_spec label
  80.         { exgoto($3);  thiswasbranch = YES; }
  81.     | SASGOTO end_spec name
  82.         { exasgoto($3);  thiswasbranch = YES; }
  83.     | SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
  84.         { exasgoto($3);  thiswasbranch = YES; }
  85.     | SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
  86.         { if(nstars < MAXLABLIST)
  87.             putcmgo(putx(fixtype($7)), nstars, labarray);
  88.           else
  89.             err("computed GOTO list too long");
  90.         }
  91.     ;
  92.  
  93. opt_comma:
  94.     | SCOMMA
  95.     ;
  96.  
  97. call:      SCALL end_spec name
  98.         { nstars = 0; $$ = $3; }
  99.     ;
  100.  
  101. callarglist:  callarg
  102.         { $$ = $1 ? mkchain((char *)$1,CHNULL) : CHNULL; }
  103.     | callarglist SCOMMA callarg
  104.         { $$ = $3 ? mkchain((char *)$3, $1) : $1; }
  105.     ;
  106.  
  107. callarg:  expr
  108.     | SSTAR label
  109.         { if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; }
  110.     ;
  111.  
  112. stop:      SPAUSE
  113.         { $$ = 0; }
  114.     | SSTOP
  115.         { $$ = 1; }
  116.     ;
  117.  
  118. exprlist:  expr
  119.         { $$ = mkchain((char *)$1, CHNULL); }
  120.     | exprlist SCOMMA expr
  121.         { $$ = hookup($1, mkchain((char *)$3,CHNULL) ); }
  122.     ;
  123.  
  124. end_spec:
  125.         { if(parstate == OUTSIDE)
  126.             {
  127.             newproc();
  128.             startproc(ESNULL, CLMAIN);
  129.             }
  130.  
  131. /* This next statement depends on the ordering of the state table encoding */
  132.  
  133.           if(parstate < INDATA) enddcl();
  134.         }
  135.     ;
  136.  
  137. intonlyon:
  138.         { intonly = YES; }
  139.     ;
  140.  
  141. intonlyoff:
  142.         { intonly = NO; }
  143.     ;
  144.