Commit | Line | Data |
---|---|---|
0d57d6f5 TL |
1 | char *xxxvers[] = "\nFORTRAN 77 PASS 1, VERSION 1.16, 3 NOVEMBER 1978\n"; |
2 | ||
3 | #include "defs" | |
4 | ||
5 | ||
6 | main(argc, argv) | |
7 | int argc; | |
8 | char **argv; | |
9 | { | |
10 | char *s; | |
11 | int k, retcode; | |
12 | FILEP opf(); | |
13 | ||
14 | #define DONE(c) { retcode = c; goto finis; } | |
15 | ||
16 | --argc; | |
17 | ++argv; | |
18 | ||
19 | while(argc>0 && argv[0][0]=='-') | |
20 | { | |
21 | for(s = argv[0]+1 ; *s ; ++s) switch(*s) | |
22 | { | |
23 | case 'w': | |
24 | if(s[1]=='6' && s[2]=='6') | |
25 | { | |
26 | ftn66flag = YES; | |
27 | s += 2; | |
28 | } | |
29 | else | |
30 | nowarnflag = YES; | |
31 | break; | |
32 | ||
33 | case 'U': | |
34 | shiftcase = NO; | |
35 | break; | |
36 | ||
37 | case 'u': | |
38 | undeftype = YES; | |
39 | break; | |
40 | ||
41 | case 'O': | |
42 | optimflag = YES; | |
43 | if( isdigit(s[1]) ) | |
44 | { | |
45 | k = *++s - '0'; | |
46 | if(k > MAXREGVAR) | |
47 | { | |
48 | warn1("-O%d: too many register variables", k); | |
49 | maxregvar = MAXREGVAR; | |
50 | } | |
51 | else | |
52 | maxregvar = k; | |
53 | } | |
54 | break; | |
55 | ||
56 | case 'd': | |
57 | debugflag = YES; | |
58 | break; | |
59 | ||
60 | case 'p': | |
61 | profileflag = YES; | |
62 | break; | |
63 | ||
64 | case 'C': | |
65 | checksubs = YES; | |
66 | break; | |
67 | ||
68 | case '1': | |
69 | onetripflag = YES; | |
70 | break; | |
71 | ||
72 | case 'I': | |
73 | if(*++s == '2') | |
74 | tyint = TYSHORT; | |
75 | else if(*s == '4') | |
76 | { | |
77 | shortsubs = NO; | |
78 | tyint = TYLONG; | |
79 | } | |
80 | else if(*s == 's') | |
81 | shortsubs = YES; | |
82 | else | |
83 | fatal1("invalid flag -I%c\n", *s); | |
84 | tylogical = tyint; | |
85 | break; | |
86 | ||
87 | default: | |
88 | fatal1("invalid flag %c\n", *s); | |
89 | } | |
90 | --argc; | |
91 | ++argv; | |
92 | } | |
93 | ||
94 | if(argc != 4) | |
95 | fatal1("arg count %d", argc); | |
96 | asmfile = opf(argv[1]); | |
97 | initfile = opf(argv[2]); | |
98 | textfile = opf(argv[3]); | |
99 | ||
100 | initkey(); | |
101 | if(inilex( copys(argv[0]) )) | |
102 | DONE(1); | |
103 | fprintf(diagfile, "%s:\n", argv[0]); | |
104 | fileinit(); | |
105 | procinit(); | |
106 | if(k = yyparse()) | |
107 | { | |
108 | fprintf(diagfile, "Bad parse, return code %d\n", k); | |
109 | DONE(1); | |
110 | } | |
111 | if(nerr > 0) | |
112 | DONE(1); | |
113 | if(parstate != OUTSIDE) | |
114 | { | |
115 | warn("missing END statement"); | |
116 | endproc(); | |
117 | } | |
118 | doext(); | |
119 | preven(ALIDOUBLE); | |
120 | prtail(); | |
121 | #if FAMILY==SCJ | |
122 | puteof(); | |
123 | #endif | |
124 | DONE(0); | |
125 | ||
126 | ||
127 | finis: | |
128 | done(retcode); | |
129 | return(retcode); | |
130 | } | |
131 | ||
132 | ||
133 | ||
134 | done(k) | |
135 | int k; | |
136 | { | |
137 | static int recurs = NO; | |
138 | ||
139 | if(recurs == NO) | |
140 | { | |
141 | recurs = YES; | |
142 | clfiles(); | |
143 | } | |
144 | exit(k); | |
145 | } | |
146 | ||
147 | ||
148 | LOCAL FILEP opf(fn) | |
149 | char *fn; | |
150 | { | |
151 | FILEP fp; | |
152 | if( fp = fopen(fn, "w") ) | |
153 | return(fp); | |
154 | ||
155 | fatal1("cannot open intermediate file %s", fn); | |
156 | /* NOTREACHED */ | |
157 | } | |
158 | ||
159 | ||
160 | ||
161 | LOCAL clfiles() | |
162 | { | |
163 | clf(&textfile); | |
164 | clf(&asmfile); | |
165 | clf(&initfile); | |
166 | } | |
167 | ||
168 | ||
169 | clf(p) | |
170 | FILEP *p; | |
171 | { | |
172 | if(p!=NULL && *p!=NULL && *p!=stdout) | |
173 | { | |
174 | if(ferror(*p)) | |
175 | fatal("writing error"); | |
176 | fclose(*p); | |
177 | } | |
178 | *p = NULL; | |
179 | } | |
180 |