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