![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to main.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to main.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10, 16 AUGUST 1980\n";
2:
3: #include "defs.h"
4: #include <signal.h>
5:
6: #ifdef SDB
7: # include <a.out.h>
8: # ifndef N_SO
9: # include <stab.h>
10: # endif
11: #endif
12:
13:
14: LOCAL char *textname = "";
15: LOCAL char *asmname = "";
16: LOCAL char *initname = "";
17:
18:
19: extern intexit();
20:
21:
22: main(argc, argv)
23: int argc;
24: char **argv;
25: {
26: char *s;
27: int k, retcode, *ip;
28: FILEP opf();
29: int flovflo();
30:
31: #define DONE(c) { retcode = c; goto finis; }
32:
33: signal(SIGFPE, flovflo); /* catch overflows */
34: signal(SIGINT, intexit);
35:
36: #if HERE == PDP11
37: ldfps(01200); /* trap on overflow */
38: #endif
39:
40:
41:
42: --argc;
43: ++argv;
44:
45: while(argc>0 && argv[0][0]=='-')
46: {
47: for(s = argv[0]+1 ; *s ; ++s) switch(*s)
48: {
49: case 'w':
50: if(s[1]=='6' && s[2]=='6')
51: {
52: ftn66flag = YES;
53: s += 2;
54: }
55: else
56: nowarnflag = YES;
57: break;
58:
59: case 'U':
60: shiftcase = NO;
61: break;
62:
63: case 'u':
64: undeftype = YES;
65: break;
66:
67: case 'O':
68: optimflag = YES;
69: break;
70:
71: case 'd':
72: debugflag[0] = YES;
73:
74: while (*s == 'd' || *s == ',')
75: {
76: k = 0;
77: while( isdigit(*++s) )
78: k = 10*k + (*s - '0');
79: if(k < 0 || k >= MAXDEBUGFLAG)
80: fatali("bad debug number %d",k);
81: debugflag[k] = YES;
82: }
83: break;
84:
85: case 'p':
86: profileflag = YES;
87: break;
88:
89: case 'C':
90: checksubs = YES;
91: break;
92:
93: case '6':
94: no66flag = YES;
95: noextflag = YES;
96: break;
97:
98: case '1':
99: onetripflag = YES;
100: break;
101:
102: #ifdef SDB
103: case 'g':
104: sdbflag = YES;
105: break;
106: #endif
107:
108: case 'N':
109: switch(*++s)
110: {
111: case 'q':
112: ip = &maxequiv; goto getnum;
113: case 'x':
114: ip = &maxext; goto getnum;
115: case 's':
116: ip = &maxstno; goto getnum;
117: case 'c':
118: ip = &maxctl; goto getnum;
119: case 'n':
120: ip = &maxhash; goto getnum;
121:
122: default:
123: fatali("invalid flag -N%c", *s);
124: }
125: getnum:
126: k = 0;
127: while( isdigit(*++s) )
128: k = 10*k + (*s - '0');
129: if(k <= 0)
130: fatal("Table size too small");
131: *ip = k;
132: break;
133:
134: case 'i':
135: if(*++s == '2')
136: tyint = TYSHORT;
137: else if(*s == '4')
138: {
139: shortsubs = NO;
140: tyint = TYLONG;
141: }
142: else if(*s == 's')
143: shortsubs = YES;
144: else
145: fatali("invalid flag -i%c\n", *s);
146: tylogical = tyint;
147: break;
148:
149: default:
150: fatali("invalid flag %c\n", *s);
151: }
152: --argc;
153: ++argv;
154: }
155:
156: if(argc != 4)
157: fatali("arg count %d", argc);
158: textname = argv[3];
159: initname = argv[2];
160: asmname = argv[1];
161: asmfile = opf(argv[1]);
162: initfile = opf(argv[2]);
163: textfile = opf(argv[3]);
164:
165: initkey();
166: if(inilex( copys(argv[0]) ))
167: DONE(1);
168: fprintf(diagfile, "%s:\n", argv[0]);
169:
170: #ifdef SDB
171: filenamestab(argv[0]);
172: #endif
173:
174: fileinit();
175: procinit();
176: if(k = yyparse())
177: {
178: fprintf(diagfile, "Bad parse, return code %d\n", k);
179: DONE(1);
180: }
181: if(nerr > 0)
182: DONE(1);
183: if(parstate != OUTSIDE)
184: {
185: warn("missing END statement");
186: endproc();
187: }
188: doext();
189: preven(ALIDOUBLE);
190: prtail();
191: #if FAMILY==PCC
192: puteof();
193: #endif
194:
195: if(nerr > 0)
196: DONE(1);
197: DONE(0);
198:
199:
200: finis:
201: done(retcode);
202: }
203:
204:
205:
206: done(k)
207: int k;
208: {
209: static char *ioerror = "i/o error on intermediate file %s\n";
210:
211: if (textfile != NULL && textfile != stdout)
212: {
213: if (ferror(textfile))
214: {
215: fprintf(diagfile, ioerror, textname);
216: k = 3;
217: }
218: fclose(textfile);
219: }
220:
221: if (asmfile != NULL && asmfile != stdout)
222: {
223: if (ferror(asmfile))
224: {
225: fprintf(diagfile, ioerror, asmname);
226: k = 3;
227: }
228: fclose(asmfile);
229: }
230:
231: if (initfile != NULL && initfile != stdout)
232: {
233: if (ferror(initfile))
234: {
235: fprintf(diagfile, ioerror, initname);
236: k = 3;
237: }
238: fclose(initfile);
239: }
240:
241: rmtmpfiles();
242:
243: exit(k);
244: }
245:
246:
247: LOCAL FILEP opf(fn)
248: char *fn;
249: {
250: FILEP fp;
251: if( fp = fopen(fn, "w") )
252: return(fp);
253:
254: fatalstr("cannot open intermediate file %s", fn);
255: /* NOTREACHED */
256: }
257:
258:
259:
260: clf(p)
261: FILEP *p;
262: {
263: if(p!=NULL && *p!=NULL && *p!=stdout)
264: {
265: if(ferror(*p))
266: fatal("writing error");
267: fclose(*p);
268: }
269: *p = NULL;
270: }
271:
272:
273:
274:
275: flovflo()
276: {
277: err("floating exception during constant evaluation");
278: #if HERE == VAX
279: fatal("vax cannot recover from floating exception");
280: rmtmpfiles();
281: /* vax returns a reserved operand that generates
282: an illegal operand fault on next instruction,
283: which if ignored causes an infinite loop.
284: */
285: #endif
286: signal(SIGFPE, flovflo);
287: }
288:
289:
290:
291: rmtmpfiles()
292: {
293: close(vdatafile);
294: unlink(vdatafname);
295: close(vchkfile);
296: unlink(vchkfname);
297: close(cdatafile);
298: unlink(cdatafname);
299: close(cchkfile);
300: unlink(cchkfname);
301: }
302:
303:
304:
305: intexit()
306: {
307: done(1);
308: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.