1: /* 2: * Copyright (c) 1980 Regents of the University of California. 3: * All rights reserved. The Berkeley software License Agreement 4: * specifies the terms and conditions for redistribution. 5: * 6: * @(#)gram.head 5.1 (Berkeley) 6/7/85 7: */ 8: 9: /* 10: * gram.head 11: * 12: * First part of the f77 grammar, f77 compiler pass 1. 13: * 14: * University of Utah CS Dept modification history: 15: * 16: * $Log: gram.head,v $ 17: * Revision 3.2 84/11/06 17:40:52 donn 18: * Fixed bug with redundant labels causing errors when they appear on (e.g.) 19: * PROGRAM statements. 20: * 21: * Revision 3.1 84/10/13 00:22:16 donn 22: * Merged Jerry Berkman's version into mine. 23: * 24: * Revision 2.2 84/08/04 21:13:02 donn 25: * Moved some code out of gram.head into gram.exec in accordance with 26: * Jerry Berkman's fixes to make ASSIGNs work right. 27: * 28: * Revision 2.1 84/07/19 12:03:20 donn 29: * Changed comment headers for UofU. 30: * 31: * Revision 1.2 84/03/23 22:43:06 donn 32: * The subroutine argument temporary fixes from Bob Corbett didn't take into 33: * account the fact that the code generator collects all the assignments to 34: * temporaries at the start of a statement -- hence the temporaries need to 35: * be initialized once per statement instead of once per call. 36: * 37: */ 38: 39: %{ 40: # include "defs.h" 41: # include "data.h" 42: 43: #ifdef SDB 44: # include <a.out.h> 45: 46: # ifndef N_SO 47: # include <stab.h> 48: # endif 49: #endif 50: 51: static int equivlisterr; 52: static int do_name_err; 53: static int nstars; 54: static int ndim; 55: static int vartype; 56: static ftnint varleng; 57: static struct { expptr lb, ub; } dims[MAXDIM+1]; 58: static struct Labelblock *labarray[MAXLABLIST]; 59: static int lastwasbranch = NO; 60: static int thiswasbranch = NO; 61: extern ftnint yystno; 62: extern flag intonly; 63: 64: ftnint convci(); 65: double convcd(); 66: expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon(); 67: expptr mkcxcon(); 68: struct Listblock *mklist(); 69: struct Listblock *mklist(); 70: struct Impldoblock *mkiodo(); 71: struct Extsym *comblock(); 72: 73: %} 74: 75: /* Specify precedences and associativities. */ 76: 77: %union { 78: int ival; 79: char *charpval; 80: chainp chval; 81: tagptr tagval; 82: expptr expval; 83: struct Labelblock *labval; 84: struct Nameblock *namval; 85: struct Eqvchain *eqvval; 86: struct Extsym *extval; 87: union Vexpr *vexpval; 88: struct ValList *drvals; 89: struct Vlist *dvals; 90: union Delt *deltp; 91: struct Rpair *rpairp; 92: struct Elist *elistp; 93: } 94: 95: %left SCOMMA 96: %nonassoc SCOLON 97: %right SEQUALS 98: %left SEQV SNEQV 99: %left SOR 100: %left SAND 101: %left SNOT 102: %nonassoc SLT SGT SLE SGE SEQ SNE 103: %left SCONCAT 104: %left SPLUS SMINUS 105: %left SSTAR SSLASH 106: %right SPOWER 107: 108: %start program 109: %type <labval> thislabel label assignlabel 110: %type <tagval> other inelt 111: %type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq 112: %type <charpval> filename 113: %type <chval> namelistlist funarglist funargs dospec 114: %type <chval> callarglist arglist args exprlist inlist outlist out2 substring 115: %type <namval> name arg call var entryname progname 116: %type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr 117: %type <expval> ubound callarg complex_const simple_const 118: %type <extval> common comblock 119: %type <eqvval> equivlist 120: %type <expval> datavalue real_const unsignedreal bit_const 121: %type <vexpval> unsignedint int_const 122: %type <vexpval> dataname 123: %type <vexpval> iconprimary iconfactor iconterm iconexpr opticonexpr 124: %type <drvals> datarval datarvals 125: %type <dvals> iconexprlist datasubs 126: %type <deltp> dataelt dataimplieddo datalval 127: %type <rpairp> datarange 128: %type <elistp> dlist datalvals 129: 130: %% 131: 132: program: 133: | program stat SEOS 134: ; 135: 136: stat: thislabel entry 137: { lastwasbranch = NO; } 138: | thislabel spec 139: | thislabel exec 140: { if($1 && ($1->labelno==dorange)) 141: enddo($1->labelno); 142: if(lastwasbranch && thislabel==NULL) 143: warn("statement cannot be reached"); 144: lastwasbranch = thiswasbranch; 145: thiswasbranch = NO; 146: if($1) 147: { 148: if($1->labtype == LABFORMAT) 149: err("label already that of a format"); 150: else 151: $1->labtype = LABEXEC; 152: } 153: if(!optimflag) 154: { 155: argtemplist = hookup(argtemplist, activearglist); 156: activearglist = CHNULL; 157: } 158: } 159: | thislabel SINCLUDE filename 160: { doinclude( $3 ); } 161: | thislabel SEND end_spec 162: { lastwasbranch = NO; endproc(); } 163: | thislabel SUNKNOWN 164: { execerr("unclassifiable statement", CNULL); flline(); }; 165: | error 166: { flline(); needkwd = NO; inioctl = NO; 167: yyerrok; yyclearin; } 168: ; 169: 170: thislabel: SLABEL 171: { 172: #ifdef SDB 173: if( sdbflag ) 174: { 175: linenostab(lineno); 176: } 177: #endif 178: 179: if(yystno != 0) 180: { 181: $$ = thislabel = mklabel(yystno); 182: if(thislabel->labdefined) 183: execerr("label %s already defined", 184: convic(thislabel->stateno) ); 185: else { 186: if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel 187: && thislabel->labtype!=LABFORMAT) 188: warn1("there is a branch to label %s from outside block", 189: convic( (ftnint) (thislabel->stateno) ) ); 190: thislabel->blklevel = blklevel; 191: thislabel->labdefined = YES; 192: } 193: } 194: else $$ = thislabel = NULL; 195: } 196: ; 197: 198: entry: SPROGRAM new_proc progname 199: {startproc($3, CLMAIN); } 200: | SBLOCK new_proc progname 201: { if($3) NO66("named BLOCKDATA"); 202: startproc($3, CLBLOCK); } 203: | SSUBROUTINE new_proc entryname arglist 204: { entrypt(CLPROC, TYSUBR, (ftnint) 0, $3, $4); } 205: | SFUNCTION new_proc entryname arglist 206: { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); } 207: | type SFUNCTION new_proc entryname arglist 208: { entrypt(CLPROC, $1, varleng, $4, $5); } 209: | SENTRY entryname arglist 210: { if(parstate==OUTSIDE || procclass==CLMAIN 211: || procclass==CLBLOCK) 212: execerr("misplaced entry statement", CNULL); 213: entrypt(CLENTRY, 0, (ftnint) 0, $2, $3); 214: } 215: ; 216: 217: new_proc: 218: { newproc(); } 219: ; 220: 221: entryname: name 222: ; 223: 224: name: SNAME 225: { $$ = mkname(toklen, token); } 226: ; 227: 228: progname: { $$ = NULL; } 229: | entryname 230: ; 231: 232: arglist: 233: { $$ = 0; } 234: | SLPAR SRPAR 235: { NO66(" () argument list"); 236: $$ = 0; } 237: | SLPAR args SRPAR 238: {$$ = $2; } 239: ; 240: 241: args: arg 242: { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL ); } 243: | args SCOMMA arg 244: { if($3) $1 = $$ = hookup($1, mkchain($3,CHNULL)); } 245: ; 246: 247: arg: name 248: { if(($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG) 249: || ($1->vclass == CLPARAM) ) { 250: dclerr("name declared as argument after use", $1); 251: $$ = NULL; 252: } else 253: $1->vstg = STGARG; 254: } 255: | SSTAR 256: { NO66("altenate return argument"); 257: $$ = 0; substars = YES; } 258: ; 259: 260: 261: 262: filename: SHOLLERITH 263: { 264: char *s; 265: s = copyn(toklen+1, token); 266: s[toklen] = '\0'; 267: $$ = s; 268: } 269: ;
|
Last modified: 1985-06-08
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1300 |
|