![[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] / 3BSD / cmd / f77|
Return to main.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / f77 |
1.1 root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.