![[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] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to gram.head CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 ! root 1: /* @(#)gram.head 1.3 (Berkeley) 6/1/81 */ ! 2: %{ ! 3: # include "defs.h" ! 4: # include "data.h" ! 5: ! 6: #ifdef SDB ! 7: # include <a.out.h> ! 8: ! 9: # ifndef N_SO ! 10: # include <stab.h> ! 11: # endif ! 12: #endif ! 13: ! 14: static int nstars; ! 15: static int ndim; ! 16: static int vartype; ! 17: static ftnint varleng; ! 18: static struct { expptr lb, ub; } dims[MAXDIM+1]; ! 19: static struct Labelblock *labarray[MAXLABLIST]; ! 20: static int lastwasbranch = NO; ! 21: static int thiswasbranch = NO; ! 22: extern ftnint yystno; ! 23: extern flag intonly; ! 24: ! 25: ftnint convci(); ! 26: double convcd(); ! 27: expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon(); ! 28: expptr mkcxcon(); ! 29: struct Listblock *mklist(); ! 30: struct Listblock *mklist(); ! 31: struct Impldoblock *mkiodo(); ! 32: struct Extsym *comblock(); ! 33: ! 34: %} ! 35: ! 36: /* Specify precedences and associativities. */ ! 37: ! 38: %union { ! 39: int ival; ! 40: char *charpval; ! 41: chainp chval; ! 42: tagptr tagval; ! 43: expptr expval; ! 44: struct Labelblock *labval; ! 45: struct Nameblock *namval; ! 46: struct Eqvchain *eqvval; ! 47: struct Extsym *extval; ! 48: union Vexpr *vexpval; ! 49: struct ValList *drvals; ! 50: struct Vlist *dvals; ! 51: union Delt *deltp; ! 52: struct Rpair *rpairp; ! 53: struct Elist *elistp; ! 54: } ! 55: ! 56: %left SCOMMA ! 57: %nonassoc SCOLON ! 58: %right SEQUALS ! 59: %left SEQV SNEQV ! 60: %left SOR ! 61: %left SAND ! 62: %left SNOT ! 63: %nonassoc SLT SGT SLE SGE SEQ SNE ! 64: %left SCONCAT ! 65: %left SPLUS SMINUS ! 66: %left SSTAR SSLASH ! 67: %right SPOWER ! 68: ! 69: %start program ! 70: %type <labval> thislabel label assignlabel ! 71: %type <tagval> other inelt ! 72: %type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq ! 73: %type <charpval> filename ! 74: %type <chval> namelistlist funarglist funargs dospec ! 75: %type <chval> callarglist arglist args exprlist inlist outlist out2 substring ! 76: %type <namval> name arg call var ! 77: %type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr ! 78: %type <expval> ubound callarg complex_const simple_const ! 79: %type <extval> common comblock entryname progname ! 80: %type <eqvval> equivlist ! 81: %type <expval> datavalue real_const unsignedreal bit_const ! 82: %type <vexpval> unsignedint int_const ! 83: %type <vexpval> dataname ! 84: %type <vexpval> iconprimary iconfactor iconterm iconexpr opticonexpr ! 85: %type <drvals> datarval datarvals ! 86: %type <dvals> iconexprlist datasubs ! 87: %type <deltp> dataelt dataimplieddo datalval ! 88: %type <rpairp> datarange ! 89: %type <elistp> dlist datalvals ! 90: ! 91: %% ! 92: ! 93: program: ! 94: | program stat SEOS ! 95: ; ! 96: ! 97: stat: thislabel entry ! 98: { lastwasbranch = NO; } ! 99: | thislabel spec ! 100: | thislabel exec ! 101: { if($1 && ($1->labelno==dorange)) ! 102: enddo($1->labelno); ! 103: if(lastwasbranch && thislabel==NULL) ! 104: warn("statement cannot be reached"); ! 105: lastwasbranch = thiswasbranch; ! 106: thiswasbranch = NO; ! 107: if($1) ! 108: { ! 109: if($1->labtype == LABFORMAT) ! 110: err("label already that of a format"); ! 111: else ! 112: $1->labtype = LABEXEC; ! 113: } ! 114: } ! 115: | thislabel SINCLUDE filename ! 116: { doinclude( $3 ); } ! 117: | thislabel SEND end_spec ! 118: { lastwasbranch = NO; endproc(); } ! 119: | thislabel SUNKNOWN ! 120: { execerr("unclassifiable statement", CNULL); flline(); }; ! 121: | error ! 122: { flline(); needkwd = NO; inioctl = NO; ! 123: yyerrok; yyclearin; } ! 124: ; ! 125: ! 126: thislabel: SLABEL ! 127: { ! 128: #ifdef SDB ! 129: if( sdbflag ) ! 130: { ! 131: linenostab(lineno); ! 132: } ! 133: #endif ! 134: ! 135: if(yystno != 0) ! 136: { ! 137: $$ = thislabel = mklabel(yystno); ! 138: if (parstate == OUTSIDE) ! 139: { ! 140: newproc(); ! 141: startproc(PNULL, CLMAIN); ! 142: parstate = INSIDE; ! 143: } ! 144: if( ! headerdone ) ! 145: puthead(CNULL, procclass); ! 146: if(thislabel->labdefined) ! 147: execerr("label %s already defined", ! 148: convic(thislabel->stateno) ); ! 149: else { ! 150: if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel ! 151: && thislabel->labtype!=LABFORMAT) ! 152: warn1("there is a branch to label %s from outside block", ! 153: convic( (ftnint) (thislabel->stateno) ) ); ! 154: thislabel->blklevel = blklevel; ! 155: thislabel->labdefined = YES; ! 156: if(thislabel->labtype != LABFORMAT) ! 157: if (optimflag) ! 158: optbuff (SKLABEL, 0, ! 159: thislabel->labelno, 1); ! 160: else ! 161: putlabel(thislabel->labelno); ! 162: } ! 163: } ! 164: else $$ = thislabel = NULL; ! 165: } ! 166: ; ! 167: ! 168: entry: SPROGRAM new_proc progname ! 169: {startproc($3, CLMAIN); } ! 170: | SBLOCK new_proc progname ! 171: { if($3) NO66("named BLOCKDATA"); ! 172: startproc($3, CLBLOCK); } ! 173: | SSUBROUTINE new_proc entryname arglist ! 174: { entrypt(CLPROC, TYSUBR, (ftnint) 0, $3, $4); } ! 175: | SFUNCTION new_proc entryname arglist ! 176: { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); } ! 177: | type SFUNCTION new_proc entryname arglist ! 178: { entrypt(CLPROC, $1, varleng, $4, $5); } ! 179: | SENTRY entryname arglist ! 180: { if(parstate==OUTSIDE || procclass==CLMAIN ! 181: || procclass==CLBLOCK) ! 182: execerr("misplaced entry statement", CNULL); ! 183: entrypt(CLENTRY, 0, (ftnint) 0, $2, $3); ! 184: } ! 185: ; ! 186: ! 187: new_proc: ! 188: { newproc(); } ! 189: ; ! 190: ! 191: entryname: name ! 192: { $$ = newentry($1); } ! 193: ; ! 194: ! 195: name: SNAME ! 196: { $$ = mkname(toklen, token); } ! 197: ; ! 198: ! 199: progname: { $$ = NULL; } ! 200: | entryname ! 201: ; ! 202: ! 203: arglist: ! 204: { $$ = 0; } ! 205: | SLPAR SRPAR ! 206: { NO66(" () argument list"); ! 207: $$ = 0; } ! 208: | SLPAR args SRPAR ! 209: {$$ = $2; } ! 210: ; ! 211: ! 212: args: arg ! 213: { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL ); } ! 214: | args SCOMMA arg ! 215: { if($3) $1 = $$ = hookup($1, mkchain($3,CHNULL)); } ! 216: ; ! 217: ! 218: arg: name ! 219: { if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG) ! 220: dclerr("name declared as argument after use", $1); ! 221: $1->vstg = STGARG; ! 222: } ! 223: | SSTAR ! 224: { NO66("altenate return argument"); ! 225: $$ = 0; substars = YES; } ! 226: ; ! 227: ! 228: ! 229: ! 230: filename: SHOLLERITH ! 231: { ! 232: char *s; ! 233: s = copyn(toklen+1, token); ! 234: s[toklen] = '\0'; ! 235: $$ = s; ! 236: } ! 237: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.