1 /****************************************************************
2 Copyright 1990 by AT&T Bell Laboratories and Bellcore.
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.
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
22 ****************************************************************/
35 char _assoc_table[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 };
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. */
41 table_entry opcode_table[] = {
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" },
55 /* Have to find out more about CONCAT before it can be implemented */
57 /* OPCONCAT 12 */ { BINARY_OP, 0, "concat (%l, %r)" },
58 /* OPLT 13 */ { BINARY_OP, 10, "%l < %r" },
59 /* OPEQ 14 */ { BINARY_OP, 9, "%l == %r" },
60 /* OPGT 15 */ { BINARY_OP, 10, "%l > %r" },
61 /* OPLE 16 */ { BINARY_OP, 10, "%l <= %r" },
62 /* OPNE 17 */ { BINARY_OP, 9, "%l != %r" },
63 /* OPGE 18 */ { BINARY_OP, 10, "%l >= %r" },
65 /* Have to find out more about CALL before it can be implemented */
67 /* OPCALL 19 */ { BINARY_OP, 0, SPECIAL_FMT },
68 /* OPCCALL 20 */ { BINARY_OP, 0, SPECIAL_FMT },
70 /* Left hand side of an assignment cannot have outermost parens */
72 /* OPASSIGN 21 */ { BINARY_OP, 2, "%l = %r" },
73 /* OPPLUSEQ 22 */ { BINARY_OP, 2, "%l += %r" },
74 /* OPSTAREQ 23 */ { BINARY_OP, 2, "%l *= %r" },
76 /* Why is this a binary operator? 15-jun-88 mwm */
78 /* OPCONV 24 */ { BINARY_OP, 14, "%l" },
79 /* OPLSHIFT 25 */ { BINARY_OP, 11, "%l << %r" },
80 /* OPMOD 26 */ { BINARY_OP, 13, "%l %% %r" },
81 /* OPCOMMA 27 */ { BINARY_OP, 1, "%l, %r" },
83 /* Don't want to nest the colon operator in parens */
85 /* OPQUEST 28 */ { BINARY_OP, 3, "%l ? %r" },
86 /* OPCOLON 29 */ { BINARY_OP, 3, "%l : %r" },
87 /* OPABS 30 */ { UNARY_OP, 0, "abs(%l)" },
88 /* OPMIN 31 */ { BINARY_OP, 0, SPECIAL_FMT },
89 /* OPMAX 32 */ { BINARY_OP, 0, SPECIAL_FMT },
90 /* OPADDR 33 */ { UNARY_OP, 14, "&%l" },
92 /* OPCOMMA_ARG 34 */ { BINARY_OP, 15, SPECIAL_FMT },
93 /* OPBITOR 35 */ { BINARY_OP, 6, "%l | %r" },
94 /* OPBITAND 36 */ { BINARY_OP, 8, "%l & %r" },
95 /* OPBITXOR 37 */ { BINARY_OP, 7, "%l ^ %r" },
96 /* OPBITNOT 38 */ { UNARY_OP, 14, "~ %l" },
97 /* OPRSHIFT 39 */ { BINARY_OP, 11, "%l >> %r" },
99 /* This isn't quite right -- it doesn't handle arrays, for instance */
101 /* OPWHATSIN 40 */ { UNARY_OP, 14, "*%l" },
102 /* OPMINUSEQ 41 */ { BINARY_OP, 2, "%l -= %r" },
103 /* OPSLASHEQ 42 */ { BINARY_OP, 2, "%l /= %r" },
104 /* OPMODEQ 43 */ { BINARY_OP, 2, "%l %%= %r" },
105 /* OPLSHIFTEQ 44 */ { BINARY_OP, 2, "%l <<= %r" },
106 /* OPRSHIFTEQ 45 */ { BINARY_OP, 2, "%l >>= %r" },
107 /* OPBITANDEQ 46 */ { BINARY_OP, 2, "%l &= %r" },
108 /* OPBITXOREQ 47 */ { BINARY_OP, 2, "%l ^= %r" },
109 /* OPBITOREQ 48 */ { BINARY_OP, 2, "%l |= %r" },
110 /* OPPREINC 49 */ { UNARY_OP, 14, "++%l" },
111 /* OPPREDEC 50 */ { UNARY_OP, 14, "--%l" },
112 /* OPDOT 51 */ { BINARY_OP, 15, "%l.%r" },
113 /* OPARROW 52 */ { BINARY_OP, 15, "%l -> %r"},
114 /* OPNEG1 53 */ { UNARY_OP, 14, "-%l" },
115 /* OPDMIN 54 */ { BINARY_OP, 0, "dmin(%l,%r)" },
116 /* OPDMAX 55 */ { BINARY_OP, 0, "dmax(%l,%r)" },
117 /* OPASSIGNI 56 */ { BINARY_OP, 2, "%l = &%r" },
118 /* OPIDENTITY 57 */ { UNARY_OP, 15, "%l" },
119 /* OPCHARCAST 58 */ { UNARY_OP, 14, "(char *)&%l" },
120 /* OPDABS 59 */ { UNARY_OP, 0, "dabs(%l)" },
121 /* OPMIN2 60 */ { BINARY_OP, 0, "min(%l,%r)" },
122 /* OPMAX2 61 */ { BINARY_OP, 0, "max(%l,%r)" },
124 /* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
126 /* OPNEG KLUDGE */ { UNARY_OP, 14, "-(doublereal)%l" }
127 }; /* opcode_table */
129 #define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
131 static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
134 static void output_prim ();
135 static void output_unary (), output_binary (), output_arg_list ();
136 static void output_list (), output_literal ();
140 void expr_out (fp, e)
144 if (e == (expptr) NULL)
148 case TNAME: out_name (fp, (struct Nameblock *) e);
151 case TCONST: out_const(fp, &e->constblock);
156 case TADDR: out_addr (fp, &(e -> addrblock));
159 case TPRIM: warn ("expr_out: got TPRIM");
160 output_prim (fp, &(e -> primblock));
163 case TLIST: output_list (fp, &(e -> listblock));
166 case TIMPLDO: err ("expr_out: got TIMPLDO");
171 erri ("expr_out: bad tag '%d'", e -> tag);
174 /* Now we know that the tag is TEXPR */
176 /* Optimize on simple expressions, such as "a = a + b" ==> "a += b" */
178 if (e -> exprblock.opcode == OPASSIGN && e -> exprblock.rightp &&
179 e -> exprblock.rightp -> tag == TEXPR) {
182 opcode = e -> exprblock.rightp -> exprblock.opcode;
184 if (opeqable[opcode]) {
185 expptr leftp, rightp;
187 if ((leftp = e -> exprblock.leftp) &&
188 (rightp = e -> exprblock.rightp -> exprblock.leftp)) {
190 if (same_ident (leftp, rightp)) {
191 expptr temp = e -> exprblock.rightp;
193 e -> exprblock.opcode = op_assign(opcode);
195 e -> exprblock.rightp = temp -> exprblock.rightp;
196 temp->exprblock.rightp = 0;
198 } /* if same_ident (leftp, rightp) */
199 } /* if leftp && rightp */
200 } /* if opcode == OPPLUS || */
201 } /* if e -> exprblock.opcode == OPASSIGN */
204 /* Optimize on increment or decrement by 1 */
207 int opcode = e -> exprblock.opcode;
208 expptr leftp = e -> exprblock.leftp;
209 expptr rightp = e -> exprblock.rightp;
211 if (leftp && rightp && (leftp -> headblock.vstg == STGARG ||
212 ISINT (leftp -> headblock.vtype)) &&
213 (opcode == OPPLUSEQ || opcode == OPMINUSEQ) &&
214 ISINT (rightp -> headblock.vtype) &&
215 ISICON (e -> exprblock.rightp) &&
216 (ISONE (e -> exprblock.rightp) ||
217 e -> exprblock.rightp -> constblock.Const.ci == -1)) {
219 /* Allow for the '-1' constant value */
221 if (!ISONE (e -> exprblock.rightp))
222 opcode = (opcode == OPPLUSEQ) ? OPMINUSEQ : OPPLUSEQ;
224 /* replace the existing opcode */
226 if (opcode == OPPLUSEQ)
227 e -> exprblock.opcode = OPPREINC;
229 e -> exprblock.opcode = OPPREDEC;
231 /* Free up storage used by the right hand side */
233 frexpr (e -> exprblock.rightp);
234 e->exprblock.rightp = 0;
235 } /* if opcode == OPPLUS */
239 if (is_unary_op (e -> exprblock.opcode))
240 output_unary (fp, &(e -> exprblock));
241 else if (is_binary_op (e -> exprblock.opcode))
242 output_binary (fp, &(e -> exprblock));
244 erri ("expr_out: bad opcode '%d'", (int) e -> exprblock.opcode);
249 void out_and_free_statement (outfile, expr)
254 expr_out (outfile, expr);
256 nice_printf (outfile, ";\n");
257 } /* out_and_free_statement */
261 int same_ident (left, right)
267 if (left -> tag == TNAME && right -> tag == TNAME && left == right)
270 if (left -> tag == TADDR && right -> tag == TADDR &&
271 left -> addrblock.uname_tag == right -> addrblock.uname_tag)
272 switch (left -> addrblock.uname_tag) {
275 /* Check for array subscripts */
277 if (left -> addrblock.user.name -> vdim ||
278 right -> addrblock.user.name -> vdim)
279 if (left -> addrblock.user.name !=
280 right -> addrblock.user.name ||
281 !same_expr (left -> addrblock.memoffset,
282 right -> addrblock.memoffset))
285 return same_ident ((expptr) (left -> addrblock.user.name),
286 (expptr) right -> addrblock.user.name);
288 return strcmp(left->addrblock.user.ident,
289 right->addrblock.user.ident) == 0;
291 return strcmp(left->addrblock.user.Charp,
292 right->addrblock.user.Charp) == 0;
297 if (left->tag == TEXPR && left->exprblock.opcode == OPWHATSIN
298 && right->tag == TEXPR && right->exprblock.opcode == OPWHATSIN)
299 return same_ident(left->exprblock.leftp,
300 right->exprblock.leftp);
306 samefpconst(c1, c2, n)
307 register Constp c1, c2;
311 if (!c1->vstg && !c2->vstg)
312 return c1->Const.cd[n] == c2->Const.cd[n];
313 s1 = c1->vstg ? c1->Const.cds[n] : dtos(c1->Const.cd[n]);
314 s2 = c2->vstg ? c2->Const.cds[n] : dtos(c2->Const.cd[n]);
315 return !strcmp(s1, s2);
320 register Constp c1, c2;
325 if (!samefpconst(c1,c2,1))
329 return samefpconst(c1,c2,0);
331 return c1->Const.ccp1.blanks == c2->Const.ccp1.blanks
332 && c1->vleng->constblock.Const.ci
333 == c2->vleng->constblock.Const.ci
334 && !memcmp(c1->Const.ccp, c2->Const.ccp,
335 (int)c1->vleng->constblock.Const.ci);
339 return c1->Const.ci == c2->Const.ci;
341 err("unexpected type in sameconst");
345 /* same_expr -- Returns true only if e1 and e2 match. This is
346 somewhat pessimistic, but can afford to be because it's just used to
347 optimize on the assignment operators (+=, -=, etc). */
349 int same_expr (e1, e2)
355 if (e1 -> tag != e2 -> tag || e1 -> headblock.vtype != e2 -> headblock.vtype)
360 if (e1 -> exprblock.opcode != e2 -> exprblock.opcode)
363 return same_expr (e1 -> exprblock.leftp, e2 -> exprblock.leftp) &&
364 same_expr (e1 -> exprblock.rightp, e2 -> exprblock.rightp);
367 return same_ident (e1, e2);
369 return sameconst(&e1->constblock, &e2->constblock);
377 void out_name (fp, namep)
381 extern int usedefsforcommon;
387 /* DON'T want to use oneof_stg() here; need to find the right common name
390 if (namep->vstg == STGCOMMON && !namep->vcommequiv && !usedefsforcommon) {
391 comm = &extsymtab[namep->vardesc.varno];
392 extern_out(fp, comm);
393 nice_printf(fp, "%d.", comm->curno);
394 } /* if namep -> vstg == STGCOMMON */
396 if (namep->vprocclass == PTHISPROC && namep->vtype != TYSUBR)
397 nice_printf(fp, xretslot[namep->vtype]->user.ident);
399 nice_printf (fp, "%s", namep->cvarname);
404 char *str_fmt[128] = {
405 "\\x00", "\\x01", "\\x02", "\\x03", "\\x04", "\\x05", "\\x06", "\\x07",
406 "\\b", "\\t", "\\n", "\\v", "\\f", "\\r", "\\x0e", "\\x0f",
407 "\\x10", "\\x11", "\\x12", "\\x13", "\\x14", "\\x15", "\\x16", "\\x17",
408 "\\x18", "\\x19", "\\x1a", "\\x1b", "\\x1c", "\\x1d", "\\x1e", "\\x1f",
409 " ", "!", "\\\"", "#", "$", "%%", "&", "'",
410 "(", ")", "*", "+", ",", "-", ".", "/",
411 "0", "1", "2", "3", "4", "5", "6", "7",
412 "8", "9", ":", ";", "<", "=", ">", "?",
413 "@", "A", "B", "C", "D", "E", "F", "G",
414 "H", "I", "J", "K", "L", "M", "N", "O",
415 "P", "Q", "R", "S", "T", "U", "V", "W",
416 "X", "Y", "Z", "[", "\\\\", "]", "^", "_",
417 "`", "a", "b", "c", "d", "e", "f", "g",
418 "h", "i", "j", "k", "l", "m", "n", "o",
419 "p", "q", "r", "s", "t", "u", "v", "w",
420 "x", "y", "z", "{", "|", "}", "~", "\\x%02x"
422 char *chr_fmt[128] = {
423 "\\x00", "\\x01", "\\x02", "\\x03", "\\x04", "\\x05", "\\x06", "\\x07",
424 "\\b", "\\t", "\\n", "\\v", "\\f", "\\r", "\\x0e", "\\x0f",
425 "\\x10", "\\x11", "\\x12", "\\x13", "\\x14", "\\x15", "\\x16", "\\x17",
426 "\\x18", "\\x19", "\\x1a", "\\x1b", "\\x1c", "\\x1d", "\\x1e", "\\x1f",
427 " ", "!", "\"", "#", "$", "%%", "&", "\\'",
428 "(", ")", "*", "+", ",", "-", ".", "/",
429 "0", "1", "2", "3", "4", "5", "6", "7",
430 "8", "9", ":", ";", "<", "=", ">", "?",
431 "@", "A", "B", "C", "D", "E", "F", "G",
432 "H", "I", "J", "K", "L", "M", "N", "O",
433 "P", "Q", "R", "S", "T", "U", "V", "W",
434 "X", "Y", "Z", "[", "\\\\", "]", "^", "_",
435 "`", "a", "b", "c", "d", "e", "f", "g",
436 "h", "i", "j", "k", "l", "m", "n", "o",
437 "p", "q", "r", "s", "t", "u", "v", "w",
438 "x", "y", "z", "{", "|", "}", "~", "\\x%02x"
441 static char *Longfmt = "%ld";
443 #define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
445 void out_const(fp, cp)
449 static char real_buf[50], imag_buf[50];
451 int type = cp->vtype;
455 nice_printf (fp, "%ld", cp->Const.ci); /* don't cast ci! */
458 nice_printf (fp, Longfmt, cp->Const.ci); /* don't cast ci! */
461 nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
464 nice_printf(fp, "%s", cpd(0));
467 nice_printf(fp, cm_fmt_string, flconst(real_buf, cpd(0)),
468 flconst(imag_buf, cpd(1)));
471 nice_printf(fp, dcm_fmt_string, cpd(0), cpd(1));
474 nice_printf (fp, "%s", cp->Const.ci ? "TRUE_" : "FALSE_");
477 char *c = cp->Const.ccp, *ce;
480 nice_printf (fp, "\"\"");
484 nice_printf (fp, "\"");
486 ce = c + cp->vleng->constblock.Const.ci;
488 k = *(unsigned char *)c++;
489 nice_printf(fp, str_fmt[k < 127 ? k : 127], k);
491 for(k = cp->Const.ccp1.blanks; k > 0; k--)
492 nice_printf(fp, " ");
493 nice_printf (fp, "\"");
498 erri ("out_const: bad type '%d'", (int) type);
506 /* out_addr -- this routine isn't local because it is called by the
507 system-generated identifier printing routines */
509 void out_addr (fp, addrp)
511 struct Addrblock *addrp;
513 extern Extsym *extsymtab;
521 && addrp->vstg == STGARG
522 && addrp->vtype != TYCHAR
523 && ISICON(addrp->memoffset)
524 && !addrp->memoffset->constblock.Const.ci)
525 nice_printf(fp, "*");
527 switch (addrp -> uname_tag) {
529 out_name (fp, addrp -> user.name);
532 if (*(s = addrp->user.ident) == ' ') {
534 nice_printf(fp, "%s",
535 xretslot[addrp->vtype]->user.ident);
537 nice_printf(fp, "%s", s+1);
540 nice_printf(fp, "%s", s);
544 nice_printf(fp, "%s", addrp->user.Charp);
547 extern_out (fp, &extsymtab[addrp -> memno]);
550 switch(addrp->vstg) {
552 out_const(fp, (Constp)addrp);
555 output_literal (fp, (int)addrp->memno,
559 Fatal("unexpected vstg in out_addr");
564 nice_printf (fp, "Unknown Addrp");
568 /* It's okay to just throw in the brackets here because they have a
569 precedence level of 15, the highest value. */
571 if ((addrp->uname_tag == UNAM_NAME && addrp->user.name->vdim
572 || addrp->ntempelt > 1 || addrp->isarray)
573 && addrp->vtype != TYCHAR) {
578 offset = addrp -> memoffset;
579 if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV)) &&
580 addrp -> uname_tag == UNAM_NAME)
581 offset = mkexpr (OPMINUS, offset, mkintcon (
582 addrp -> user.name -> voffset));
584 nice_printf (fp, "[");
586 offset = mkexpr (OPSLASH, offset,
587 ICON (typesize[addrp -> vtype] * (addrp -> Field ? 2 : 1)));
588 expr_out (fp, offset);
589 nice_printf (fp, "]");
592 /* Check for structure field reference */
594 if (addrp -> Field && addrp -> uname_tag != UNAM_CONST &&
595 addrp -> uname_tag != UNAM_UNKNOWN) {
596 if (oneof_stg((addrp -> uname_tag == UNAM_NAME ? addrp -> user.name :
597 (Namep) NULL), addrp -> vstg, M(STGARG)|M(STGEQUIV))
598 && !was_array && (addrp->vclass != CLPROC || !multitype))
599 nice_printf (fp, "->%s", addrp -> Field);
601 nice_printf (fp, ".%s", addrp -> Field);
604 /* Check for character subscripting */
606 if (addrp->vtype == TYCHAR &&
607 (addrp->vclass != CLPROC || addrp->uname_tag == UNAM_NAME
608 && addrp->user.name->vprocclass == PTHISPROC) &&
609 addrp -> memoffset &&
610 (addrp -> uname_tag != UNAM_NAME ||
611 addrp -> user.name -> vtype == TYCHAR) &&
612 (!ISICON (addrp -> memoffset) ||
613 (addrp -> memoffset -> constblock.Const.ci))) {
616 expptr e = addrp -> memoffset;
621 if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
622 && addrp -> uname_tag == UNAM_NAME) {
623 e = mkexpr (OPMINUS, e, mkintcon (addrp -> user.name -> voffset));
625 /* mkexpr will simplify it to zero if possible */
626 if (e->tag == TCONST && e->constblock.Const.ci == 0)
628 } /* if addrp -> vstg == STGCOMMON */
630 /* In the worst case, parentheses might be needed OUTSIDE the expression,
631 too. But since I think this subscripting can only appear as a
632 parameter in a procedure call, I don't think outside parens will ever
633 be needed. INSIDE parens are handled below */
635 nice_printf (fp, " + ");
636 if (e -> tag == TEXPR) {
637 int arg_prec = op_precedence (e -> exprblock.opcode);
638 int prec = op_precedence (OPPLUS);
639 use_paren = arg_prec && (arg_prec < prec || (arg_prec == prec &&
640 is_left_assoc (OPPLUS)));
641 } /* if e -> tag == TEXPR */
642 if (use_paren) nice_printf (fp, "(");
644 if (use_paren) nice_printf (fp, ")");
649 static void output_literal (fp, memno, cp)
654 struct Literal *litp, *lastlit;
655 extern struct Literal litpool[];
656 extern int nliterals;
657 extern char *lit_name ();
659 lastlit = litpool + nliterals;
661 for (litp = litpool; litp < lastlit; litp++) {
662 if (litp -> litnum == memno)
669 nice_printf (fp, "%s", lit_name (litp));
672 } /* output_literal */
675 static void output_prim (fp, primp)
677 struct Primblock *primp;
682 out_name (fp, primp -> namep);
684 output_arg_list (fp, primp -> argsp);
686 if (primp -> fcharp != (expptr) NULL || primp -> lcharp != (expptr) NULL)
687 nice_printf (fp, "Sorry, no substrings yet");
692 static void output_arg_list (fp, listp)
694 struct Listblock *listp;
698 if (listp == (struct Listblock *) NULL || listp -> listp == (chainp) NULL)
701 nice_printf (fp, "(");
703 for (arg_list = listp -> listp; arg_list; arg_list = arg_list -> nextp) {
704 expr_out (fp, (expptr) arg_list -> datap);
705 if (arg_list -> nextp != (chainp) NULL)
707 /* Might want to add a hook in here to accomodate the style setting which
708 wants spaces after commas */
710 nice_printf (fp, ",");
713 nice_printf (fp, ")");
714 } /* output_arg_list */
718 static void output_unary (fp, e)
725 switch (e -> opcode) {
727 if (e->vtype == TYREAL && forcedouble) {
728 e->opcode = OPNEG_KLUDGE;
744 output_binary (fp, e);
748 nice_printf (fp, "Sorry, no OPCALL yet");
751 erri ("output_unary: bad opcode", (int) e -> opcode);
762 /* special handling for ichar and character*1 */
763 register expptr lp = e->leftp;
764 register union Expression *Offset;
765 int lt = lp->headblock.vtype;
770 if (lp->addrblock.vtype == TYCHAR) {
773 nice_printf(fp, "*");
774 out_name(fp, (Namep)lp);
778 k = *(unsigned char *)lp->constblock.Const.ccp;
779 sprintf(buf, chr_fmt[k < 127 ? k : 127], k);
780 nice_printf(fp, "'%s'", buf);
783 if (lp->addrblock.vstg == STGCONST)
785 lt = lp->addrblock.vtype = tyint;
786 Offset = lp->addrblock.memoffset;
787 if (lp->addrblock.uname_tag == UNAM_NAME) {
788 np = lp->addrblock.user.name;
790 M(STGCOMMON)|M(STGEQUIV)))
791 Offset = mkexpr(OPMINUS, Offset,
794 lp->addrblock.memoffset = Offset ?
795 mkexpr(OPSTAR, Offset,
796 ICON(typesize[tyint]))
798 lp->addrblock.isarray = 1;
799 /* STGCOMMON or STGEQUIV would cause */
800 /* voffset to be added in a second time */
801 lp->addrblock.vstg = STGUNKNOWN;
804 badtag("opconv_fudge", lp->tag);
808 nice_printf(fp, "(%s) ",
809 c_type_decl(e->vtype, 0));
814 static void output_binary (fp, e)
819 extern table_entry opcode_table[];
822 if (e == NULL || e -> tag != TEXPR)
825 /* Instead of writing a huge switch, I've incorporated the output format
826 into a table. Things like "%l" and "%r" stand for the left and
827 right subexpressions. This should allow both prefix and infix
828 functions to be specified (e.g. "(%l * %r", "z_div (%l, %r"). Of
829 course, I should REALLY think out the ramifications of writing out
830 straight text, as opposed to some intermediate format, which could
831 figure out and optimize on the the number of required blanks (we don't
832 want "x - (-y)" to become "x --y", for example). Special cases (such as
833 incomplete implementations) could still be implemented as part of the
834 switch, they will just have some dummy value instead of the string
835 pattern. Another difficulty is the fact that the complex functions
836 will differ from the integer and real ones */
838 /* Handle a special case. We don't want to output "x + - 4", or "y - - 3"
840 if ((e -> opcode == OPPLUS || e -> opcode == OPMINUS) &&
841 e -> rightp && e -> rightp -> tag == TCONST &&
842 isnegative_const (&(e -> rightp -> constblock)) &&
843 is_negatable (&(e -> rightp -> constblock))) {
845 e -> opcode = (e -> opcode == OPPLUS) ? OPMINUS : OPPLUS;
846 negate_const (&(e -> rightp -> constblock));
847 } /* if e -> opcode == PLUS or MINUS */
849 prec = op_precedence (e -> opcode);
850 format = op_format (e -> opcode);
852 if (format != SPECIAL_FMT) {
854 if (*format == '%') {
855 int arg_prec, use_paren = 0;
858 switch (*(format + 1)) {
861 if (lp && lp->tag == TEXPR) {
862 arg_prec = op_precedence(lp->exprblock.opcode);
864 use_paren = arg_prec &&
865 (arg_prec < prec || (arg_prec == prec &&
866 is_right_assoc (prec)));
867 } /* if e -> leftp */
868 if (e->opcode == OPCONV && opconv_fudge(fp,e))
871 nice_printf (fp, "(");
874 nice_printf (fp, ")");
878 if (rp && rp->tag == TEXPR) {
879 arg_prec = op_precedence(rp->exprblock.opcode);
881 use_paren = arg_prec &&
882 (arg_prec < prec || (arg_prec == prec &&
883 is_left_assoc (prec)));
884 use_paren = use_paren ||
885 (rp->exprblock.opcode == OPNEG
886 && prec >= op_precedence(OPMINUS));
887 } /* if e -> rightp */
889 nice_printf (fp, "(");
892 nice_printf (fp, ")");
896 nice_printf (fp, "%%");
899 erri ("output_binary: format err: '%%%c' illegal",
900 (int) *(format + 1));
905 nice_printf (fp, "%c", *format++);
906 } /* while *format */
909 /* Handle Special cases of formatting */
911 switch (e -> opcode) {
914 out_call (fp, (int) e -> opcode, e -> vtype,
915 e -> vleng, e -> leftp, e -> rightp);
920 nice_printf(fp, "(");
921 expr_out(fp, e->leftp);
922 nice_printf(fp, ", &");
924 expr_out(fp, e->rightp);
925 nice_printf(fp, ")");
930 nice_printf (fp, "Sorry, can't format OPCODE '%d'",
936 } /* output_binary */
939 out_call (outfile, op, ftype, len, name, args)
942 expptr len, name, args;
944 chainp arglist; /* Pointer to any actual arguments */
945 chainp cp; /* Iterator over argument lists */
946 Addrp ret_val = (Addrp) NULL;
947 /* Function return value buffer, if any is
949 int byvalue; /* True iff we're calling a C library
951 int done_once; /* Used for writing commas to outfile */
959 /* Don't use addresses if we're calling a C function */
961 byvalue = op == OPCCALL;
964 arglist = args -> listblock.listp;
968 /* If this is a CHARACTER function, the first argument is the result */
972 ret_val = (Addrp) (arglist -> datap);
973 arglist = arglist -> nextp;
975 err ("adjustable character function");
979 /* If this is a COMPLEX function, the first argument is the result */
981 else if (ISCOMPLEX (ftype)) {
982 ret_val = (Addrp) (arglist -> datap);
983 arglist = arglist -> nextp;
986 /* Now we can actually start to write out the function invocation */
988 if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
989 nice_printf (outfile, "(");
990 expr_out (outfile, name);
991 nice_printf (outfile, ")");
992 np = (Namep)name->exprblock.leftp;
996 expr_out(outfile, name);
999 /* prepare to cast procedure parameters -- set A if we know how */
1001 A = np->tag == TNAME && (at = np->arginfo) && at->nargs > 0
1004 nice_printf(outfile, "(");
1007 if (ISCOMPLEX (ftype))
1008 nice_printf (outfile, "&");
1009 expr_out (outfile, (expptr) ret_val);
1011 /* The length of the result of a character function is the second argument */
1012 /* It should be in place from putcall(), so we won't touch it explicitly */
1015 done_once = ret_val ? TRUE : FALSE;
1017 /* Now run through the named arguments */
1020 for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
1023 nice_printf (outfile, ", ");
1026 if (!( q = (expptr)cp->datap) )
1029 if (q->tag == TADDR) {
1030 if (q->addrblock.vtype > TYERROR) {
1032 nice_printf(outfile, "&%s", q->addrblock.user.ident);
1035 if (!byvalue && q->addrblock.isarray
1036 && q->addrblock.vtype != TYCHAR
1037 && q->addrblock.memoffset->tag == TCONST) {
1039 /* check for 0 offset -- after */
1040 /* correcting for equivalence. */
1041 L = q->addrblock.memoffset->constblock.Const.ci;
1042 if (ONEOF(q->addrblock.vstg, M(STGCOMMON)|M(STGEQUIV))
1043 && q->addrblock.uname_tag == UNAM_NAME)
1044 L -= q->addrblock.user.name->voffset;
1049 /* This also prevents &sizeof(doublereal)[0] */
1050 switch(q->addrblock.uname_tag) {
1052 out_name(outfile, q->addrblock.user.name);
1055 nice_printf(outfile, "%s",
1056 q->addrblock.user.ident);
1059 nice_printf(outfile, "%s",
1060 q->addrblock.user.Charp);
1064 &extsymtab[q->addrblock.memno]);
1070 /* Skip over the dereferencing operator generated only for the
1071 intermediate file */
1073 if (q -> tag == TEXPR && q -> exprblock.opcode == OPWHATSIN)
1074 q = q -> exprblock.leftp;
1076 if (q->headblock.vclass == CLPROC
1079 || q->nameblock.vprocclass != PTHISPROC))
1081 if (A && (t = A[narg].type) >= 200)
1084 t = q->headblock.vtype;
1085 if (q->tag == TNAME && q->nameblock.vimpltype)
1088 nice_printf(outfile, "(%s)", usedcasts[t] = casttypes[t]);
1091 if ((q -> tag == TADDR || q-> tag == TNAME) &&
1092 (byvalue || q -> headblock.vstg != STGREG)) {
1093 if (byvalue && q -> headblock.vtype != TYCHAR) {
1095 /* Think about array access, too! Don't just think about argument storage
1098 if (q -> tag == TADDR &&
1099 !(q -> addrblock.uname_tag == UNAM_NAME &&
1100 q -> addrblock.user.name -> vdim) &&
1101 oneof_stg(q -> addrblock.user.name, q -> addrblock.vstg,
1102 M(STGARG)|M(STGEQUIV)))
1104 nice_printf (outfile, "*");
1105 else if (q -> tag == TNAME
1106 && oneof_stg(&q->nameblock, q -> nameblock.vstg,
1107 M(STGARG)|M(STGEQUIV))
1108 && !(q -> nameblock.vdim))
1109 nice_printf (outfile, "*");
1111 } else if (q->headblock.vtype != TYCHAR) {
1114 if (q->tag == TADDR &&
1115 !ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
1117 ONEOF(q->addrblock.vstg,
1118 M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
1119 || ((memoffset = q->addrblock.memoffset)
1120 && (!ISICON(memoffset)
1121 || memoffset->constblock.Const.ci)))
1122 || ONEOF(q->addrblock.vstg,
1123 M(STGINIT)|M(STGAUTO)|M(STGBSS))
1124 && !q->addrblock.isarray)
1125 nice_printf (outfile, "&");
1126 else if (q -> tag == TNAME
1127 && !oneof_stg(&q->nameblock, q -> nameblock.vstg,
1128 M(STGARG)|M(STGEXT)|M(STGEQUIV)))
1129 nice_printf (outfile, "&");
1132 expr_out (outfile, q);
1133 } /* if q -> tag == TADDR || q -> tag == TNAME */
1135 /* Might be a Constant expression, e.g. string length, character constants */
1137 else if (q -> tag == TCONST) {
1138 if (tyioint == TYLONG)
1140 out_const(outfile, &q->constblock);
1144 /* Must be some other kind of expression, or register var, or constant.
1145 In particular, this is likely to be a temporary variable assignment
1146 which was generated in p1put_call */
1148 else if (!ISCOMPLEX (q -> headblock.vtype) && !ISCHAR (q)){
1149 int use_paren = q -> tag == TEXPR &&
1150 op_precedence (q -> exprblock.opcode) <=
1151 op_precedence (OPCOMMA);
1153 if (use_paren) nice_printf (outfile, "(");
1154 expr_out (outfile, q);
1155 if (use_paren) nice_printf (outfile, ")");
1156 } /* if !ISCOMPLEX */
1158 err ("out_call: unknown parameter");
1160 } /* for (cp = arglist */
1165 nice_printf (outfile, ")");
1174 sprintf(buf, fl_fmt_string, x);
1182 static char buf[64];
1183 sprintf(buf, db_fmt_string, x);
1187 char tr_tab[256]; /* machine dependent */
1189 /* out_init -- Initialize the data structures used by the routines in
1190 output.c. These structures include the output format to be used for
1191 Float, Double, Complex, and Double Complex constants. */
1195 extern int tab_size;
1198 s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
1203 opeqable[OPPLUS] = 1;
1204 opeqable[OPMINUS] = 1;
1205 opeqable[OPSTAR] = 1;
1206 opeqable[OPSLASH] = 1;
1207 opeqable[OPMOD] = 1;
1208 opeqable[OPLSHIFT] = 1;
1209 opeqable[OPBITAND] = 1;
1210 opeqable[OPBITXOR] = 1;
1211 opeqable[OPBITOR ] = 1;
1214 /* Set the output format for both types of floating point constants */
1216 if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
1217 fl_fmt_string = Ansi == 1 ? "%sf" : "(float)%s";
1219 if (db_fmt_string == NULL || *db_fmt_string == '\0')
1220 db_fmt_string = "%.17g";
1222 /* Set the output format for both types of complex constants. They will
1223 have string parameters rather than float or double so that the decimal
1224 point may be added to the strings generated by the {db,fl}_fmt_string
1227 if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
1228 cm_fmt_string = "{%s,%s}";
1229 } /* if cm_fmt_string == NULL */
1231 if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
1232 dcm_fmt_string = "{%s,%s}";
1233 } /* if dcm_fmt_string == NULL */
1239 void extern_out (fp, extsym)
1243 if (extsym == (Extsym *) NULL)
1246 nice_printf (fp, "%s", extsym->cextname);
1252 static void output_list (fp, listp)
1254 struct Listblock *listp;
1259 nice_printf (fp, "(");
1261 for (elts = listp -> listp; elts; elts = elts -> nextp) {
1262 if (elts -> datap) {
1264 nice_printf (fp, ", ");
1265 expr_out (fp, (expptr) elts -> datap);
1267 } /* if elts -> datap */
1269 nice_printf (fp, ")");
1273 void out_asgoto (outfile, expr)
1282 if (expr == (expptr) NULL) {
1283 err ("out_asgoto: NULL variable expr");
1287 nice_printf (outfile, "switch (");
1288 expr_out (outfile, expr);
1289 nice_printf (outfile, ") {\n");
1292 /* The initial addrp value will be stored as a namep pointer */
1296 /* local variable */
1297 namep = &expr->nameblock;
1300 if (expr->exprblock.opcode == OPWHATSIN
1301 && expr->exprblock.leftp->tag == TNAME)
1303 namep = &expr->exprblock.leftp->nameblock;
1308 if (expr->addrblock.uname_tag == UNAM_NAME) {
1309 /* initialized local variable */
1310 namep = expr->addrblock.user.name;
1315 err("out_asgoto: bad expr");
1319 for(k = 0, value = namep -> varxptr.assigned_values; value;
1320 value = value->nextp, k++) {
1321 nice_printf (outfile, "case %d: goto %s;\n", k,
1322 user_label((long)value->datap));
1326 nice_printf (outfile, "}\n");
1329 void out_if (outfile, expr)
1333 nice_printf (outfile, "if (");
1334 expr_out (outfile, expr);
1335 nice_printf (outfile, ") {\n");
1340 output_rbrace(outfile, s)
1344 extern int last_was_label;
1347 if (last_was_label) {
1353 nice_printf(outfile, fmt, s);
1356 void out_else (outfile)
1360 output_rbrace(outfile, "} else {\n");
1364 void elif_out (outfile, expr)
1369 output_rbrace(outfile, "} else ");
1370 out_if (outfile, expr);
1373 void endif_out (outfile)
1377 output_rbrace(outfile, "}\n");
1380 void end_else_out (outfile)
1384 output_rbrace(outfile, "}\n");
1385 } /* end_else_out */
1389 void compgoto_out (outfile, index, labels)
1391 expptr index, labels;
1394 err ("compgoto_out: null index for computed goto");
1395 else if (labels && labels -> tag != TLIST)
1396 erri ("compgoto_out: expected label list, got tag '%d'",
1399 extern char *user_label ();
1403 nice_printf (outfile, "switch (");
1404 expr_out (outfile, index);
1405 nice_printf (outfile, ") {\n");
1408 for (elts = labels -> listblock.listp; elts; elts = elts -> nextp, i++) {
1409 if (elts -> datap) {
1410 if (ISICON(((expptr) (elts -> datap))))
1411 nice_printf (outfile, "case %d: goto %s;\n", i,
1412 user_label(((expptr)(elts->datap))->constblock.Const.ci));
1414 err ("compgoto_out: bad label in label list");
1415 } /* if (elts -> datap) */
1418 nice_printf (outfile, "}\n");
1420 } /* compgoto_out */
1423 void out_for (outfile, init, test, inc)
1425 expptr init, test, inc;
1427 nice_printf (outfile, "for (");
1428 expr_out (outfile, init);
1429 nice_printf (outfile, "; ");
1430 expr_out (outfile, test);
1431 nice_printf (outfile, "; ");
1432 expr_out (outfile, inc);
1433 nice_printf (outfile, ") {\n");
1438 void out_end_for (outfile)
1442 nice_printf (outfile, "}\n");