1%{ 2 3#include "defines.h" 4#include "defs.h" 5 6static int nstars; 7static int ndim; 8static int vartype; 9static ftnint varleng; 10struct uux dims[8]; 11static struct labelblock *labarray[100]; 12static int lastwasbranch = NO; 13static 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 60program: 61 | program stat SEOS 62 ; 63 64stat: 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 86thislabel: 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 111entry: 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 129new_proc: 130 { newproc(); } 131 ; 132 133entryname: name 134 { $$ = newentry($1); } 135 ; 136 137name: SFNAME 138 { $$ = mkname(toklen, token); } 139 ; 140 141progname: { $$ = NULL; } 142 | entryname 143 ; 144 145arglist: 146 { $$ = 0; } 147 | SLPAR SRPAR 148 { $$ = 0; } 149 | SLPAR args SRPAR 150 {$$ = $2; } 151 ; 152 153args: arg 154 { $$ = ($1 ? mkchain($1,0) : 0 ); } 155 | args SCOMMA arg 156 { if($3) $1 = $$ = hookup($1, mkchain($3,0)); } 157 ; 158 159arg: name 160 { $1->vstg = STGARG; } 161 | SSTAR 162 { $$ = 0; substars = YES; } 163 ; 164 165 166 167filename: SHOLLERITH 168 { 169 char *s; 170 s = copyn(toklen+1, token); 171 s[toklen] = '\0'; 172 $$ = s; 173 } 174 ; 175