compilers/pcc/pcc-1.0.0/f77/fcom/gram.head

   1 %{
   2
   3 #include "defines.h"
   4 #include "defs.h"
   5
   6 static int nstars;
   7 static int ndim;
   8 static int vartype;
   9 static ftnint varleng;
  10 struct uux dims[8];
  11 static struct labelblock *labarray[100];
  12 static int lastwasbranch = NO;
  13 static int thiswasbranch = NO;
  14
  15 %}
  16
  17 /* Specify precedences and associativies. */
  18
  19 %left SCOMMA
  20 %nonassoc SCOLON
  21 %right SEQUALS
  22 %left SEQV SNEQV
  23 %left SOR
  24 %left SAND
  25 %left SNOT
  26 %nonassoc SLT SGT SLE SGE SEQ SNE
  27 %left SCONCAT
  28 %left SPLUS SMINUS
  29 %left SSTAR SSLASH
  30 %right SPOWER
  31
  32 %union {
  33         struct labelblock *label;
  34         struct extsym *extsym;
  35
  36         bigptr bigptr;
  37         chainp chainp;
  38
  39         ftnint fint;
  40         char *str;
  41         char token;
  42         int num;
  43 }
  44
  45 %type <label>   thislabel label labelval
  46 %type <str>     filename
  47 %type <num>     SLABEL type dcl typename addop relop
  48                 stop nameeq
  49 %type <extsym>  progname entryname common comblock
  50 %type <bigptr>  name var call lhs simple inelt other bit_const
  51                 value simple_const complex_const arg
  52 %type <chainp>  args datavarlist datavar dospec funarglist funargs exprlist
  53                 callarglist inlist outlist out2 equivlist arglist
  54 %type <fint>    lengspec
  55 %type <token>   letter
  56 %type <bigptr>  uexpr callarg opt_expr unpar_fexpr ubound expr fexpr
  57
  58 %%
  59
  60 program:
  61         | program stat SEOS
  62         ;
  63
  64 stat:     thislabel entry
  65                 { lastwasbranch = NO; }
  66         | thislabel  spec
  67         | thislabel  exec
  68                 { if($1 && ($1->labelno==dorange))
  69                         enddo($1->labelno);
  70                   if(lastwasbranch && thislabel==NULL)
  71                         warn1("statement cannot be reached");
  72                   lastwasbranch = thiswasbranch;
  73                   thiswasbranch = NO;
  74                 }
  75         | thislabel SINCLUDE filename
  76                 { doinclude( $3 ); }
  77         | thislabel  SEND  end_spec
  78                 { lastwasbranch = NO;  endproc(); }
  79         | thislabel SUNKNOWN
  80                 { execerr("unclassifiable statement", 0);  flline(); }
  81         | error
  82                 { flline();  needkwd = NO;  inioctl = NO;
  83                   yyerrok; yyclearin; }
  84         ;
  85
  86 thislabel:  SLABEL
  87                 {
  88                 if($1)
  89                         {
  90                         $$ = thislabel =  mklabel( (ftnint) $1);
  91                         if( ! headerdone )
  92                                 puthead(NULL);
  93                         if(thislabel->labdefined)
  94                                 execerr("label %s already defined",
  95                                         convic(thislabel->stateno) );
  96                         else    {
  97                                 if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
  98                                     && thislabel->labtype!=LABFORMAT)
  99                                         warn1("there is a branch to label %s from outside block",
 100                                               convic( (ftnint) (thislabel->stateno) ) );
 101                                 thislabel->blklevel = blklevel;
 102                                 thislabel->labdefined = YES;
 103                                 if(thislabel->labtype != LABFORMAT)
 104                                         putlabel(thislabel->labelno);
 105                                 }
 106                         }
 107                 else    $$ = thislabel = NULL;
 108                 }
 109         ;
 110
 111 entry:    SPROGRAM new_proc progname
 112                 { startproc($3, CLMAIN); }
 113         | SBLOCK new_proc progname
 114                 { startproc($3, CLBLOCK); }
 115         | SSUBROUTINE new_proc entryname arglist
 116                 { entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
 117         | SFUNCTION new_proc entryname arglist
 118                 { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
 119         | type SFUNCTION new_proc entryname arglist
 120                 { entrypt(CLPROC, $1, varleng, $4, $5); }
 121         | SENTRY entryname arglist
 122                 { if(parstate==OUTSIDE || procclass==CLMAIN
 123                         || procclass==CLBLOCK)
 124                                 execerr("misplaced entry statement", 0);
 125                   entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
 126                 }
 127         ;
 128
 129 new_proc:
 130                 { newproc(); }
 131         ;
 132
 133 entryname:  name
 134                 { $$ = newentry($1); }
 135         ;
 136
 137 name:     SFNAME
 138                 { $$ = mkname(toklen, token); }
 139         ;
 140
 141 progname:               { $$ = NULL; }
 142         | entryname
 143         ;
 144
 145 arglist:
 146                 { $$ = 0; }
 147         | SLPAR SRPAR
 148                 { $$ = 0; }
 149         | SLPAR args SRPAR
 150                 {$$ = $2; }
 151         ;
 152
 153 args:     arg
 154                 { $$ = ($1 ? mkchain($1,0) : 0 ); }
 155         | args SCOMMA arg
 156                 { if($3) $1 = $$ = hookup($1, mkchain($3,0)); }
 157         ;
 158
 159 arg:      name
 160                 { $1->vstg = STGARG; }
 161         | SSTAR
 162                 { $$ = 0;  substars = YES; }
 163         ;
 164
 165
 166
 167 filename:   SHOLLERITH
 168                 {
 169                 char *s;
 170                 s = copyn(toklen+1, token);
 171                 s[toklen] = '\0';
 172                 $$ = s;
 173                 }
 174         ;