source: mainline/uspace/app/pcc/f77/fcom/gram.head@ 91b673d8

%{

#include "defines.h"
#include "defs.h"

static int nstars;
static int ndim;
static int vartype;
static ftnint varleng;
struct uux dims[8];
static struct labelblock *labarray[100];
static int lastwasbranch = NO;
static int thiswasbranch = NO;

%}

/* Specify precedences and associativies. */

%left SCOMMA
%nonassoc SCOLON
%right SEQUALS
%left SEQV SNEQV
%left SOR
%left SAND
%left SNOT
%nonassoc SLT SGT SLE SGE SEQ SNE
%left SCONCAT
%left SPLUS SMINUS
%left SSTAR SSLASH
%right SPOWER

%union {
        struct labelblock *label;
        struct extsym *extsym;

        bigptr bigptr;
        chainp chainp;

        ftnint fint;
        char *str;
        char token;
        int num;
}

%type <label>   thislabel label labelval
%type <str>     filename
%type <num>     SLABEL type dcl typename addop relop
                stop nameeq
%type <extsym>  progname entryname common comblock
%type <bigptr>  name var call lhs simple inelt other bit_const
                value simple_const complex_const arg
%type <chainp>  args datavarlist datavar dospec funarglist funargs exprlist
                callarglist inlist outlist out2 equivlist arglist
%type <fint>    lengspec
%type <token>   letter
%type <bigptr>  uexpr callarg opt_expr unpar_fexpr ubound expr fexpr

%%

program:
        | program stat SEOS
        ;

stat:     thislabel entry
                { lastwasbranch = NO; }
        | thislabel  spec
        | thislabel  exec
                { if($1 && ($1->labelno==dorange))
                        enddo($1->labelno);
                  if(lastwasbranch && thislabel==NULL)
                        warn1("statement cannot be reached");
                  lastwasbranch = thiswasbranch;
                  thiswasbranch = NO;
                }
        | thislabel SINCLUDE filename
                { doinclude( $3 ); }
        | thislabel  SEND  end_spec
                { lastwasbranch = NO;  endproc(); }
        | thislabel SUNKNOWN
                { execerr("unclassifiable statement", 0);  flline(); }
        | error
                { flline();  needkwd = NO;  inioctl = NO; 
                  yyerrok; yyclearin; }
        ;

thislabel:  SLABEL
                {
                if($1)
                        {
                        $$ = thislabel =  mklabel( (ftnint) $1);
                        if( ! headerdone )
                                puthead(NULL);
                        if(thislabel->labdefined)
                                execerr("label %s already defined",
                                        convic(thislabel->stateno) );
                        else    {
                                if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
                                    && thislabel->labtype!=LABFORMAT)
                                        warn1("there is a branch to label %s from outside block",
                                              convic( (ftnint) (thislabel->stateno) ) );
                                thislabel->blklevel = blklevel;
                                thislabel->labdefined = YES;
                                if(thislabel->labtype != LABFORMAT)
                                        putlabel(thislabel->labelno);
                                }
                        }
                else    $$ = thislabel = NULL;
                }
        ;

entry:    SPROGRAM new_proc progname
                { startproc($3, CLMAIN); }
        | SBLOCK new_proc progname
                { startproc($3, CLBLOCK); }
        | SSUBROUTINE new_proc entryname arglist
                { entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
        | SFUNCTION new_proc entryname arglist
                { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
        | type SFUNCTION new_proc entryname arglist
                { entrypt(CLPROC, $1, varleng, $4, $5); }
        | SENTRY entryname arglist
                { if(parstate==OUTSIDE || procclass==CLMAIN
                        || procclass==CLBLOCK)
                                execerr("misplaced entry statement", 0);
                  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
                }
        ;

new_proc:
                { newproc(); }
        ;

entryname:  name
                { $$ = newentry($1); }
        ;

name:     SFNAME
                { $$ = mkname(toklen, token); }
        ;

progname:               { $$ = NULL; }
        | entryname
        ;

arglist:
                { $$ = 0; }
        | SLPAR SRPAR
                { $$ = 0; }
        | SLPAR args SRPAR
                {$$ = $2; }
        ;

args:     arg
                { $$ = ($1 ? mkchain($1,0) : 0 ); }
        | args SCOMMA arg
                { if($3) $1 = $$ = hookup($1, mkchain($3,0)); }
        ;

arg:      name
                { $1->vstg = STGARG; }
        | SSTAR
                { $$ = 0;  substars = YES; }
        ;



filename:   SHOLLERITH
                {
                char *s;
                s = copyn(toklen+1, token);
                s[toklen] = '\0';
                $$ = s;
                }
        ;