![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gram.head CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to gram.head CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1 |
1.1 ! root 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: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.