![[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] / 3BSD / cmd / f77|
Return to gram.head CVS log | Up to [CSRG BSD Unix] / 3BSD / 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: #endif
11:
12: static int nstars;
13: static int ndim;
14: static int vartype;
15: static ftnint varleng;
16: static struct { ptr lb, ub; } dims[MAXDIM+1];
17: static struct Labelblock *labarray[MAXLABLIST];
18: static int lastwasbranch = NO;
19: static int thiswasbranch = NO;
20: extern ftnint yystno;
21:
22: ftnint convci();
23: double convcd();
24: struct Addrblock *nextdata(), *mkbitcon();
25: struct Constblock *mklogcon(), *mkaddcon(), *mkrealcon();
26: struct Constblock *mkstrcon(), *mkcxcon();
27: struct Listblock *mklist();
28: struct Listblock *mklist();
29: struct Impldoblock *mkiodo();
30: struct Extsym *comblock();
31:
32: %}
33:
34: /* Specify precedences and associativies. */
35:
36: %left SCOMMA
37: %nonassoc SCOLON
38: %right SEQUALS
39: %left SEQV SNEQV
40: %left SOR
41: %left SAND
42: %left SNOT
43: %nonassoc SLT SGT SLE SGE SEQ SNE
44: %left SCONCAT
45: %left SPLUS SMINUS
46: %left SSTAR SSLASH
47: %right SPOWER
48:
49: %%
50:
51: program:
52: | program stat SEOS
53: ;
54:
55: stat: thislabel entry
56: { lastwasbranch = NO; }
57: | thislabel spec
58: | thislabel exec
59: { if($1 && ($1->labelno==dorange))
60: enddo($1->labelno);
61: if(lastwasbranch && thislabel==NULL)
62: warn("statement cannot be reached");
63: lastwasbranch = thiswasbranch;
64: thiswasbranch = NO;
65: if($1)
66: {
67: if($1->labtype == LABFORMAT)
68: err("label already that of a format");
69: else
70: $1->labtype = LABEXEC;
71: }
72: }
73: | thislabel SINCLUDE filename
74: { doinclude( $3 ); }
75: | thislabel SEND end_spec
76: { lastwasbranch = NO; endproc(); }
77: | thislabel SUNKNOWN
78: { execerr("unclassifiable statement", 0); flline(); };
79: | error
80: { flline(); needkwd = NO; inioctl = NO;
81: yyerrok; yyclearin; }
82: ;
83:
84: thislabel: SLABEL
85: {
86: #ifdef SDB
87: char buff[10];
88: if( sdbflag )
89: {
90: # ifdef UCBVAXASM
91: p2pass( stabdline(N_SLINE, lineno) );
92: # else
93: sprintf(buff,"LL%d", ++dbglabel);
94: p2pass( stabline(0, N_SLINE, lineno, buff) );
95: p2pi("LL%d:\n", dbglabel);
96: # endif
97: }
98: #endif
99:
100: if(yystno != 0)
101: {
102: $$ = thislabel = mklabel(yystno);
103: if( ! headerdone )
104: puthead(NULL, procclass);
105: if(thislabel->labdefined)
106: execerr("label %s already defined",
107: convic(thislabel->stateno) );
108: else {
109: if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
110: && thislabel->labtype!=LABFORMAT)
111: warn1("there is a branch to label %s from outside block",
112: convic( (ftnint) (thislabel->stateno) ) );
113: thislabel->blklevel = blklevel;
114: thislabel->labdefined = YES;
115: if(thislabel->labtype != LABFORMAT)
116: putlabel(thislabel->labelno);
117: }
118: }
119: else $$ = thislabel = NULL;
120: }
121: ;
122:
123: entry: SPROGRAM new_proc progname
124: {startproc($3, CLMAIN); }
125: | SBLOCK new_proc progname
126: { if($3) NO66("named BLOCKDATA");
127: startproc($3, CLBLOCK); }
128: | SSUBROUTINE new_proc entryname arglist
129: { entrypt(CLPROC, TYSUBR, (ftnint) 0, $3, $4); }
130: | SFUNCTION new_proc entryname arglist
131: { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
132: | type SFUNCTION new_proc entryname arglist
133: { entrypt(CLPROC, $1, varleng, $4, $5); }
134: | SENTRY entryname arglist
135: { if(parstate==OUTSIDE || procclass==CLMAIN
136: || procclass==CLBLOCK)
137: execerr("misplaced entry statement", 0);
138: entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
139: }
140: ;
141:
142: new_proc:
143: { newproc(); }
144: ;
145:
146: entryname: name
147: { $$ = newentry($1); }
148: ;
149:
150: name: SNAME
151: { $$ = mkname(toklen, token); }
152: ;
153:
154: progname: { $$ = NULL; }
155: | entryname
156: ;
157:
158: arglist:
159: { $$ = 0; }
160: | SLPAR SRPAR
161: { NO66(" () argument list");
162: $$ = 0; }
163: | SLPAR args SRPAR
164: {$$ = $2; }
165: ;
166:
167: args: arg
168: { $$ = ($1 ? mkchain($1,0) : 0 ); }
169: | args SCOMMA arg
170: { if($3) $1 = $$ = hookup($1, mkchain($3,0)); }
171: ;
172:
173: arg: name
174: { if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
175: dclerr("name declared as argument after use", $1);
176: $1->vstg = STGARG;
177: }
178: | SSTAR
179: { NO66("altenate return argument");
180: $$ = 0; substars = YES; }
181: ;
182:
183:
184:
185: filename: SHOLLERITH
186: {
187: char *s;
188: s = copyn(toklen+1, token);
189: s[toklen] = '\0';
190: $$ = s;
191: }
192: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.