Commit | Line | Data |
---|---|---|
832026c6 C |
1 | #include "defs" |
2 | #include <ctype.h> | |
3 | ||
4 | static int indent; | |
5 | ||
6 | char *verb[] = { " ", " ", "continue", "call ", "do ", "if ", "if ", | |
7 | "goto ", "return", "read ", "write ", "format ", "stop ", | |
8 | "data ", "equivalence ", "common ", "external ", | |
9 | "rewind", "backspace", "endfile", | |
10 | "subroutine ", "function ", "program", "blockdata", "end", CNULL }; | |
11 | ||
12 | extern char *ops[]; | |
13 | ptr getsii(); | |
14 | ||
15 | /* generate code */ | |
16 | ||
17 | pass2() | |
18 | { | |
19 | exnull(); | |
20 | if(comments) putcomment(); | |
21 | if(verbose) | |
22 | fprintf(diagfile, " Pass 2\n"); | |
23 | ||
24 | dclsect = 0; | |
25 | indent = 0; | |
26 | ||
27 | namegen(); | |
28 | dclgen(); | |
29 | body(iefile); | |
30 | datas(); | |
31 | body(icfile); | |
32 | ||
33 | p2stmt(0); | |
34 | p2key(FEND); | |
35 | p2flush(); | |
36 | if(verbose) | |
37 | fprintf(diagfile, " Pass 2 done\n"); | |
38 | } | |
39 | \f | |
40 | datas() | |
41 | { | |
42 | register int c, n; | |
43 | int n1; | |
44 | ||
45 | rewii(idfile); | |
46 | swii(idfile); | |
47 | ||
48 | for( ; ; ) | |
49 | { | |
50 | c = getic(&n1); | |
51 | n = n1; | |
52 | switch(c) | |
53 | { | |
54 | case ICEOF: | |
55 | return; | |
56 | ||
57 | case ICMARK: | |
58 | break; | |
59 | ||
60 | case ICBLANK: | |
61 | putblank(n); | |
62 | break; | |
63 | ||
64 | case ICNAME: | |
65 | if(*ftnames[n] == '\0') | |
66 | fatal1("no name for n=%d", n); | |
67 | p2stmt(0); | |
68 | p2key(FDATA); | |
69 | p2str( ftnames[n] ); | |
70 | break; | |
71 | ||
72 | case ICOP: | |
73 | p2str( ops[n] ); | |
74 | break; | |
75 | ||
76 | case ICCONST: | |
77 | p2str( getsii(n) ); | |
78 | break; | |
79 | ||
80 | default: | |
81 | fatal1("datas: invalid intermediate tag %d", c); | |
82 | } | |
83 | } | |
84 | } | |
85 | \f | |
86 | body(fileadd) | |
87 | struct fileblock **fileadd; | |
88 | { | |
89 | int n1; | |
90 | register int n; | |
91 | register int c; | |
92 | int prevc; | |
93 | int ifn; | |
94 | ||
95 | rewii(fileadd); | |
96 | swii(fileadd); | |
97 | ||
98 | prevc = 0; | |
99 | ifn = 0; | |
100 | ||
101 | for(;;) | |
102 | { | |
103 | c = getic(&n1); | |
104 | n = n1; | |
105 | switch(c) | |
106 | { | |
107 | case ICEOF: | |
108 | return; | |
109 | ||
110 | case ICBEGIN: | |
111 | if(n != 0) | |
112 | { | |
113 | if(prevc) | |
114 | p2key(FCONTINUE); | |
115 | else prevc = 1; | |
116 | p2stmt( stnos[n] ); | |
117 | } | |
118 | else if(!prevc) p2stmt(0); | |
119 | break; | |
120 | ||
121 | case ICKEYWORD: | |
122 | p2key(n); | |
123 | if(n != FIF2) | |
124 | break; | |
125 | getic(&ifn); | |
126 | if( indifs[ifn] ) | |
127 | skipuntil(ICMARK) ; | |
128 | break; | |
129 | ||
130 | case ICOP: | |
131 | p2str( ops[n] ); | |
132 | break; | |
133 | ||
134 | case ICNAME: | |
135 | if(*ftnames[n]=='\0') | |
136 | fatal1("no name for n=%d", n); | |
137 | p2str( ftnames[n] ); | |
138 | break; | |
139 | ||
140 | case ICCOMMENT: | |
141 | if(prevc) | |
142 | p2key(FCONTINUE); | |
143 | p2com(n); | |
144 | break; | |
145 | ||
146 | case ICBLANK: | |
147 | putblank(n); | |
148 | break; | |
149 | ||
150 | case ICCONST: | |
151 | p2str( getsii(n) ); | |
152 | break; | |
153 | ||
154 | case ICINDPTR: | |
155 | n = indifs[n]; | |
156 | ||
157 | case ICLABEL: | |
158 | p2str(" "); | |
159 | p2int( stnos[n] ); | |
160 | break; | |
161 | ||
162 | case ICMARK: | |
163 | if( indifs[ifn] ) | |
164 | { | |
165 | p2str(" "); | |
166 | p2key(FGOTO); | |
167 | p2int( stnos[ indifs[ifn] ] ); | |
168 | } | |
169 | else | |
170 | { | |
171 | skipuntil(ICINDENT); | |
172 | p2str(" "); | |
173 | } | |
174 | break; | |
175 | ||
176 | case ICINDENT: | |
177 | indent = n * INDENTSPACES; | |
178 | p2indent(indent); | |
179 | break; | |
180 | ||
181 | default: | |
182 | sprintf(msg, "Bad pass2 value %o,%o", c,n); | |
183 | fatal(msg); | |
184 | break; | |
185 | } | |
186 | if(c!=ICBEGIN && c!=ICINDENT) | |
187 | prevc = 0; | |
188 | } | |
189 | } | |
190 | \f | |
191 | putname(p) | |
192 | register ptr p; | |
193 | { | |
194 | register int i; | |
195 | ||
196 | if(p->vextbase) | |
197 | { | |
198 | putic(ICNAME, p->vextbase); | |
199 | return; | |
200 | } | |
201 | ||
202 | for(i=0 ; i<NFTNTYPES ; ++i) | |
203 | if(p->vbase[i]) | |
204 | { | |
205 | putic(ICNAME, p->vbase[i]); | |
206 | return; | |
207 | } | |
208 | if(strlen(p->sthead->namep) <= XL) | |
209 | fatal1("no fortran slot for name %s", p->sthead->namep); | |
210 | } | |
211 | ||
212 | ||
213 | ||
214 | putconst(ty, p) | |
215 | int ty; | |
216 | char *p; | |
217 | { | |
218 | ptr mkchcon(); | |
219 | ||
220 | if(ty != TYCHAR) | |
221 | putsii(ICCONST,p); | |
222 | else /* change character constant to a variable */ | |
223 | putname( mkchcon(p) ); | |
224 | } | |
225 | ||
226 | ||
227 | putzcon(p) | |
228 | register ptr p; | |
229 | { | |
230 | char buff[100]; | |
231 | sprintf(buff, "(%s,%s)", p->leftp, p->rightp); | |
232 | putsii(ICCONST,buff); | |
233 | } | |
234 | ||
235 | ||
236 | ||
237 | ||
238 | ||
239 | ||
240 | putcomment() | |
241 | { | |
242 | register ptr p; | |
243 | ||
244 | for(p = comments ; p ; p = p->nextp) | |
245 | { | |
246 | putsii(ICCOMMENT, p->datap); | |
247 | cfree(p->datap); | |
248 | } | |
249 | frchain(&comments); | |
250 | } | |
251 | ||
252 | ||
253 | putblank(n) | |
254 | int n; | |
255 | { | |
256 | while(n-- > 0) | |
257 | p2putc(' '); | |
258 | } | |
259 | ||
260 | ||
261 | ||
262 | skipuntil(k) | |
263 | int k; | |
264 | { | |
265 | register int i; | |
266 | int n; | |
267 | ||
268 | while( (i = getic(&n))!=k && i!=ICEOF) | |
269 | if(i==ICCOMMENT || i==ICCONST) | |
270 | getsii(n); | |
271 | } | |
272 | \f | |
273 | ||
274 | p2int(n) /* put an integer constant in the output */ | |
275 | int n; | |
276 | { | |
277 | p2str( convic(n) ); | |
278 | } | |
279 | ||
280 | ||
281 | ||
282 | ||
283 | p2key(n) /* print a keyword */ | |
284 | int n; | |
285 | { | |
286 | p2str( verb[n] ); | |
287 | } | |
288 | ||
289 | ||
290 | ||
291 | p2str(s) /* write a character string on the output */ | |
292 | char *s; | |
293 | { | |
294 | int n; | |
295 | ||
296 | n = strlen(s); | |
297 | if(nftnch==LINESPACES-1 && (n==1 || (n==2 && s[1]==' ')) ) | |
298 | p2putc(s[0]); | |
299 | ||
300 | else { | |
301 | if( n<=LINESPACES && nftnch+n>LINESPACES-1 ) | |
302 | p2line( min(LINESPACES-n , indent+INDENTSPACES) ); | |
303 | ||
304 | while(*s) | |
305 | p2putc(*s++); | |
306 | } | |
307 | } | |
308 | ||
309 | ||
310 | ||
311 | p2stmt(n) /* start a statement with label n */ | |
312 | int n; | |
313 | { | |
314 | if(n > 0) | |
315 | fprintf(codefile,"\n%4d ", n); | |
316 | else fprintf(codefile,"\n "); | |
317 | ||
318 | nftnch = 0; | |
319 | nftncont = 0; | |
320 | } | |
321 | ||
322 | ||
323 | p2com(n) /* copy a comment */ | |
324 | int n; | |
325 | { | |
326 | register int k; | |
327 | register char *q; | |
328 | ||
329 | q = getsii(n); | |
330 | if(q[0] == '%') /* a literal escape line */ | |
331 | { | |
332 | putc('\n', codefile); | |
333 | while(--n > 0) | |
334 | putc(*++q, codefile); | |
335 | } | |
336 | else /* actually a comment line */ | |
337 | { | |
338 | ++q; | |
339 | --n; | |
340 | ||
341 | do { | |
342 | k = (n>71 ? 71 : n); | |
343 | fprintf(codefile, "\n"); | |
344 | putc( tailor.ftnsys==CRAY ? 'C' : 'c' , codefile); | |
345 | while(k-- > 0) | |
346 | putc(*q++, codefile); | |
347 | n -= 71; | |
348 | } | |
349 | while(n > 0); | |
350 | } | |
351 | } | |
352 | ||
353 | ||
354 | ||
355 | ||
356 | p2flush() | |
357 | { | |
358 | if(nftnch > 0) | |
359 | { | |
360 | fprintf(codefile, "\n"); | |
361 | nftnch = 0; | |
362 | } | |
363 | } | |
364 | ||
365 | ||
366 | ||
367 | ||
368 | p2putc(c) | |
369 | char c; | |
370 | { | |
371 | if(nftnch >= LINESPACES) /* end of line */ | |
372 | p2line(0); | |
373 | if(tailor.ftnsys == CRAY) | |
374 | putc( islower(c) ? toupper(c) : c , codefile); | |
375 | else | |
376 | putc(c, codefile); | |
377 | ++nftnch; | |
378 | } | |
379 | ||
380 | ||
381 | ||
382 | p2line(in) | |
383 | int in; | |
384 | { | |
385 | register char contchar; | |
386 | ||
387 | if(++nftncont > 19) | |
388 | { | |
389 | execerr("too many continuation lines", CNULL); | |
390 | contchar = 'X'; | |
391 | } | |
392 | if(tailor.ftncontnu == 1) | |
393 | fprintf(codefile, "\n&"); | |
394 | else { /* standard column-6 continuation */ | |
395 | if(nftncont < 20) | |
396 | contchar = "0123456789ABCDEFGHIJ" [nftncont]; | |
397 | fprintf(codefile, "\n %c", contchar); | |
398 | } | |
399 | ||
400 | nftnch = 0; | |
401 | if(in > 0) | |
402 | p2indent(in); | |
403 | } | |
404 | ||
405 | ||
406 | ||
407 | p2indent(n) | |
408 | register int n; | |
409 | { | |
410 | while(n-- > 0) | |
411 | p2putc(' '); | |
412 | } |