Commit | Line | Data |
---|---|---|
31cef89c | 1 | char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10, 16 AUGUST 1980\n"; |
47621762 BJ |
2 | |
3 | #include "defs" | |
4 | #include <signal.h> | |
5 | ||
6 | #ifdef SDB | |
7 | # include <a.out.h> | |
31cef89c BJ |
8 | # ifndef N_SO |
9 | # include <stab.h> | |
10 | # endif | |
47621762 BJ |
11 | #endif |
12 | ||
13 | ||
14 | main(argc, argv) | |
15 | int argc; | |
16 | char **argv; | |
17 | { | |
18 | char *s; | |
19 | int k, retcode, *ip; | |
20 | FILEP opf(); | |
21 | int flovflo(); | |
22 | ||
23 | #define DONE(c) { retcode = c; goto finis; } | |
24 | ||
25 | signal(SIGFPE, flovflo); /* catch overflows */ | |
26 | ||
27 | #if HERE == PDP11 | |
28 | ldfps(01200); /* trap on overflow */ | |
29 | #endif | |
30 | ||
31 | ||
32 | ||
33 | --argc; | |
34 | ++argv; | |
35 | ||
36 | while(argc>0 && argv[0][0]=='-') | |
37 | { | |
38 | for(s = argv[0]+1 ; *s ; ++s) switch(*s) | |
39 | { | |
40 | case 'w': | |
41 | if(s[1]=='6' && s[2]=='6') | |
42 | { | |
43 | ftn66flag = YES; | |
44 | s += 2; | |
45 | } | |
46 | else | |
47 | nowarnflag = YES; | |
48 | break; | |
49 | ||
50 | case 'U': | |
51 | shiftcase = NO; | |
52 | break; | |
53 | ||
54 | case 'u': | |
55 | undeftype = YES; | |
56 | break; | |
57 | ||
58 | case 'O': | |
59 | optimflag = YES; | |
60 | if( isdigit(s[1]) ) | |
61 | { | |
62 | k = *++s - '0'; | |
63 | if(k > MAXREGVAR) | |
64 | { | |
65 | warn1("-O%d: too many register variables", k); | |
66 | maxregvar = MAXREGVAR; | |
67 | } | |
68 | else | |
69 | maxregvar = k; | |
70 | } | |
71 | break; | |
72 | ||
73 | case 'd': | |
74 | debugflag = YES; | |
75 | break; | |
76 | ||
77 | case 'p': | |
78 | profileflag = YES; | |
79 | break; | |
80 | ||
81 | case 'C': | |
82 | checksubs = YES; | |
83 | break; | |
84 | ||
85 | case '6': | |
86 | no66flag = YES; | |
87 | noextflag = YES; | |
88 | break; | |
89 | ||
90 | case '1': | |
91 | onetripflag = YES; | |
92 | break; | |
93 | ||
94 | #ifdef SDB | |
95 | case 'g': | |
96 | sdbflag = YES; | |
97 | break; | |
98 | #endif | |
99 | ||
100 | case 'N': | |
101 | switch(*++s) | |
102 | { | |
103 | case 'q': | |
104 | ip = &maxequiv; goto getnum; | |
105 | case 'x': | |
106 | ip = &maxext; goto getnum; | |
107 | case 's': | |
108 | ip = &maxstno; goto getnum; | |
109 | case 'c': | |
110 | ip = &maxctl; goto getnum; | |
111 | case 'n': | |
112 | ip = &maxhash; goto getnum; | |
113 | ||
114 | default: | |
115 | fatali("invalid flag -N%c", *s); | |
116 | } | |
117 | getnum: | |
118 | k = 0; | |
119 | while( isdigit(*++s) ) | |
120 | k = 10*k + (*s - '0'); | |
121 | if(k <= 0) | |
122 | fatal("Table size too small"); | |
123 | *ip = k; | |
124 | break; | |
125 | ||
126 | case 'I': | |
127 | if(*++s == '2') | |
128 | tyint = TYSHORT; | |
129 | else if(*s == '4') | |
130 | { | |
131 | shortsubs = NO; | |
132 | tyint = TYLONG; | |
133 | } | |
134 | else if(*s == 's') | |
135 | shortsubs = YES; | |
136 | else | |
137 | fatali("invalid flag -I%c\n", *s); | |
138 | tylogical = tyint; | |
139 | break; | |
140 | ||
141 | default: | |
142 | fatali("invalid flag %c\n", *s); | |
143 | } | |
144 | --argc; | |
145 | ++argv; | |
146 | } | |
147 | ||
148 | if(argc != 4) | |
149 | fatali("arg count %d", argc); | |
150 | asmfile = opf(argv[1]); | |
151 | initfile = opf(argv[2]); | |
152 | textfile = opf(argv[3]); | |
153 | ||
154 | initkey(); | |
155 | if(inilex( copys(argv[0]) )) | |
156 | DONE(1); | |
157 | fprintf(diagfile, "%s:\n", argv[0]); | |
158 | ||
159 | #ifdef SDB | |
160 | for(s = argv[0] ; ; s += 8) | |
161 | { | |
162 | prstab(s,N_SO,0,0); | |
163 | if( strlen(s) < 8 ) | |
164 | break; | |
165 | } | |
166 | #endif | |
167 | ||
168 | fileinit(); | |
169 | procinit(); | |
170 | if(k = yyparse()) | |
171 | { | |
172 | fprintf(diagfile, "Bad parse, return code %d\n", k); | |
173 | DONE(1); | |
174 | } | |
175 | if(nerr > 0) | |
176 | DONE(1); | |
177 | if(parstate != OUTSIDE) | |
178 | { | |
179 | warn("missing END statement"); | |
180 | endproc(); | |
181 | } | |
182 | doext(); | |
183 | preven(ALIDOUBLE); | |
184 | prtail(); | |
185 | #if FAMILY==PCC | |
186 | puteof(); | |
187 | #endif | |
188 | ||
189 | if(nerr > 0) | |
190 | DONE(1); | |
191 | DONE(0); | |
192 | ||
193 | ||
194 | finis: | |
195 | done(retcode); | |
196 | return(retcode); | |
197 | } | |
198 | ||
199 | ||
200 | ||
201 | done(k) | |
202 | int k; | |
203 | { | |
204 | static int recurs = NO; | |
205 | ||
206 | if(recurs == NO) | |
207 | { | |
208 | recurs = YES; | |
209 | clfiles(); | |
210 | } | |
211 | exit(k); | |
212 | } | |
213 | ||
214 | ||
215 | LOCAL FILEP opf(fn) | |
216 | char *fn; | |
217 | { | |
218 | FILEP fp; | |
219 | if( fp = fopen(fn, "w") ) | |
220 | return(fp); | |
221 | ||
222 | fatalstr("cannot open intermediate file %s", fn); | |
223 | /* NOTREACHED */ | |
224 | } | |
225 | ||
226 | ||
227 | ||
228 | LOCAL clfiles() | |
229 | { | |
230 | clf(&textfile); | |
231 | clf(&asmfile); | |
232 | clf(&initfile); | |
233 | } | |
234 | ||
235 | ||
236 | clf(p) | |
237 | FILEP *p; | |
238 | { | |
239 | if(p!=NULL && *p!=NULL && *p!=stdout) | |
240 | { | |
241 | if(ferror(*p)) | |
242 | fatal("writing error"); | |
243 | fclose(*p); | |
244 | } | |
245 | *p = NULL; | |
246 | } | |
247 | ||
248 | ||
249 | ||
250 | ||
251 | flovflo() | |
252 | { | |
253 | err("floating exception during constant evaluation"); | |
254 | #if HERE == VAX | |
255 | fatal("vax cannot recover from floating exception"); | |
256 | /* vax returns a reserved operand that generates | |
257 | an illegal operand fault on next instruction, | |
258 | which if ignored causes an infinite loop. | |
259 | */ | |
260 | #endif | |
261 | signal(SIGFPE, flovflo); | |
262 | } |