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