lang/fortran/comp/gram.exec

   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         ;