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