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