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