![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pass2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / efl|
Return to pass2.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / efl |
1.1 root 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:
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:
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:
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:
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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.