2.11BSD#431 - /usr/src/usr.bin/f77/gram.head

   1: %{
   2: #include "defs"
   3: #include "string_defs"
   4: 
   5: #ifdef  C_OVERLAY
   6: #define yyerror(x)  {fprintf(diagfile, "Error on line %d of %s: %s\n", lineno, infname, x); nerr++;}
   7: #else
   8: #define yyerror(x)  error(x, 0, 0, YYERR)
   9: #endif
  10: 
  11: static int nstars;
  12: static int ndim;
  13: static int vartype;
  14: static ftnint varleng;
  15: static struct { ptr lb, ub; } dims[8];
  16: static struct labelblock *labarray[MAXLABLIST];
  17: static int lastwasbranch = NO;
  18: static int thiswasbranch = NO;
  19: extern ftnint yystno;
  20: extern flag intonly;
  21: 
  22: ftnint convci();
  23: double convcd();
  24: struct addrblock *nextdata(), *mkbitcon();
  25: struct constblock *mklogcon(), *mkaddcon(), *mkrealcon();
  26: struct constblock *mkstrcon(), *mkcxcon();
  27: struct listblock *mklist();
  28: struct listblock *mklist();
  29: struct impldoblock *mkiodo();
  30: struct extsym *comblock();
  31: 
  32: %}
  33: 
  34: /* Specify precedences and associativies. */
  35: 
  36: %left SCOMMA
  37: %nonassoc SCOLON
  38: %right SEQUALS
  39: %left SEQV SNEQV
  40: %left SOR
  41: %left SAND
  42: %left SNOT
  43: %nonassoc SLT SGT SLE SGE SEQ SNE
  44: %left SCONCAT
  45: %left SPLUS SMINUS
  46: %left SSTAR SSLASH
  47: %right SPOWER
  48: 
  49: %%
  50: 
  51: program:
  52:     | program stat SEOS
  53:     ;
  54: 
  55: stat:     thislabel entry
  56:         { lastwasbranch = NO; }
  57:     | thislabel  spec
  58:     | thislabel  exec
  59:         { if($1 && ($1->labelno==dorange))
  60:             enddo($1->labelno);
  61:           if(lastwasbranch && thislabel==NULL)
  62:             error("statement cannot be reached",0,0,WARN1);
  63:           lastwasbranch = thiswasbranch;
  64:           thiswasbranch = NO;
  65:         }
  66:     | thislabel SINCLUDE filename
  67:         { doinclude( $3 ); }
  68:     | thislabel  SEND  end_spec
  69:         { lastwasbranch = NO;  endproc(); }
  70:     | thislabel SUNKNOWN
  71:         { error("unclassifiable statement",0,0,EXECERR);  flline(); };
  72:     | error
  73:         { flline();  needkwd = NO;  inioctl = NO;
  74:           yyerrok; yyclearin; }
  75:     ;
  76: 
  77: thislabel:  SLABEL
  78:         {
  79:         if(yystno != 0)
  80:             {
  81:             $$ = thislabel =  mklabel(yystno);
  82:             if( ! headerdone )
  83:                 puthead(NULL, procclass);
  84:             if(thislabel->labdefined)
  85:                 error("label %s already defined",
  86:                     convic(thislabel->stateno),0,EXECERR);
  87:             else    {
  88:                 if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
  89:                     && thislabel->labtype!=LABFORMAT)
  90:                     error("there is a branch to label %s from outside block",
  91:                           convic( (ftnint) (thislabel->stateno) ),0,WARN1);
  92:                 thislabel->blklevel = blklevel;
  93:                 thislabel->labdefined = YES;
  94:                 if(thislabel->labtype != LABFORMAT)
  95:                     putlabel(thislabel->labelno);
  96:                 }
  97:             }
  98:         else    $$ = thislabel = NULL;
  99:         }
 100:     ;
 101: 
 102: entry:    SPROGRAM new_proc progname
 103:         { startproc($3, CLMAIN); }
 104:     | SBLOCK new_proc progname
 105:         { startproc($3, CLBLOCK); }
 106:     | SSUBROUTINE new_proc entryname arglist
 107:         { entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
 108:     | SFUNCTION new_proc entryname arglist
 109:         { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
 110:     | type SFUNCTION new_proc entryname arglist
 111:         { entrypt(CLPROC, $1, varleng, $4, $5); }
 112:     | SENTRY entryname arglist
 113:         { if(parstate==OUTSIDE || procclass==CLMAIN
 114:             || procclass==CLBLOCK)
 115:                 error("misplaced entry statement", 0,0,EXECERR);
 116:           entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
 117:         }
 118:     ;
 119: 
 120: new_proc:
 121:         { newproc(); }
 122:     ;
 123: 
 124: entryname:  name
 125:         { $$ = newentry($1); }
 126:     ;
 127: 
 128: name:     SNAME
 129:         { $$ = mkname(toklen, token); }
 130:     ;
 131: 
 132: progname:       { $$ = NULL; }
 133:     | entryname
 134:     ;
 135: 
 136: arglist:
 137:         { $$ = 0; }
 138:     | SLPAR SRPAR
 139:         { $$ = 0; }
 140:     | SLPAR args SRPAR
 141:         {$$ = $2; }
 142:     ;
 143: 
 144: args:     arg
 145:         { $$ = ($1 ? mkchain($1,0) : 0 ); }
 146:     | args SCOMMA arg
 147:         { if($3) $1 = $$ = hookup($1, mkchain($3,0)); }
 148:     ;
 149: 
 150: arg:      name
 151:         { $1->vstg = STGARG; }
 152:     | SSTAR
 153:         { $$ = 0;  substars = YES; }
 154:     ;
 155: 
 156: 
 157: 
 158: filename:   SHOLLERITH
 159:         {
 160:         char *s;
 161:         s = copyn(toklen+1, token);
 162:         s[toklen] = '\0';
 163:         $$ = s;
 164:         }
 165:     ;

Defined macros