![[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] / 40BSD / cmd / f77|
Return to main.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / f77 |
1.1 root 1: char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10, 16 AUGUST 1980\n";
2:
3: #include "defs"
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: 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.