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