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