![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to output.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f2c|
Return to output.c CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 root 1: /****************************************************************
2: Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore.
3:
4: Permission to use, copy, modify, and distribute this software
5: and its documentation for any purpose and without fee is hereby
6: granted, provided that the above copyright notice appear in all
7: copies and that both that the copyright notice and this
8: permission notice and warranty disclaimer appear in supporting
9: documentation, and that the names of AT&T Bell Laboratories or
10: Bellcore or any of their entities not be used in advertising or
11: publicity pertaining to distribution of the software without
12: specific, written prior permission.
13:
14: AT&T and Bellcore disclaim all warranties with regard to this
15: software, including all implied warranties of merchantability
16: and fitness. In no event shall AT&T or Bellcore be liable for
17: any special, indirect or consequential damages or any damages
18: whatsoever resulting from loss of use, data or profits, whether
19: in an action of contract, negligence or other tortious action,
20: arising out of or in connection with the use or performance of
21: this software.
22: ****************************************************************/
23:
24: #include "defs.h"
25: #include "names.h"
26: #include "output.h"
27:
28: #ifndef TRUE
29: #define TRUE 1
30: #endif
31: #ifndef FALSE
32: #define FALSE 0
33: #endif
34:
35: char _assoc_table[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 };
36:
37: /* Opcode table -- This array is indexed by the OP_____ macros defined in
38: defines.h; these macros are expected to be adjacent integers, so that
39: this table is as small as possible. */
40:
41: table_entry opcode_table[] = {
42: { 0, 0, NULL },
43: /* OPPLUS 1 */ { BINARY_OP, 12, "%l + %r" },
44: /* OPMINUS 2 */ { BINARY_OP, 12, "%l - %r" },
45: /* OPSTAR 3 */ { BINARY_OP, 13, "%l * %r" },
46: /* OPSLASH 4 */ { BINARY_OP, 13, "%l / %r" },
47: /* OPPOWER 5 */ { BINARY_OP, 0, "power (%l, %r)" },
48: /* OPNEG 6 */ { UNARY_OP, 14, "-%l" },
49: /* OPOR 7 */ { BINARY_OP, 4, "%l || %r" },
50: /* OPAND 8 */ { BINARY_OP, 5, "%l && %r" },
51: /* OPEQV 9 */ { BINARY_OP, 9, "%l == %r" },
52: /* OPNEQV 10 */ { BINARY_OP, 9, "%l != %r" },
53: /* OPNOT 11 */ { UNARY_OP, 14, "! %l" },
54: /* OPCONCAT 12 */ { BINARY_OP, 0, "concat (%l, %r)" },
55: /* OPLT 13 */ { BINARY_OP, 10, "%l < %r" },
56: /* OPEQ 14 */ { BINARY_OP, 9, "%l == %r" },
57: /* OPGT 15 */ { BINARY_OP, 10, "%l > %r" },
58: /* OPLE 16 */ { BINARY_OP, 10, "%l <= %r" },
59: /* OPNE 17 */ { BINARY_OP, 9, "%l != %r" },
60: /* OPGE 18 */ { BINARY_OP, 10, "%l >= %r" },
61: /* OPCALL 19 */ { BINARY_OP, 15, SPECIAL_FMT },
62: /* OPCCALL 20 */ { BINARY_OP, 15, SPECIAL_FMT },
63:
64: /* Left hand side of an assignment cannot have outermost parens */
65:
66: /* OPASSIGN 21 */ { BINARY_OP, 2, "%l = %r" },
67: /* OPPLUSEQ 22 */ { BINARY_OP, 2, "%l += %r" },
68: /* OPSTAREQ 23 */ { BINARY_OP, 2, "%l *= %r" },
69: /* OPCONV 24 */ { BINARY_OP, 14, "%l" },
70: /* OPLSHIFT 25 */ { BINARY_OP, 11, "%l << %r" },
71: /* OPMOD 26 */ { BINARY_OP, 13, "%l %% %r" },
72: /* OPCOMMA 27 */ { BINARY_OP, 1, "%l, %r" },
73:
74: /* Don't want to nest the colon operator in parens */
75:
76: /* OPQUEST 28 */ { BINARY_OP, 3, "%l ? %r" },
77: /* OPCOLON 29 */ { BINARY_OP, 3, "%l : %r" },
78: /* OPABS 30 */ { UNARY_OP, 0, "abs(%l)" },
79: /* OPMIN 31 */ { BINARY_OP, 0, SPECIAL_FMT },
80: /* OPMAX 32 */ { BINARY_OP, 0, SPECIAL_FMT },
81: /* OPADDR 33 */ { UNARY_OP, 14, "&%l" },
82:
83: /* OPCOMMA_ARG 34 */ { BINARY_OP, 15, SPECIAL_FMT },
84: /* OPBITOR 35 */ { BINARY_OP, 6, "%l | %r" },
85: /* OPBITAND 36 */ { BINARY_OP, 8, "%l & %r" },
86: /* OPBITXOR 37 */ { BINARY_OP, 7, "%l ^ %r" },
87: /* OPBITNOT 38 */ { UNARY_OP, 14, "~ %l" },
88: /* OPRSHIFT 39 */ { BINARY_OP, 11, "%l >> %r" },
89:
90: /* This isn't quite right -- it doesn't handle arrays, for instance */
91:
92: /* OPWHATSIN 40 */ { UNARY_OP, 14, "*%l" },
93: /* OPMINUSEQ 41 */ { BINARY_OP, 2, "%l -= %r" },
94: /* OPSLASHEQ 42 */ { BINARY_OP, 2, "%l /= %r" },
95: /* OPMODEQ 43 */ { BINARY_OP, 2, "%l %%= %r" },
96: /* OPLSHIFTEQ 44 */ { BINARY_OP, 2, "%l <<= %r" },
97: /* OPRSHIFTEQ 45 */ { BINARY_OP, 2, "%l >>= %r" },
98: /* OPBITANDEQ 46 */ { BINARY_OP, 2, "%l &= %r" },
99: /* OPBITXOREQ 47 */ { BINARY_OP, 2, "%l ^= %r" },
100: /* OPBITOREQ 48 */ { BINARY_OP, 2, "%l |= %r" },
101: /* OPPREINC 49 */ { UNARY_OP, 14, "++%l" },
102: /* OPPREDEC 50 */ { UNARY_OP, 14, "--%l" },
103: /* OPDOT 51 */ { BINARY_OP, 15, "%l.%r" },
104: /* OPARROW 52 */ { BINARY_OP, 15, "%l -> %r"},
105: /* OPNEG1 53 */ { UNARY_OP, 14, "-%l" },
106: /* OPDMIN 54 */ { BINARY_OP, 0, "dmin(%l,%r)" },
107: /* OPDMAX 55 */ { BINARY_OP, 0, "dmax(%l,%r)" },
108: /* OPASSIGNI 56 */ { BINARY_OP, 2, "%l = &%r" },
109: /* OPIDENTITY 57 */ { UNARY_OP, 15, "%l" },
110: /* OPCHARCAST 58 */ { UNARY_OP, 14, "(char *)&%l" },
111: /* OPDABS 59 */ { UNARY_OP, 0, "dabs(%l)" },
112: /* OPMIN2 60 */ { BINARY_OP, 0, "min(%l,%r)" },
113: /* OPMAX2 61 */ { BINARY_OP, 0, "max(%l,%r)" },
114:
115: /* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
116:
117: /* OPNEG KLUDGE */ { UNARY_OP, 14, "-(doublereal)%l" }
118: }; /* opcode_table */
119:
120: #define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
121:
122: static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
123:
124:
125: static void output_prim ();
126: static void output_unary (), output_binary (), output_arg_list ();
127: static void output_list (), output_literal ();
128:
129:
130: void expr_out (fp, e)
131: FILE *fp;
132: expptr e;
133: {
134: if (e == (expptr) NULL)
135: return;
136:
137: switch (e -> tag) {
138: case TNAME: out_name (fp, (struct Nameblock *) e);
139: return;
140:
141: case TCONST: out_const(fp, &e->constblock);
142: goto end_out;
143: case TEXPR:
144: break;
145:
146: case TADDR: out_addr (fp, &(e -> addrblock));
147: goto end_out;
148:
149: case TPRIM: warn ("expr_out: got TPRIM");
150: output_prim (fp, &(e -> primblock));
151: return;
152:
153: case TLIST: output_list (fp, &(e -> listblock));
154: end_out: frexpr(e);
155: return;
156:
157: case TIMPLDO: err ("expr_out: got TIMPLDO");
158: return;
159:
160: case TERROR:
161: default:
162: erri ("expr_out: bad tag '%d'", e -> tag);
163: } /* switch */
164:
165: /* Now we know that the tag is TEXPR */
166:
167: /* Optimize on simple expressions, such as "a = a + b" ==> "a += b" */
168:
169: if (e -> exprblock.opcode == OPASSIGN && e -> exprblock.rightp &&
170: e -> exprblock.rightp -> tag == TEXPR) {
171: int opcode;
172:
173: opcode = e -> exprblock.rightp -> exprblock.opcode;
174:
175: if (opeqable[opcode]) {
176: expptr leftp, rightp;
177:
178: if ((leftp = e -> exprblock.leftp) &&
179: (rightp = e -> exprblock.rightp -> exprblock.leftp)) {
180:
181: if (same_ident (leftp, rightp)) {
182: expptr temp = e -> exprblock.rightp;
183:
184: e -> exprblock.opcode = op_assign(opcode);
185:
186: e -> exprblock.rightp = temp -> exprblock.rightp;
187: temp->exprblock.rightp = 0;
188: frexpr(temp);
189: } /* if same_ident (leftp, rightp) */
190: } /* if leftp && rightp */
191: } /* if opcode == OPPLUS || */
192: } /* if e -> exprblock.opcode == OPASSIGN */
193:
194:
195: /* Optimize on increment or decrement by 1 */
196:
197: {
198: int opcode = e -> exprblock.opcode;
199: expptr leftp = e -> exprblock.leftp;
200: expptr rightp = e -> exprblock.rightp;
201:
202: if (leftp && rightp && (leftp -> headblock.vstg == STGARG ||
203: ISINT (leftp -> headblock.vtype)) &&
204: (opcode == OPPLUSEQ || opcode == OPMINUSEQ) &&
205: ISINT (rightp -> headblock.vtype) &&
206: ISICON (e -> exprblock.rightp) &&
207: (ISONE (e -> exprblock.rightp) ||
208: e -> exprblock.rightp -> constblock.Const.ci == -1)) {
209:
210: /* Allow for the '-1' constant value */
211:
212: if (!ISONE (e -> exprblock.rightp))
213: opcode = (opcode == OPPLUSEQ) ? OPMINUSEQ : OPPLUSEQ;
214:
215: /* replace the existing opcode */
216:
217: if (opcode == OPPLUSEQ)
218: e -> exprblock.opcode = OPPREINC;
219: else
220: e -> exprblock.opcode = OPPREDEC;
221:
222: /* Free up storage used by the right hand side */
223:
224: frexpr (e -> exprblock.rightp);
225: e->exprblock.rightp = 0;
226: } /* if opcode == OPPLUS */
227: } /* block */
228:
229:
230: if (is_unary_op (e -> exprblock.opcode))
231: output_unary (fp, &(e -> exprblock));
232: else if (is_binary_op (e -> exprblock.opcode))
233: output_binary (fp, &(e -> exprblock));
234: else
235: erri ("expr_out: bad opcode '%d'", (int) e -> exprblock.opcode);
236:
237: free((char *)e);
238:
239: } /* expr_out */
240:
241:
242: void out_and_free_statement (outfile, expr)
243: FILE *outfile;
244: expptr expr;
245: {
246: if (expr)
247: expr_out (outfile, expr);
248:
249: nice_printf (outfile, ";\n");
250: } /* out_and_free_statement */
251:
252:
253:
254: int same_ident (left, right)
255: expptr left, right;
256: {
257: if (!left || !right)
258: return 0;
259:
260: if (left -> tag == TNAME && right -> tag == TNAME && left == right)
261: return 1;
262:
263: if (left -> tag == TADDR && right -> tag == TADDR &&
264: left -> addrblock.uname_tag == right -> addrblock.uname_tag)
265: switch (left -> addrblock.uname_tag) {
266: case UNAM_REF:
267: case UNAM_NAME:
268:
269: /* Check for array subscripts */
270:
271: if (left -> addrblock.user.name -> vdim ||
272: right -> addrblock.user.name -> vdim)
273: if (left -> addrblock.user.name !=
274: right -> addrblock.user.name ||
275: !same_expr (left -> addrblock.memoffset,
276: right -> addrblock.memoffset))
277: return 0;
278:
279: return same_ident ((expptr) (left -> addrblock.user.name),
280: (expptr) right -> addrblock.user.name);
281: case UNAM_IDENT:
282: return strcmp(left->addrblock.user.ident,
283: right->addrblock.user.ident) == 0;
284: case UNAM_CHARP:
285: return strcmp(left->addrblock.user.Charp,
286: right->addrblock.user.Charp) == 0;
287: default:
288: return 0;
289: } /* switch */
290:
291: if (left->tag == TEXPR && left->exprblock.opcode == OPWHATSIN
292: && right->tag == TEXPR && right->exprblock.opcode == OPWHATSIN)
293: return same_ident(left->exprblock.leftp,
294: right->exprblock.leftp);
295:
296: return 0;
297: } /* same_ident */
298:
299: static int
300: samefpconst(c1, c2, n)
301: register Constp c1, c2;
302: register int n;
303: {
304: char *s1, *s2;
305: if (!c1->vstg && !c2->vstg)
306: return c1->Const.cd[n] == c2->Const.cd[n];
307: s1 = c1->vstg ? c1->Const.cds[n] : dtos(c1->Const.cd[n]);
308: s2 = c2->vstg ? c2->Const.cds[n] : dtos(c2->Const.cd[n]);
309: return !strcmp(s1, s2);
310: }
311:
312: static int
313: sameconst(c1, c2)
314: register Constp c1, c2;
315: {
316: switch(c1->vtype) {
317: case TYCOMPLEX:
318: case TYDCOMPLEX:
319: if (!samefpconst(c1,c2,1))
320: return 0;
321: case TYREAL:
322: case TYDREAL:
323: return samefpconst(c1,c2,0);
324: case TYCHAR:
325: return c1->Const.ccp1.blanks == c2->Const.ccp1.blanks
326: && c1->vleng->constblock.Const.ci
327: == c2->vleng->constblock.Const.ci
328: && !memcmp(c1->Const.ccp, c2->Const.ccp,
329: (int)c1->vleng->constblock.Const.ci);
330: case TYSHORT:
331: case TYINT:
332: case TYLOGICAL:
333: return c1->Const.ci == c2->Const.ci;
334: }
335: err("unexpected type in sameconst");
336: return 0;
337: }
338:
339: /* same_expr -- Returns true only if e1 and e2 match. This is
340: somewhat pessimistic, but can afford to be because it's just used to
341: optimize on the assignment operators (+=, -=, etc). */
342:
343: int same_expr (e1, e2)
344: expptr e1, e2;
345: {
346: if (!e1 || !e2)
347: return !e1 && !e2;
348:
349: if (e1 -> tag != e2 -> tag || e1 -> headblock.vtype != e2 -> headblock.vtype)
350: return 0;
351:
352: switch (e1 -> tag) {
353: case TEXPR:
354: if (e1 -> exprblock.opcode != e2 -> exprblock.opcode)
355: return 0;
356:
357: return same_expr (e1 -> exprblock.leftp, e2 -> exprblock.leftp) &&
358: same_expr (e1 -> exprblock.rightp, e2 -> exprblock.rightp);
359: case TNAME:
360: case TADDR:
361: return same_ident (e1, e2);
362: case TCONST:
363: return sameconst(&e1->constblock, &e2->constblock);
364: default:
365: return 0;
366: } /* switch */
367: } /* same_expr */
368:
369:
370:
371: void out_name (fp, namep)
372: FILE *fp;
373: Namep namep;
374: {
375: extern int usedefsforcommon;
376: Extsym *comm;
377:
378: if (namep == NULL)
379: return;
380:
381: /* DON'T want to use oneof_stg() here; need to find the right common name
382: */
383:
384: if (namep->vstg == STGCOMMON && !namep->vcommequiv && !usedefsforcommon) {
385: comm = &extsymtab[namep->vardesc.varno];
386: extern_out(fp, comm);
387: nice_printf(fp, "%d.", comm->curno);
388: } /* if namep -> vstg == STGCOMMON */
389:
390: if (namep->vprocclass == PTHISPROC && namep->vtype != TYSUBR)
391: nice_printf(fp, xretslot[namep->vtype]->user.ident);
392: else
393: nice_printf (fp, "%s", namep->cvarname);
394: } /* out_name */
395:
396:
397: static char *Longfmt = "%ld";
398:
399: #define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
400:
401: void out_const(fp, cp)
402: FILE *fp;
403: register Constp cp;
404: {
405: static char real_buf[50], imag_buf[50];
406: unsigned int k;
407: int type = cp->vtype;
408:
409: switch (type) {
410: case TYINT1:
411: case TYSHORT:
412: nice_printf (fp, "%ld", cp->Const.ci); /* don't cast ci! */
413: break;
414: case TYLONG:
415: #ifdef TYQUAD
416: case TYQUAD:
417: #endif
418: nice_printf (fp, Longfmt, cp->Const.ci); /* don't cast ci! */
419: break;
420: case TYREAL:
421: nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
422: break;
423: case TYDREAL:
424: nice_printf(fp, "%s", cpd(0));
425: break;
426: case TYCOMPLEX:
427: nice_printf(fp, cm_fmt_string, flconst(real_buf, cpd(0)),
428: flconst(imag_buf, cpd(1)));
429: break;
430: case TYDCOMPLEX:
431: nice_printf(fp, dcm_fmt_string, cpd(0), cpd(1));
432: break;
433: case TYLOGICAL1:
434: case TYLOGICAL2:
435: case TYLOGICAL:
436: nice_printf (fp, "%s", cp->Const.ci ? "TRUE_" : "FALSE_");
437: break;
438: case TYCHAR: {
439: char *c = cp->Const.ccp, *ce;
440:
441: if (c == NULL) {
442: nice_printf (fp, "\"\"");
443: break;
444: } /* if c == NULL */
445:
446: nice_printf (fp, "\"");
447: ce = c + cp->vleng->constblock.Const.ci;
448: while(c < ce) {
449: k = *(unsigned char *)c++;
450: nice_printf(fp, str_fmt[k], k);
451: }
452: for(k = cp->Const.ccp1.blanks; k > 0; k--)
453: nice_printf(fp, " ");
454: nice_printf (fp, "\"");
455: break;
456: } /* case TYCHAR */
457: default:
458: erri ("out_const: bad type '%d'", (int) type);
459: break;
460: } /* switch */
461:
462: } /* out_const */
463: #undef cpd
464:
465: static void
466: out_args(fp, ep) FILE *fp; expptr ep;
467: {
468: chainp arglist;
469:
470: if(ep->tag != TLIST)
471: badtag("out_args", ep->tag);
472: for(arglist = ep->listblock.listp;;) {
473: expr_out(fp, (expptr)arglist->datap);
474: arglist->datap = 0;
475: if (!(arglist = arglist->nextp))
476: break;
477: nice_printf(fp, ", ");
478: }
479: }
480:
481:
482: /* out_addr -- this routine isn't local because it is called by the
483: system-generated identifier printing routines */
484:
485: void out_addr (fp, addrp)
486: FILE *fp;
487: struct Addrblock *addrp;
488: {
489: extern Extsym *extsymtab;
490: int was_array = 0;
491: char *s;
492:
493:
494: if (addrp == NULL)
495: return;
496: if (doin_setbound
497: && addrp->vstg == STGARG
498: && addrp->vtype != TYCHAR
499: && ISICON(addrp->memoffset)
500: && !addrp->memoffset->constblock.Const.ci)
501: nice_printf(fp, "*");
502:
503: switch (addrp -> uname_tag) {
504: case UNAM_REF:
505: nice_printf(fp, "%s_%s(", addrp->user.name->cvarname,
506: addrp->cmplx_sub ? "subscr" : "ref");
507: out_args(fp, addrp->memoffset);
508: nice_printf(fp, ")");
509: return;
510: case UNAM_NAME:
511: out_name (fp, addrp -> user.name);
512: break;
513: case UNAM_IDENT:
514: if (*(s = addrp->user.ident) == ' ') {
515: if (multitype)
516: nice_printf(fp, "%s",
517: xretslot[addrp->vtype]->user.ident);
518: else
519: nice_printf(fp, "%s", s+1);
520: }
521: else {
522: nice_printf(fp, "%s", s);
523: }
524: break;
525: case UNAM_CHARP:
526: nice_printf(fp, "%s", addrp->user.Charp);
527: break;
528: case UNAM_EXTERN:
529: extern_out (fp, &extsymtab[addrp -> memno]);
530: break;
531: case UNAM_CONST:
532: switch(addrp->vstg) {
533: case STGCONST:
534: out_const(fp, (Constp)addrp);
535: break;
536: case STGMEMNO:
537: output_literal (fp, (int)addrp->memno,
538: (Constp)addrp);
539: break;
540: default:
541: Fatal("unexpected vstg in out_addr");
542: }
543: break;
544: case UNAM_UNKNOWN:
545: default:
546: nice_printf (fp, "Unknown Addrp");
547: break;
548: } /* switch */
549:
550: /* It's okay to just throw in the brackets here because they have a
551: precedence level of 15, the highest value. */
552:
553: if ((addrp->uname_tag == UNAM_NAME && addrp->user.name->vdim
554: || addrp->ntempelt > 1 || addrp->isarray)
555: && addrp->vtype != TYCHAR) {
556: expptr offset;
557:
558: was_array = 1;
559:
560: offset = addrp -> memoffset;
561: addrp->memoffset = 0;
562: if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
563: && addrp -> uname_tag == UNAM_NAME
564: && !addrp->skip_offset)
565: offset = mkexpr (OPMINUS, offset, mkintcon (
566: addrp -> user.name -> voffset));
567:
568: nice_printf (fp, "[");
569:
570: offset = mkexpr (OPSLASH, offset,
571: ICON (typesize[addrp -> vtype] * (addrp -> Field ? 2 : 1)));
572: expr_out (fp, offset);
573: nice_printf (fp, "]");
574: }
575:
576: /* Check for structure field reference */
577:
578: if (addrp -> Field && addrp -> uname_tag != UNAM_CONST &&
579: addrp -> uname_tag != UNAM_UNKNOWN) {
580: if (oneof_stg((addrp -> uname_tag == UNAM_NAME ? addrp -> user.name :
581: (Namep) NULL), addrp -> vstg, M(STGARG)|M(STGEQUIV))
582: && !was_array && (addrp->vclass != CLPROC || !multitype))
583: nice_printf (fp, "->%s", addrp -> Field);
584: else
585: nice_printf (fp, ".%s", addrp -> Field);
586: } /* if */
587:
588: /* Check for character subscripting */
589:
590: if (addrp->vtype == TYCHAR &&
591: (addrp->vclass != CLPROC || addrp->uname_tag == UNAM_NAME
592: && addrp->user.name->vprocclass == PTHISPROC) &&
593: addrp -> memoffset &&
594: (addrp -> uname_tag != UNAM_NAME ||
595: addrp -> user.name -> vtype == TYCHAR) &&
596: (!ISICON (addrp -> memoffset) ||
597: (addrp -> memoffset -> constblock.Const.ci))) {
598:
599: int use_paren = 0;
600: expptr e = addrp -> memoffset;
601:
602: if (!e)
603: return;
604: addrp->memoffset = 0;
605:
606: if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
607: && addrp -> uname_tag == UNAM_NAME) {
608: e = mkexpr (OPMINUS, e, mkintcon (addrp -> user.name -> voffset));
609:
610: /* mkexpr will simplify it to zero if possible */
611: if (e->tag == TCONST && e->constblock.Const.ci == 0)
612: return;
613: } /* if addrp -> vstg == STGCOMMON */
614:
615: /* In the worst case, parentheses might be needed OUTSIDE the expression,
616: too. But since I think this subscripting can only appear as a
617: parameter in a procedure call, I don't think outside parens will ever
618: be needed. INSIDE parens are handled below */
619:
620: nice_printf (fp, " + ");
621: if (e -> tag == TEXPR) {
622: int arg_prec = op_precedence (e -> exprblock.opcode);
623: int prec = op_precedence (OPPLUS);
624: use_paren = arg_prec && (arg_prec < prec || (arg_prec == prec &&
625: is_left_assoc (OPPLUS)));
626: } /* if e -> tag == TEXPR */
627: if (use_paren) nice_printf (fp, "(");
628: expr_out (fp, e);
629: if (use_paren) nice_printf (fp, ")");
630: } /* if */
631: } /* out_addr */
632:
633:
634: static void output_literal (fp, memno, cp)
635: FILE *fp;
636: int memno;
637: Constp cp;
638: {
639: struct Literal *litp, *lastlit;
640: extern char *lit_name ();
641:
642: lastlit = litpool + nliterals;
643:
644: for (litp = litpool; litp < lastlit; litp++) {
645: if (litp -> litnum == memno)
646: break;
647: } /* for litp */
648:
649: if (litp >= lastlit)
650: out_const (fp, cp);
651: else {
652: nice_printf (fp, "%s", lit_name (litp));
653: litp->lituse++;
654: }
655: } /* output_literal */
656:
657:
658: static void output_prim (fp, primp)
659: FILE *fp;
660: struct Primblock *primp;
661: {
662: if (primp == NULL)
663: return;
664:
665: out_name (fp, primp -> namep);
666: if (primp -> argsp)
667: output_arg_list (fp, primp -> argsp);
668:
669: if (primp -> fcharp != (expptr) NULL || primp -> lcharp != (expptr) NULL)
670: nice_printf (fp, "Sorry, no substrings yet");
671: }
672:
673:
674:
675: static void output_arg_list (fp, listp)
676: FILE *fp;
677: struct Listblock *listp;
678: {
679: chainp arg_list;
680:
681: if (listp == (struct Listblock *) NULL || listp -> listp == (chainp) NULL)
682: return;
683:
684: nice_printf (fp, "(");
685:
686: for (arg_list = listp -> listp; arg_list; arg_list = arg_list -> nextp) {
687: expr_out (fp, (expptr) arg_list -> datap);
688: if (arg_list -> nextp != (chainp) NULL)
689:
690: /* Might want to add a hook in here to accomodate the style setting which
691: wants spaces after commas */
692:
693: nice_printf (fp, ",");
694: } /* for arg_list */
695:
696: nice_printf (fp, ")");
697: } /* output_arg_list */
698:
699:
700:
701: static void output_unary (fp, e)
702: FILE *fp;
703: struct Exprblock *e;
704: {
705: if (e == NULL)
706: return;
707:
708: switch (e -> opcode) {
709: case OPNEG:
710: if (e->vtype == TYREAL && forcedouble) {
711: e->opcode = OPNEG_KLUDGE;
712: output_binary(fp,e);
713: e->opcode = OPNEG;
714: break;
715: }
716: case OPNEG1:
717: case OPNOT:
718: case OPABS:
719: case OPBITNOT:
720: case OPWHATSIN:
721: case OPPREINC:
722: case OPPREDEC:
723: case OPADDR:
724: case OPIDENTITY:
725: case OPCHARCAST:
726: case OPDABS:
727: output_binary (fp, e);
728: break;
729: case OPCALL:
730: case OPCCALL:
731: nice_printf (fp, "Sorry, no OPCALL yet");
732: break;
733: default:
734: erri ("output_unary: bad opcode", (int) e -> opcode);
735: break;
736: } /* switch */
737: } /* output_unary */
738:
739:
740: static char *
741: findconst(m)
742: register long m;
743: {
744: register struct Literal *litp, *litpe;
745:
746: litp = litpool;
747: for(litpe = litp + nliterals; litp < litpe; litp++)
748: if (litp->litnum == m)
749: return litp->cds[0];
750: Fatal("findconst failure!");
751: return 0;
752: }
753:
754: static int
755: opconv_fudge(fp,e)
756: FILE *fp;
757: struct Exprblock *e;
758: {
759: /* special handling for ichar and character*1 */
760: register expptr lp;
761: register union Expression *Offset;
762: register char *cp;
763: int lt;
764: char buf[8];
765: unsigned int k;
766: Namep np;
767:
768: if (!(lp = e->leftp)) /* possible with erroneous Fortran */
769: return 1;
770: lt = lp->headblock.vtype;
771: if (lt == TYCHAR) {
772: switch(lp->tag) {
773: case TNAME:
774: nice_printf(fp, "*");
775: out_name(fp, (Namep)lp);
776: return 1;
777: case TCONST:
778: tconst:
779: cp = lp->constblock.Const.ccp;
780: tconst1:
781: k = *(unsigned char *)cp;
782: sprintf(buf, chr_fmt[k], k);
783: nice_printf(fp, "'%s'", buf);
784: return 1;
785: case TADDR:
786: switch(lp->addrblock.vstg) {
787: case STGMEMNO:
788: if (halign && e->vtype != TYCHAR) {
789: nice_printf(fp, "*(%s *)",
790: c_type_decl(e->vtype));
791: expr_out(fp, lp);
792: return 1;
793: }
794: cp = findconst(lp->addrblock.memno);
795: goto tconst1;
796: case STGCONST:
797: goto tconst;
798: }
799: lp->addrblock.vtype = tyint;
800: Offset = lp->addrblock.memoffset;
801: switch(lp->addrblock.uname_tag) {
802: case UNAM_REF:
803: nice_printf(fp, "*");
804: return 0;
805: case UNAM_NAME:
806: np = lp->addrblock.user.name;
807: if (ONEOF(np->vstg,
808: M(STGCOMMON)|M(STGEQUIV)))
809: Offset = mkexpr(OPMINUS, Offset,
810: ICON(np->voffset));
811: }
812: lp->addrblock.memoffset = Offset ?
813: mkexpr(OPSTAR, Offset,
814: ICON(typesize[tyint]))
815: : ICON(0);
816: lp->addrblock.isarray = 1;
817: /* STGCOMMON or STGEQUIV would cause */
818: /* voffset to be added in a second time */
819: lp->addrblock.vstg = STGUNKNOWN;
820: break;
821: default:
822: badtag("opconv_fudge", lp->tag);
823: }
824: }
825: if (lt != e->vtype)
826: nice_printf(fp, "(%s) ",
827: c_type_decl(e->vtype, 0));
828: return 0;
829: }
830:
831:
832: static void output_binary (fp, e)
833: FILE *fp;
834: struct Exprblock *e;
835: {
836: char *format;
837: extern table_entry opcode_table[];
838: int prec;
839:
840: if (e == NULL || e -> tag != TEXPR)
841: return;
842:
843: /* Instead of writing a huge switch, I've incorporated the output format
844: into a table. Things like "%l" and "%r" stand for the left and
845: right subexpressions. This should allow both prefix and infix
846: functions to be specified (e.g. "(%l * %r", "z_div (%l, %r"). Of
847: course, I should REALLY think out the ramifications of writing out
848: straight text, as opposed to some intermediate format, which could
849: figure out and optimize on the the number of required blanks (we don't
850: want "x - (-y)" to become "x --y", for example). Special cases (such as
851: incomplete implementations) could still be implemented as part of the
852: switch, they will just have some dummy value instead of the string
853: pattern. Another difficulty is the fact that the complex functions
854: will differ from the integer and real ones */
855:
856: /* Handle a special case. We don't want to output "x + - 4", or "y - - 3"
857: */
858: if ((e -> opcode == OPPLUS || e -> opcode == OPMINUS) &&
859: e -> rightp && e -> rightp -> tag == TCONST &&
860: isnegative_const (&(e -> rightp -> constblock)) &&
861: is_negatable (&(e -> rightp -> constblock))) {
862:
863: e -> opcode = (e -> opcode == OPPLUS) ? OPMINUS : OPPLUS;
864: negate_const (&(e -> rightp -> constblock));
865: } /* if e -> opcode == PLUS or MINUS */
866:
867: prec = op_precedence (e -> opcode);
868: format = op_format (e -> opcode);
869:
870: if (format != SPECIAL_FMT) {
871: while (*format) {
872: if (*format == '%') {
873: int arg_prec, use_paren = 0;
874: expptr lp, rp;
875:
876: switch (*(format + 1)) {
877: case 'l':
878: lp = e->leftp;
879: if (lp && lp->tag == TEXPR) {
880: arg_prec = op_precedence(lp->exprblock.opcode);
881:
882: use_paren = arg_prec &&
883: (arg_prec < prec || (arg_prec == prec &&
884: is_right_assoc (prec)));
885: } /* if e -> leftp */
886: if (e->opcode == OPCONV && opconv_fudge(fp,e))
887: break;
888: if (use_paren)
889: nice_printf (fp, "(");
890: expr_out(fp, lp);
891: if (use_paren)
892: nice_printf (fp, ")");
893: break;
894: case 'r':
895: rp = e->rightp;
896: if (rp && rp->tag == TEXPR) {
897: arg_prec = op_precedence(rp->exprblock.opcode);
898:
899: use_paren = arg_prec &&
900: (arg_prec < prec || (arg_prec == prec &&
901: is_left_assoc (prec)));
902: use_paren = use_paren ||
903: (rp->exprblock.opcode == OPNEG
904: && prec >= op_precedence(OPMINUS));
905: } /* if e -> rightp */
906: if (use_paren)
907: nice_printf (fp, "(");
908: expr_out(fp, rp);
909: if (use_paren)
910: nice_printf (fp, ")");
911: break;
912: case '\0':
913: case '%':
914: nice_printf (fp, "%%");
915: break;
916: default:
917: erri ("output_binary: format err: '%%%c' illegal",
918: (int) *(format + 1));
919: break;
920: } /* switch */
921: format += 2;
922: } else
923: nice_printf (fp, "%c", *format++);
924: } /* while *format */
925: } else {
926:
927: /* Handle Special cases of formatting */
928:
929: switch (e -> opcode) {
930: case OPCCALL:
931: case OPCALL:
932: out_call (fp, (int) e -> opcode, e -> vtype,
933: e -> vleng, e -> leftp, e -> rightp);
934: break;
935:
936: case OPCOMMA_ARG:
937: doin_setbound = 1;
938: nice_printf(fp, "(");
939: expr_out(fp, e->leftp);
940: nice_printf(fp, ", &");
941: doin_setbound = 0;
942: expr_out(fp, e->rightp);
943: nice_printf(fp, ")");
944: break;
945:
946: case OPADDR:
947: default:
948: nice_printf (fp, "Sorry, can't format OPCODE '%d'",
949: e -> opcode);
950: break;
951: }
952:
953: } /* else */
954: } /* output_binary */
955:
956:
957: out_call (outfile, op, ftype, len, name, args)
958: FILE *outfile;
959: int op, ftype;
960: expptr len, name, args;
961: {
962: chainp arglist; /* Pointer to any actual arguments */
963: chainp cp; /* Iterator over argument lists */
964: Addrp ret_val = (Addrp) NULL;
965: /* Function return value buffer, if any is
966: required */
967: int byvalue; /* True iff we're calling a C library
968: routine */
969: int done_once; /* Used for writing commas to outfile */
970: int narg, t;
971: register expptr q;
972: long L;
973: Argtypes *at;
974: Atype *A, *Ac;
975: Namep np;
976: extern int forcereal;
977:
978: /* Don't use addresses if we're calling a C function */
979:
980: byvalue = op == OPCCALL;
981:
982: if (args)
983: arglist = args -> listblock.listp;
984: else
985: arglist = CHNULL;
986:
987: /* If this is a CHARACTER function, the first argument is the result */
988:
989: if (ftype == TYCHAR)
990: if (ISICON (len)) {
991: ret_val = (Addrp) (arglist -> datap);
992: arglist = arglist -> nextp;
993: } else {
994: err ("adjustable character function");
995: return;
996: } /* else */
997:
998: /* If this is a COMPLEX function, the first argument is the result */
999:
1000: else if (ISCOMPLEX (ftype)) {
1001: ret_val = (Addrp) (arglist -> datap);
1002: arglist = arglist -> nextp;
1003: } /* if ISCOMPLEX */
1004:
1005: /* Now we can actually start to write out the function invocation */
1006:
1007: if (ftype == TYREAL && forcereal)
1008: nice_printf(outfile, "(real)");
1009: if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
1010: nice_printf (outfile, "(");
1011: np = (Namep)name->exprblock.leftp; /*expr_out will free name */
1012: expr_out (outfile, name);
1013: nice_printf (outfile, ")");
1014: }
1015: else {
1016: np = (Namep)name;
1017: expr_out(outfile, name);
1018: }
1019:
1020: /* prepare to cast procedure parameters -- set A if we know how */
1021:
1022: A = Ac = 0;
1023: if (np->tag == TNAME && (at = np->arginfo)) {
1024: if (at->nargs > 0)
1025: A = at->atypes;
1026: if (Ansi && (at->defined || at->nargs > 0))
1027: Ac = at->atypes;
1028: }
1029:
1030: nice_printf(outfile, "(");
1031:
1032: if (ret_val) {
1033: if (ISCOMPLEX (ftype))
1034: nice_printf (outfile, "&");
1035: expr_out (outfile, (expptr) ret_val);
1036: if (Ac)
1037: Ac++;
1038:
1039: /* The length of the result of a character function is the second argument */
1040: /* It should be in place from putcall(), so we won't touch it explicitly */
1041:
1042: } /* if ret_val */
1043: done_once = ret_val ? TRUE : FALSE;
1044:
1045: /* Now run through the named arguments */
1046:
1047: narg = -1;
1048: for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
1049:
1050: if (done_once)
1051: nice_printf (outfile, ", ");
1052: narg++;
1053:
1054: if (!( q = (expptr)cp->datap) )
1055: continue;
1056:
1057: if (q->tag == TADDR) {
1058: if (q->addrblock.vtype > TYERROR) {
1059: /* I/O block */
1060: nice_printf(outfile, "&%s", q->addrblock.user.ident);
1061: continue;
1062: }
1063: if (!byvalue && q->addrblock.isarray
1064: && q->addrblock.vtype != TYCHAR
1065: && q->addrblock.memoffset->tag == TCONST) {
1066:
1067: /* check for 0 offset -- after */
1068: /* correcting for equivalence. */
1069: L = q->addrblock.memoffset->constblock.Const.ci;
1070: if (ONEOF(q->addrblock.vstg, M(STGCOMMON)|M(STGEQUIV))
1071: && q->addrblock.uname_tag == UNAM_NAME)
1072: L -= q->addrblock.user.name->voffset;
1073: if (L)
1074: goto skip_deref;
1075:
1076: if (Ac && narg < at->dnargs
1077: && q->headblock.vtype != (t = Ac[narg].type)
1078: && t > TYADDR && t < TYSUBR)
1079: nice_printf(outfile, "(%s*)", typename[t]);
1080:
1081: /* &x[0] == x */
1082: /* This also prevents &sizeof(doublereal)[0] */
1083:
1084: switch(q->addrblock.uname_tag) {
1085: case UNAM_NAME:
1086: out_name(outfile, q->addrblock.user.name);
1087: continue;
1088: case UNAM_IDENT:
1089: nice_printf(outfile, "%s",
1090: q->addrblock.user.ident);
1091: continue;
1092: case UNAM_CHARP:
1093: nice_printf(outfile, "%s",
1094: q->addrblock.user.Charp);
1095: continue;
1096: case UNAM_EXTERN:
1097: extern_out(outfile,
1098: &extsymtab[q->addrblock.memno]);
1099: continue;
1100: }
1101: }
1102: }
1103:
1104: /* Skip over the dereferencing operator generated only for the
1105: intermediate file */
1106: skip_deref:
1107: if (q -> tag == TEXPR && q -> exprblock.opcode == OPWHATSIN)
1108: q = q -> exprblock.leftp;
1109:
1110: if (q->headblock.vclass == CLPROC) {
1111: if (Castargs && (q->tag != TNAME
1112: || q->nameblock.vprocclass != PTHISPROC))
1113: {
1114: if (A && (t = A[narg].type) >= 200)
1115: t %= 100;
1116: else {
1117: t = q->headblock.vtype;
1118: if (q->tag == TNAME && q->nameblock.vimpltype)
1119: t = TYUNKNOWN;
1120: }
1121: nice_printf(outfile, "(%s)", usedcasts[t] = casttypes[t]);
1122: }
1123: }
1124: else if (Ac && narg < at->dnargs
1125: && q->headblock.vtype != (t = Ac[narg].type)
1126: && t > TYADDR && t < TYSUBR)
1127: nice_printf(outfile, "(%s*)", typename[t]);
1128:
1129: if ((q -> tag == TADDR || q-> tag == TNAME) &&
1130: (byvalue || q -> headblock.vstg != STGREG)) {
1131: if (q -> headblock.vtype != TYCHAR)
1132: if (byvalue) {
1133:
1134: if (q -> tag == TADDR &&
1135: q -> addrblock.uname_tag == UNAM_NAME &&
1136: ! q -> addrblock.user.name -> vdim &&
1137: oneof_stg(q -> addrblock.user.name, q -> addrblock.vstg,
1138: M(STGARG)|M(STGEQUIV)) &&
1139: ! ISCOMPLEX(q->addrblock.user.name->vtype))
1140: nice_printf (outfile, "*");
1141: else if (q -> tag == TNAME
1142: && oneof_stg(&q->nameblock, q -> nameblock.vstg,
1143: M(STGARG)|M(STGEQUIV))
1144: && !(q -> nameblock.vdim))
1145: nice_printf (outfile, "*");
1146:
1147: } else {
1148: expptr memoffset;
1149:
1150: if (q->tag == TADDR &&
1151: !ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
1152: && (
1153: ONEOF(q->addrblock.vstg,
1154: M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
1155: || ((memoffset = q->addrblock.memoffset)
1156: && (!ISICON(memoffset)
1157: || memoffset->constblock.Const.ci)))
1158: || ONEOF(q->addrblock.vstg,
1159: M(STGINIT)|M(STGAUTO)|M(STGBSS))
1160: && !q->addrblock.isarray)
1161: nice_printf (outfile, "&");
1162: else if (q -> tag == TNAME
1163: && !oneof_stg(&q->nameblock, q -> nameblock.vstg,
1164: M(STGARG)|M(STGEXT)|M(STGEQUIV)))
1165: nice_printf (outfile, "&");
1166: } /* else */
1167:
1168: expr_out (outfile, q);
1169: } /* if q -> tag == TADDR || q -> tag == TNAME */
1170:
1171: /* Might be a Constant expression, e.g. string length, character constants */
1172:
1173: else if (q -> tag == TCONST) {
1174: if (tyioint == TYLONG)
1175: Longfmt = "%ldL";
1176: out_const(outfile, &q->constblock);
1177: Longfmt = "%ld";
1178: }
1179:
1180: /* Must be some other kind of expression, or register var, or constant.
1181: In particular, this is likely to be a temporary variable assignment
1182: which was generated in p1put_call */
1183:
1184: else if (!ISCOMPLEX (q -> headblock.vtype) && !ISCHAR (q)){
1185: int use_paren = q -> tag == TEXPR &&
1186: op_precedence (q -> exprblock.opcode) <=
1187: op_precedence (OPCOMMA);
1188:
1189: if (use_paren) nice_printf (outfile, "(");
1190: expr_out (outfile, q);
1191: if (use_paren) nice_printf (outfile, ")");
1192: } /* if !ISCOMPLEX */
1193: else
1194: err ("out_call: unknown parameter");
1195:
1196: } /* for (cp = arglist */
1197:
1198: if (arglist)
1199: frchain (&arglist);
1200:
1201: nice_printf (outfile, ")");
1202:
1203: } /* out_call */
1204:
1205:
1206: char *
1207: flconst(buf, x)
1208: char *buf, *x;
1209: {
1210: sprintf(buf, fl_fmt_string, x);
1211: return buf;
1212: }
1213:
1214: char *
1215: dtos(x)
1216: double x;
1217: {
1218: static char buf[64];
1219: sprintf(buf, db_fmt_string, x);
1220: return buf;
1221: }
1222:
1223: char tr_tab[Table_size];
1224:
1225: /* out_init -- Initialize the data structures used by the routines in
1226: output.c. These structures include the output format to be used for
1227: Float, Double, Complex, and Double Complex constants. */
1228:
1229: void out_init ()
1230: {
1231: extern int tab_size;
1232: register char *s;
1233:
1234: s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
1235: while(*s)
1236: tr_tab[*s++] = 3;
1237: tr_tab['>'] = 1;
1238:
1239: opeqable[OPPLUS] = 1;
1240: opeqable[OPMINUS] = 1;
1241: opeqable[OPSTAR] = 1;
1242: opeqable[OPSLASH] = 1;
1243: opeqable[OPMOD] = 1;
1244: opeqable[OPLSHIFT] = 1;
1245: opeqable[OPBITAND] = 1;
1246: opeqable[OPBITXOR] = 1;
1247: opeqable[OPBITOR ] = 1;
1248:
1249:
1250: /* Set the output format for both types of floating point constants */
1251:
1252: if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
1253: fl_fmt_string = Ansi == 1 ? "%sf" : "(float)%s";
1254:
1255: if (db_fmt_string == NULL || *db_fmt_string == '\0')
1256: db_fmt_string = "%.17g";
1257:
1258: /* Set the output format for both types of complex constants. They will
1259: have string parameters rather than float or double so that the decimal
1260: point may be added to the strings generated by the {db,fl}_fmt_string
1261: formats above */
1262:
1263: if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
1264: cm_fmt_string = "{%s,%s}";
1265: } /* if cm_fmt_string == NULL */
1266:
1267: if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
1268: dcm_fmt_string = "{%s,%s}";
1269: } /* if dcm_fmt_string == NULL */
1270:
1271: tab_size = 4;
1272: } /* out_init */
1273:
1274:
1275: void extern_out (fp, extsym)
1276: FILE *fp;
1277: Extsym *extsym;
1278: {
1279: if (extsym == (Extsym *) NULL)
1280: return;
1281:
1282: nice_printf (fp, "%s", extsym->cextname);
1283:
1284: } /* extern_out */
1285:
1286:
1287:
1288: static void output_list (fp, listp)
1289: FILE *fp;
1290: struct Listblock *listp;
1291: {
1292: int did_one = 0;
1293: chainp elts;
1294:
1295: nice_printf (fp, "(");
1296: if (listp)
1297: for (elts = listp -> listp; elts; elts = elts -> nextp) {
1298: if (elts -> datap) {
1299: if (did_one)
1300: nice_printf (fp, ", ");
1301: expr_out (fp, (expptr) elts -> datap);
1302: did_one = 1;
1303: } /* if elts -> datap */
1304: } /* for elts */
1305: nice_printf (fp, ")");
1306: } /* output_list */
1307:
1308:
1309: void out_asgoto (outfile, expr)
1310: FILE *outfile;
1311: expptr expr;
1312: {
1313: char *user_label();
1314: chainp value;
1315: Namep namep;
1316: int k;
1317:
1318: if (expr == (expptr) NULL) {
1319: err ("out_asgoto: NULL variable expr");
1320: return;
1321: } /* if expr */
1322:
1323: nice_printf (outfile, Ansi ? "switch (" : "switch ((int)"); /*)*/
1324: expr_out (outfile, expr);
1325: nice_printf (outfile, ") {\n");
1326: next_tab (outfile);
1327:
1328: /* The initial addrp value will be stored as a namep pointer */
1329:
1330: switch(expr->tag) {
1331: case TNAME:
1332: /* local variable */
1333: namep = &expr->nameblock;
1334: break;
1335: case TEXPR:
1336: if (expr->exprblock.opcode == OPWHATSIN
1337: && expr->exprblock.leftp->tag == TNAME)
1338: /* argument */
1339: namep = &expr->exprblock.leftp->nameblock;
1340: else
1341: goto bad;
1342: break;
1343: case TADDR:
1344: if (expr->addrblock.uname_tag == UNAM_NAME) {
1345: /* initialized local variable */
1346: namep = expr->addrblock.user.name;
1347: break;
1348: }
1349: default:
1350: bad:
1351: err("out_asgoto: bad expr");
1352: return;
1353: }
1354:
1355: for(k = 0, value = namep -> varxptr.assigned_values; value;
1356: value = value->nextp, k++) {
1357: nice_printf (outfile, "case %d: goto %s;\n", k,
1358: user_label((long)value->datap));
1359: } /* for value */
1360: prev_tab (outfile);
1361:
1362: nice_printf (outfile, "}\n");
1363: } /* out_asgoto */
1364:
1365: void out_if (outfile, expr)
1366: FILE *outfile;
1367: expptr expr;
1368: {
1369: nice_printf (outfile, "if (");
1370: expr_out (outfile, expr);
1371: nice_printf (outfile, ") {\n");
1372: next_tab (outfile);
1373: } /* out_if */
1374:
1375: static void
1376: output_rbrace(outfile, s)
1377: FILE *outfile;
1378: char *s;
1379: {
1380: extern int last_was_label;
1381: register char *fmt;
1382:
1383: if (last_was_label) {
1384: last_was_label = 0;
1385: fmt = ";%s";
1386: }
1387: else
1388: fmt = "%s";
1389: nice_printf(outfile, fmt, s);
1390: }
1391:
1392: void out_else (outfile)
1393: FILE *outfile;
1394: {
1395: prev_tab (outfile);
1396: output_rbrace(outfile, "} else {\n");
1397: next_tab (outfile);
1398: } /* out_else */
1399:
1400: void elif_out (outfile, expr)
1401: FILE *outfile;
1402: expptr expr;
1403: {
1404: prev_tab (outfile);
1405: output_rbrace(outfile, "} else ");
1406: out_if (outfile, expr);
1407: } /* elif_out */
1408:
1409: void endif_out (outfile)
1410: FILE *outfile;
1411: {
1412: prev_tab (outfile);
1413: output_rbrace(outfile, "}\n");
1414: } /* endif_out */
1415:
1416: void end_else_out (outfile)
1417: FILE *outfile;
1418: {
1419: prev_tab (outfile);
1420: output_rbrace(outfile, "}\n");
1421: } /* end_else_out */
1422:
1423:
1424:
1425: void compgoto_out (outfile, index, labels)
1426: FILE *outfile;
1427: expptr index, labels;
1428: {
1429: char *s1, *s2;
1430:
1431: if (index == ENULL)
1432: err ("compgoto_out: null index for computed goto");
1433: else if (labels && labels -> tag != TLIST)
1434: erri ("compgoto_out: expected label list, got tag '%d'",
1435: labels -> tag);
1436: else {
1437: extern char *user_label ();
1438: chainp elts;
1439: int i = 1;
1440:
1441: s2 = /*(*/ ") {\n"; /*}*/
1442: if (Ansi)
1443: s1 = "switch ("; /*)*/
1444: else if (index->tag == TNAME || index->tag == TEXPR
1445: && index->exprblock.opcode == OPWHATSIN)
1446: s1 = "switch ((int)"; /*)*/
1447: else {
1448: s1 = "switch ((int)(";
1449: s2 = ")) {\n"; /*}*/
1450: }
1451: nice_printf(outfile, s1);
1452: expr_out (outfile, index);
1453: nice_printf (outfile, s2);
1454: next_tab (outfile);
1455:
1456: for (elts = labels -> listblock.listp; elts; elts = elts -> nextp, i++) {
1457: if (elts -> datap) {
1458: if (ISICON(((expptr) (elts -> datap))))
1459: nice_printf (outfile, "case %d: goto %s;\n", i,
1460: user_label(((expptr)(elts->datap))->constblock.Const.ci));
1461: else
1462: err ("compgoto_out: bad label in label list");
1463: } /* if (elts -> datap) */
1464: } /* for elts */
1465: prev_tab (outfile);
1466: nice_printf (outfile, /*{*/ "}\n");
1467: } /* else */
1468: } /* compgoto_out */
1469:
1470:
1471: void out_for (outfile, init, test, inc)
1472: FILE *outfile;
1473: expptr init, test, inc;
1474: {
1475: nice_printf (outfile, "for (");
1476: expr_out (outfile, init);
1477: nice_printf (outfile, "; ");
1478: expr_out (outfile, test);
1479: nice_printf (outfile, "; ");
1480: expr_out (outfile, inc);
1481: nice_printf (outfile, ") {\n");
1482: next_tab (outfile);
1483: } /* out_for */
1484:
1485:
1486: void out_end_for (outfile)
1487: FILE *outfile;
1488: {
1489: prev_tab (outfile);
1490: nice_printf (outfile, "}\n");
1491: } /* out_end_for */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.