00001 /****************************************************************
00002 Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
00003 
00004 Permission to use, copy, modify, and distribute this software
00005 and its documentation for any purpose and without fee is hereby
00006 granted, provided that the above copyright notice appear in all
00007 copies and that both that the copyright notice and this
00008 permission notice and warranty disclaimer appear in supporting
00009 documentation, and that the names of AT&T, Bell Laboratories,
00010 Lucent or Bellcore or any of their entities not be used in
00011 advertising or publicity pertaining to distribution of the
00012 software without specific, written prior permission.
00013 
00014 AT&T, Lucent and Bellcore disclaim all warranties with regard to
00015 this software, including all implied warranties of
00016 merchantability and fitness.  In no event shall AT&T, Lucent or
00017 Bellcore be liable for any special, indirect or consequential
00018 damages or any damages whatsoever resulting from loss of use,
00019 data or profits, whether in an action of contract, negligence or
00020 other tortious action, arising out of or in connection with the
00021 use or performance of this software.
00022 ****************************************************************/
00023 
00024 #include "defs.h"
00025 #include "names.h"
00026 #include "output.h"
00027 
00028 #ifndef TRUE
00029 #define TRUE 1
00030 #endif
00031 #ifndef FALSE
00032 #define FALSE 0
00033 #endif
00034 
00035 char _assoc_table[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 };
00036 
00037 /* Opcode table -- This array is indexed by the OP_____ macros defined in
00038    defines.h; these macros are expected to be adjacent integers, so that
00039    this table is as small as possible. */
00040 
00041 table_entry opcode_table[] = {
00042                                 { 0, 0, NULL },
00043         /* OPPLUS 1 */          { BINARY_OP, 12, "%l + %r" },
00044         /* OPMINUS 2 */         { BINARY_OP, 12, "%l - %r" },
00045         /* OPSTAR 3 */          { BINARY_OP, 13, "%l * %r" },
00046         /* OPSLASH 4 */         { BINARY_OP, 13, "%l / %r" },
00047         /* OPPOWER 5 */         { BINARY_OP,  0, "power (%l, %r)" },
00048         /* OPNEG 6 */           { UNARY_OP,  14, "-%l" },
00049         /* OPOR 7 */            { BINARY_OP,  4, "%l || %r" },
00050         /* OPAND 8 */           { BINARY_OP,  5, "%l && %r" },
00051         /* OPEQV 9 */           { BINARY_OP,  9, "%l == %r" },
00052         /* OPNEQV 10 */         { BINARY_OP,  9, "%l != %r" },
00053         /* OPNOT 11 */          { UNARY_OP,  14, "! %l" },
00054         /* OPCONCAT 12 */       { BINARY_OP,  0, "concat (%l, %r)" },
00055         /* OPLT 13 */           { BINARY_OP, 10, "%l < %r" },
00056         /* OPEQ 14 */           { BINARY_OP,  9, "%l == %r" },
00057         /* OPGT 15 */           { BINARY_OP, 10, "%l > %r" },
00058         /* OPLE 16 */           { BINARY_OP, 10, "%l <= %r" },
00059         /* OPNE 17 */           { BINARY_OP,  9, "%l != %r" },
00060         /* OPGE 18 */           { BINARY_OP, 10, "%l >= %r" },
00061         /* OPCALL 19 */         { BINARY_OP, 15, SPECIAL_FMT },
00062         /* OPCCALL 20 */        { BINARY_OP, 15, SPECIAL_FMT },
00063 
00064 /* Left hand side of an assignment cannot have outermost parens */
00065 
00066         /* OPASSIGN 21 */       { BINARY_OP,  2, "%l = %r" },
00067         /* OPPLUSEQ 22 */       { BINARY_OP,  2, "%l += %r" },
00068         /* OPSTAREQ 23 */       { BINARY_OP,  2, "%l *= %r" },
00069         /* OPCONV 24 */         { BINARY_OP, 14, "%l" },
00070         /* OPLSHIFT 25 */       { BINARY_OP, 11, "%l << %r" },
00071         /* OPMOD 26 */          { BINARY_OP, 13, "%l %% %r" },
00072         /* OPCOMMA 27 */        { BINARY_OP,  1, "%l, %r" },
00073 
00074 /* Don't want to nest the colon operator in parens */
00075 
00076         /* OPQUEST 28 */        { BINARY_OP, 3, "%l ? %r" },
00077         /* OPCOLON 29 */        { BINARY_OP, 3, "%l : %r" },
00078         /* OPABS 30 */          { UNARY_OP,  0, "abs(%l)" },
00079         /* OPMIN 31 */          { BINARY_OP,   0, SPECIAL_FMT },
00080         /* OPMAX 32 */          { BINARY_OP,   0, SPECIAL_FMT },
00081         /* OPADDR 33 */         { UNARY_OP, 14, "&%l" },
00082 
00083         /* OPCOMMA_ARG 34 */    { BINARY_OP, 15, SPECIAL_FMT },
00084         /* OPBITOR 35 */        { BINARY_OP,  6, "%l | %r" },
00085         /* OPBITAND 36 */       { BINARY_OP,  8, "%l & %r" },
00086         /* OPBITXOR 37 */       { BINARY_OP,  7, "%l ^ %r" },
00087         /* OPBITNOT 38 */       { UNARY_OP,  14, "~ %l" },
00088         /* OPRSHIFT 39 */       { BINARY_OP, 11, "%l >> %r" },
00089 
00090 /* This isn't quite right -- it doesn't handle arrays, for instance */
00091 
00092         /* OPWHATSIN 40 */      { UNARY_OP,  14, "*%l" },
00093         /* OPMINUSEQ 41 */      { BINARY_OP,  2, "%l -= %r" },
00094         /* OPSLASHEQ 42 */      { BINARY_OP,  2, "%l /= %r" },
00095         /* OPMODEQ 43 */        { BINARY_OP,  2, "%l %%= %r" },
00096         /* OPLSHIFTEQ 44 */     { BINARY_OP,  2, "%l <<= %r" },
00097         /* OPRSHIFTEQ 45 */     { BINARY_OP,  2, "%l >>= %r" },
00098         /* OPBITANDEQ 46 */     { BINARY_OP,  2, "%l &= %r" },
00099         /* OPBITXOREQ 47 */     { BINARY_OP,  2, "%l ^= %r" },
00100         /* OPBITOREQ 48 */      { BINARY_OP,  2, "%l |= %r" },
00101         /* OPPREINC 49 */       { UNARY_OP,  14, "++%l" },
00102         /* OPPREDEC 50 */       { UNARY_OP,  14, "--%l" },
00103         /* OPDOT 51 */          { BINARY_OP, 15, "%l.%r" },
00104         /* OPARROW 52 */        { BINARY_OP, 15, "%l -> %r"},
00105         /* OPNEG1 53 */         { UNARY_OP,  14, "-%l" },
00106         /* OPDMIN 54 */         { BINARY_OP, 0, "dmin(%l,%r)" },
00107         /* OPDMAX 55 */         { BINARY_OP, 0, "dmax(%l,%r)" },
00108         /* OPASSIGNI 56 */      { BINARY_OP,  2, "%l = &%r" },
00109         /* OPIDENTITY 57 */     { UNARY_OP, 15, "%l" },
00110         /* OPCHARCAST 58 */     { UNARY_OP, 14, "(char *)&%l" },
00111         /* OPDABS 59 */         { UNARY_OP, 0, "dabs(%l)" },
00112         /* OPMIN2 60 */         { BINARY_OP,   0, "min(%l,%r)" },
00113         /* OPMAX2 61 */         { BINARY_OP,   0, "max(%l,%r)" },
00114         /* OPBITTEST 62 */      { BINARY_OP,   0, "bit_test(%l,%r)" },
00115         /* OPBITCLR 63 */       { BINARY_OP,   0, "bit_clear(%l,%r)" },
00116         /* OPBITSET 64 */       { BINARY_OP,   0, "bit_set(%l,%r)" },
00117 #ifdef TYQUAD
00118         /* OPQBITCLR 65 */      { BINARY_OP,   0, "qbit_clear(%l,%r)" },
00119         /* OPQBITSET 66 */      { BINARY_OP,   0, "qbit_set(%l,%r)" },
00120 #endif
00121 
00122 /* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
00123 
00124         /* OPNEG KLUDGE */      { UNARY_OP,  14, "-(doublereal)%l" }
00125 }; /* opcode_table */
00126 
00127 #define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
00128 
00129 extern int dneg;
00130 static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
00131 
00132 
00133 static void output_arg_list Argdcl((FILEP, struct Listblock*));
00134 static void output_binary Argdcl((FILEP, Exprp));
00135 static void output_list Argdcl((FILEP, struct Listblock*));
00136 static void output_literal Argdcl((FILEP, long, Constp));
00137 static void output_prim Argdcl((FILEP, struct Primblock*));
00138 static void output_unary Argdcl((FILEP, Exprp));
00139 
00140 
00141  void
00142 #ifdef KR_headers
00143 expr_out(fp, e)
00144         FILE *fp;
00145         expptr e;
00146 #else
00147 expr_out(FILE *fp, expptr e)
00148 #endif
00149 {
00150     if (e == (expptr) NULL)
00151         return;
00152 
00153     switch (e -> tag) {
00154         case TNAME:     out_name (fp, (struct Nameblock *) e);
00155                         return;
00156 
00157         case TCONST:    out_const(fp, &e->constblock);
00158                         goto end_out;
00159         case TEXPR:
00160                         break;
00161 
00162         case TADDR:     out_addr (fp, &(e -> addrblock));
00163                         goto end_out;
00164 
00165         case TPRIM:     if (!nerr)
00166                                 warn ("expr_out: got TPRIM");
00167                         output_prim (fp, &(e -> primblock));
00168                         return;
00169 
00170         case TLIST:     output_list (fp, &(e -> listblock));
00171  end_out:               frexpr(e);
00172                         return;
00173 
00174         case TIMPLDO:   err ("expr_out: got TIMPLDO");
00175                         return;
00176 
00177         case TERROR:
00178         default:
00179                         erri ("expr_out: bad tag '%d'", e -> tag);
00180     } /* switch */
00181 
00182 /* Now we know that the tag is TEXPR */
00183 
00184 /* Optimize on simple expressions, such as "a = a + b" ==> "a += b" */
00185 
00186     if (e -> exprblock.opcode == OPASSIGN && e -> exprblock.rightp &&
00187         e -> exprblock.rightp -> tag == TEXPR) {
00188         int opcode;
00189 
00190         opcode = e -> exprblock.rightp -> exprblock.opcode;
00191 
00192         if (opeqable[opcode]) {
00193             expptr leftp, rightp;
00194 
00195             if ((leftp = e -> exprblock.leftp) &&
00196                 (rightp = e -> exprblock.rightp -> exprblock.leftp)) {
00197 
00198                 if (same_ident (leftp, rightp)) {
00199                     expptr temp = e -> exprblock.rightp;
00200 
00201                     e -> exprblock.opcode = op_assign(opcode);
00202 
00203                     e -> exprblock.rightp = temp -> exprblock.rightp;
00204                     temp->exprblock.rightp = 0;
00205                     frexpr(temp);
00206                 } /* if same_ident (leftp, rightp) */
00207             } /* if leftp && rightp */
00208         } /* if opcode == OPPLUS || */
00209     } /* if e -> exprblock.opcode == OPASSIGN */
00210 
00211 
00212 /* Optimize on increment or decrement by 1 */
00213 
00214     {
00215         int opcode = e -> exprblock.opcode;
00216         expptr leftp = e -> exprblock.leftp;
00217         expptr rightp = e -> exprblock.rightp;
00218 
00219         if (leftp && rightp && (leftp -> headblock.vstg == STGARG ||
00220                 ISINT (leftp -> headblock.vtype)) &&
00221                 (opcode == OPPLUSEQ || opcode == OPMINUSEQ) &&
00222                 ISINT (rightp -> headblock.vtype) &&
00223                 ISICON (e -> exprblock.rightp) &&
00224                 (ISONE (e -> exprblock.rightp) ||
00225                 e -> exprblock.rightp -> constblock.Const.ci == -1)) {
00226 
00227 /* Allow for the '-1' constant value */
00228 
00229             if (!ISONE (e -> exprblock.rightp))
00230                 opcode = (opcode == OPPLUSEQ) ? OPMINUSEQ : OPPLUSEQ;
00231 
00232 /* replace the existing opcode */
00233 
00234             if (opcode == OPPLUSEQ)
00235                 e -> exprblock.opcode = OPPREINC;
00236             else
00237                 e -> exprblock.opcode = OPPREDEC;
00238 
00239 /* Free up storage used by the right hand side */
00240 
00241             frexpr (e -> exprblock.rightp);
00242             e->exprblock.rightp = 0;
00243         } /* if opcode == OPPLUS */
00244     } /* block */
00245 
00246 
00247     if (is_unary_op (e -> exprblock.opcode))
00248         output_unary (fp, &(e -> exprblock));
00249     else if (is_binary_op (e -> exprblock.opcode))
00250         output_binary (fp, &(e -> exprblock));
00251     else
00252         erri ("expr_out: bad opcode '%d'", (int) e -> exprblock.opcode);
00253 
00254     free((char *)e);
00255 
00256 } /* expr_out */
00257 
00258 
00259  void
00260 #ifdef KR_headers
00261 out_and_free_statement(outfile, expr)
00262         FILE *outfile;
00263         expptr expr;
00264 #else
00265 out_and_free_statement(FILE *outfile, expptr expr)
00266 #endif
00267 {
00268     if (expr)
00269         expr_out (outfile, expr);
00270 
00271     nice_printf (outfile, ";\n");
00272 } /* out_and_free_statement */
00273 
00274 
00275 
00276  int
00277 #ifdef KR_headers
00278 same_ident(left, right)
00279         expptr left;
00280         expptr right;
00281 #else
00282 same_ident(expptr left, expptr right)
00283 #endif
00284 {
00285     if (!left || !right)
00286         return 0;
00287 
00288     if (left -> tag == TNAME && right -> tag == TNAME && left == right)
00289         return 1;
00290 
00291     if (left -> tag == TADDR && right -> tag == TADDR &&
00292             left -> addrblock.uname_tag == right -> addrblock.uname_tag)
00293         switch (left -> addrblock.uname_tag) {
00294             case UNAM_REF:
00295             case UNAM_NAME:
00296 
00297 /* Check for array subscripts */
00298 
00299                 if (left -> addrblock.user.name -> vdim ||
00300                         right -> addrblock.user.name -> vdim)
00301                     if (left -> addrblock.user.name !=
00302                             right -> addrblock.user.name ||
00303                             !same_expr (left -> addrblock.memoffset,
00304                             right -> addrblock.memoffset))
00305                         return 0;
00306 
00307                 return same_ident ((expptr) (left -> addrblock.user.name),
00308                         (expptr) right -> addrblock.user.name);
00309             case UNAM_IDENT:
00310                 return strcmp(left->addrblock.user.ident,
00311                                 right->addrblock.user.ident) == 0;
00312             case UNAM_CHARP:
00313                 return strcmp(left->addrblock.user.Charp,
00314                                 right->addrblock.user.Charp) == 0;
00315             default:
00316                 return 0;
00317         } /* switch */
00318 
00319     if (left->tag == TEXPR && left->exprblock.opcode == OPWHATSIN
00320         && right->tag == TEXPR && right->exprblock.opcode == OPWHATSIN)
00321                 return same_ident(left->exprblock.leftp,
00322                                  right->exprblock.leftp);
00323 
00324     return 0;
00325 } /* same_ident */
00326 
00327  static int
00328 #ifdef KR_headers
00329 samefpconst(c1, c2, n)
00330         register Constp c1;
00331         register Constp c2;
00332         register int n;
00333 #else
00334 samefpconst(register Constp c1, register Constp c2, register int n)
00335 #endif
00336 {
00337         char *s1, *s2;
00338         if (!c1->vstg && !c2->vstg)
00339                 return c1->Const.cd[n] == c2->Const.cd[n];
00340         s1 = c1->vstg ? c1->Const.cds[n] : dtos(c1->Const.cd[n]);
00341         s2 = c2->vstg ? c2->Const.cds[n] : dtos(c2->Const.cd[n]);
00342         return !strcmp(s1, s2);
00343         }
00344 
00345  static int
00346 #ifdef KR_headers
00347 sameconst(c1, c2)
00348         register Constp c1;
00349         register Constp c2;
00350 #else
00351 sameconst(register Constp c1, register Constp c2)
00352 #endif
00353 {
00354         switch(c1->vtype) {
00355                 case TYCOMPLEX:
00356                 case TYDCOMPLEX:
00357                         if (!samefpconst(c1,c2,1))
00358                                 return 0;
00359                 case TYREAL:
00360                 case TYDREAL:
00361                         return samefpconst(c1,c2,0);
00362                 case TYCHAR:
00363                         return c1->Const.ccp1.blanks == c2->Const.ccp1.blanks
00364                             &&     c1->vleng->constblock.Const.ci
00365                                 == c2->vleng->constblock.Const.ci
00366                             && !memcmp(c1->Const.ccp, c2->Const.ccp,
00367                                         (int)c1->vleng->constblock.Const.ci);
00368                 case TYSHORT:
00369                 case TYINT:
00370                 case TYLOGICAL:
00371                         return c1->Const.ci == c2->Const.ci;
00372                 }
00373         err("unexpected type in sameconst");
00374         return 0;
00375         }
00376 
00377 /* same_expr -- Returns true only if   e1 and e2   match.  This is
00378    somewhat pessimistic, but can afford to be because it's just used to
00379    optimize on the assignment operators (+=, -=, etc). */
00380 
00381  int
00382 #ifdef KR_headers
00383 same_expr(e1, e2)
00384         expptr e1;
00385         expptr e2;
00386 #else
00387 same_expr(expptr e1, expptr e2)
00388 #endif
00389 {
00390     if (!e1 || !e2)
00391         return !e1 && !e2;
00392 
00393     if (e1 -> tag != e2 -> tag || e1 -> headblock.vtype != e2 -> headblock.vtype)
00394         return 0;
00395 
00396     switch (e1 -> tag) {
00397         case TEXPR:
00398             if (e1 -> exprblock.opcode != e2 -> exprblock.opcode)
00399                 return 0;
00400 
00401             return same_expr (e1 -> exprblock.leftp, e2 -> exprblock.leftp) &&
00402                    same_expr (e1 -> exprblock.rightp, e2 -> exprblock.rightp);
00403         case TNAME:
00404         case TADDR:
00405             return same_ident (e1, e2);
00406         case TCONST:
00407             return sameconst(&e1->constblock, &e2->constblock);
00408         default:
00409             return 0;
00410     } /* switch */
00411 } /* same_expr */
00412 
00413 
00414 
00415  void
00416 #ifdef KR_headers
00417 out_name(fp, namep)
00418         FILE *fp;
00419         Namep namep;
00420 #else
00421 out_name(FILE *fp, Namep namep)
00422 #endif
00423 {
00424     extern int usedefsforcommon;
00425     Extsym *comm;
00426 
00427     if (namep == NULL)
00428         return;
00429 
00430 /* DON'T want to use oneof_stg() here; need to find the right common name
00431    */
00432 
00433     if (namep->vstg == STGCOMMON && !namep->vcommequiv && !usedefsforcommon) {
00434         comm = &extsymtab[namep->vardesc.varno];
00435         extern_out(fp, comm);
00436         nice_printf(fp, "%d.", comm->curno);
00437     } /* if namep -> vstg == STGCOMMON */
00438 
00439     if (namep->vprocclass == PTHISPROC && namep->vtype != TYSUBR)
00440         nice_printf(fp, xretslot[namep->vtype]->user.ident);
00441     else
00442         nice_printf (fp, "%s", namep->cvarname);
00443 } /* out_name */
00444 
00445 
00446 static char *Longfmt = "%ld";
00447 
00448 #define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
00449 
00450  void
00451 #ifdef KR_headers
00452 out_const(fp, cp)
00453         FILE *fp;
00454         register Constp cp;
00455 #else
00456 out_const(FILE *fp, register Constp cp)
00457 #endif
00458 {
00459     static char real_buf[50], imag_buf[50];
00460     unsigned int k;
00461     int type = cp->vtype;
00462 
00463     switch (type) {
00464         case TYINT1:
00465         case TYSHORT:
00466             nice_printf (fp, "%ld", cp->Const.ci);      /* don't cast ci! */
00467             break;
00468         case TYLONG:
00469 #ifdef TYQUAD
00470         case TYQUAD:
00471 #endif
00472             nice_printf (fp, Longfmt, cp->Const.ci);    /* don't cast ci! */
00473             break;
00474         case TYREAL:
00475             nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
00476             break;
00477         case TYDREAL:
00478             nice_printf(fp, "%s", cpd(0));
00479             break;
00480         case TYCOMPLEX:
00481             nice_printf(fp, cm_fmt_string, flconst(real_buf, cpd(0)),
00482                         flconst(imag_buf, cpd(1)));
00483             break;
00484         case TYDCOMPLEX:
00485             nice_printf(fp, dcm_fmt_string, cpd(0), cpd(1));
00486             break;
00487         case TYLOGICAL1:
00488         case TYLOGICAL2:
00489         case TYLOGICAL:
00490             nice_printf (fp, "%s", cp->Const.ci ? "TRUE_" : "FALSE_");
00491             break;
00492         case TYCHAR: {
00493             char *c = cp->Const.ccp, *ce;
00494 
00495             if (c == NULL) {
00496                 nice_printf (fp, "\"\"");
00497                 break;
00498             } /* if c == NULL */
00499 
00500             nice_printf (fp, "\"");
00501             ce = c + cp->vleng->constblock.Const.ci;
00502             while(c < ce) {
00503                 k = *(unsigned char *)c++;
00504                 nice_printf(fp, str_fmt[k], k);
00505                 }
00506             for(k = cp->Const.ccp1.blanks; k > 0; k--)
00507                 nice_printf(fp, " ");
00508             nice_printf (fp, "\"");
00509             break;
00510         } /* case TYCHAR */
00511         default:
00512             erri ("out_const:  bad type '%d'", (int) type);
00513             break;
00514     } /* switch */
00515 
00516 } /* out_const */
00517 #undef cpd
00518 
00519  static void
00520 #ifdef KR_headers
00521 out_args(fp, ep)
00522         FILE *fp;
00523         expptr ep;
00524 #else
00525 out_args(FILE *fp, expptr ep)
00526 #endif
00527 {
00528         chainp arglist;
00529 
00530         if(ep->tag != TLIST)
00531                 badtag("out_args", ep->tag);
00532         for(arglist = ep->listblock.listp;;) {
00533                 expr_out(fp, (expptr)arglist->datap);
00534                 arglist->datap = 0;
00535                 if (!(arglist = arglist->nextp))
00536                         break;
00537                 nice_printf(fp, ", ");
00538                 }
00539         }
00540 
00541 
00542 /* out_addr -- this routine isn't local because it is called by the
00543    system-generated identifier printing routines */
00544 
00545  void
00546 #ifdef KR_headers
00547 out_addr(fp, addrp)
00548         FILE *fp;
00549         struct Addrblock *addrp;
00550 #else
00551 out_addr(FILE *fp, struct Addrblock *addrp)
00552 #endif
00553 {
00554         extern Extsym *extsymtab;
00555         int was_array = 0;
00556         char *s;
00557 
00558 
00559         if (addrp == NULL)
00560                 return;
00561         if (doin_setbound
00562                         && addrp->vstg == STGARG
00563                         && addrp->vtype != TYCHAR
00564                         && ISICON(addrp->memoffset)
00565                         && !addrp->memoffset->constblock.Const.ci)
00566                 nice_printf(fp, "*");
00567 
00568         switch (addrp -> uname_tag) {
00569             case UNAM_REF:
00570                 nice_printf(fp, "%s_%s(", addrp->user.name->cvarname,
00571                         addrp->cmplx_sub ? "subscr" : "ref");
00572                 out_args(fp, addrp->memoffset);
00573                 nice_printf(fp, ")");
00574                 return;
00575             case UNAM_NAME:
00576                 out_name (fp, addrp -> user.name);
00577                 break;
00578             case UNAM_IDENT:
00579                 if (*(s = addrp->user.ident) == ' ') {
00580                         if (multitype)
00581                                 nice_printf(fp, "%s",
00582                                         xretslot[addrp->vtype]->user.ident);
00583                         else
00584                                 nice_printf(fp, "%s", s+1);
00585                         }
00586                 else {
00587                         nice_printf(fp, "%s", s);
00588                         }
00589                 break;
00590             case UNAM_CHARP:
00591                 nice_printf(fp, "%s", addrp->user.Charp);
00592                 break;
00593             case UNAM_EXTERN:
00594                 extern_out (fp, &extsymtab[addrp -> memno]);
00595                 break;
00596             case UNAM_CONST:
00597                 switch(addrp->vstg) {
00598                         case STGCONST:
00599                                 out_const(fp, (Constp)addrp);
00600                                 break;
00601                         case STGMEMNO:
00602                                 output_literal (fp, addrp->memno,
00603                                         (Constp)addrp);
00604                                 break;
00605                         default:
00606                         Fatal("unexpected vstg in out_addr");
00607                         }
00608                 break;
00609             case UNAM_UNKNOWN:
00610             default:
00611                 nice_printf (fp, "Unknown Addrp");
00612                 break;
00613         } /* switch */
00614 
00615 /* It's okay to just throw in the brackets here because they have a
00616    precedence level of 15, the highest value.  */
00617 
00618     if ((addrp->uname_tag == UNAM_NAME && addrp->user.name->vdim
00619                         || addrp->ntempelt > 1 || addrp->isarray)
00620         && addrp->vtype != TYCHAR) {
00621         expptr offset;
00622 
00623         was_array = 1;
00624 
00625         offset = addrp -> memoffset;
00626         addrp->memoffset = 0;
00627         if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
00628                 && addrp -> uname_tag == UNAM_NAME
00629                 && !addrp->skip_offset)
00630             offset = mkexpr (OPMINUS, offset, mkintcon (
00631                     addrp -> user.name -> voffset));
00632 
00633         nice_printf (fp, "[");
00634 
00635         offset = mkexpr (OPSLASH, offset,
00636                 ICON (typesize[addrp -> vtype] * (addrp -> Field ? 2 : 1)));
00637         expr_out (fp, offset);
00638         nice_printf (fp, "]");
00639         }
00640 
00641 /* Check for structure field reference */
00642 
00643     if (addrp -> Field && addrp -> uname_tag != UNAM_CONST &&
00644             addrp -> uname_tag != UNAM_UNKNOWN) {
00645         if (oneof_stg((addrp -> uname_tag == UNAM_NAME ? addrp -> user.name :
00646                 (Namep) NULL), addrp -> vstg, M(STGARG)|M(STGEQUIV))
00647                 && !was_array && (addrp->vclass != CLPROC || !multitype))
00648             nice_printf (fp, "->%s", addrp -> Field);
00649         else
00650             nice_printf (fp, ".%s", addrp -> Field);
00651     } /* if */
00652 
00653 /* Check for character subscripting */
00654 
00655     if (addrp->vtype == TYCHAR &&
00656             (addrp->vclass != CLPROC || addrp->uname_tag == UNAM_NAME
00657                         && addrp->user.name->vprocclass == PTHISPROC) &&
00658             addrp -> memoffset &&
00659             (addrp -> uname_tag != UNAM_NAME ||
00660              addrp -> user.name -> vtype == TYCHAR) &&
00661             (!ISICON (addrp -> memoffset) ||
00662              (addrp -> memoffset -> constblock.Const.ci))) {
00663 
00664         int use_paren = 0;
00665         expptr e = addrp -> memoffset;
00666 
00667         if (!e)
00668                 return;
00669         addrp->memoffset = 0;
00670 
00671         if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
00672          && addrp -> uname_tag == UNAM_NAME) {
00673             e = mkexpr (OPMINUS, e, mkintcon (addrp -> user.name -> voffset));
00674 
00675 /* mkexpr will simplify it to zero if possible */
00676             if (e->tag == TCONST && e->constblock.Const.ci == 0)
00677                 return;
00678         } /* if addrp -> vstg == STGCOMMON */
00679 
00680 /* In the worst case, parentheses might be needed OUTSIDE the expression,
00681    too.  But since I think this subscripting can only appear as a
00682    parameter in a procedure call, I don't think outside parens will ever
00683    be needed.  INSIDE parens are handled below */
00684 
00685         nice_printf (fp, " + ");
00686         if (e -> tag == TEXPR) {
00687             int arg_prec = op_precedence (e -> exprblock.opcode);
00688             int prec = op_precedence (OPPLUS);
00689             use_paren = arg_prec && (arg_prec < prec || (arg_prec == prec &&
00690                     is_left_assoc (OPPLUS)));
00691         } /* if e -> tag == TEXPR */
00692         if (use_paren) nice_printf (fp, "(");
00693         expr_out (fp, e);
00694         if (use_paren) nice_printf (fp, ")");
00695     } /* if */
00696 } /* out_addr */
00697 
00698 
00699  static void
00700 #ifdef KR_headers
00701 output_literal(fp, memno, cp)
00702         FILE *fp;
00703         long memno;
00704         Constp cp;
00705 #else
00706 output_literal(FILE *fp, long memno, Constp cp)
00707 #endif
00708 {
00709     struct Literal *litp, *lastlit;
00710 
00711     lastlit = litpool + nliterals;
00712 
00713     for (litp = litpool; litp < lastlit; litp++) {
00714         if (litp -> litnum == memno)
00715             break;
00716     } /* for litp */
00717 
00718     if (litp >= lastlit)
00719         out_const (fp, cp);
00720     else {
00721         nice_printf (fp, "%s", lit_name (litp));
00722         litp->lituse++;
00723         }
00724 } /* output_literal */
00725 
00726 
00727  static void
00728 #ifdef KR_headers
00729 output_prim(fp, primp)
00730         FILE *fp;
00731         struct Primblock *primp;
00732 #else
00733 output_prim(FILE *fp, struct Primblock *primp)
00734 #endif
00735 {
00736     if (primp == NULL)
00737         return;
00738 
00739     out_name (fp, primp -> namep);
00740     if (primp -> argsp)
00741         output_arg_list (fp, primp -> argsp);
00742 
00743     if (primp -> fcharp != (expptr) NULL || primp -> lcharp != (expptr) NULL)
00744         nice_printf (fp, "Sorry, no substrings yet");
00745 }
00746 
00747 
00748 
00749  static void
00750 #ifdef KR_headers
00751 output_arg_list(fp, listp)
00752         FILE *fp;
00753         struct Listblock *listp;
00754 #else
00755 output_arg_list(FILE *fp, struct Listblock *listp)
00756 #endif
00757 {
00758     chainp arg_list;
00759 
00760     if (listp == (struct Listblock *) NULL || listp -> listp == (chainp) NULL)
00761         return;
00762 
00763     nice_printf (fp, "(");
00764 
00765     for (arg_list = listp -> listp; arg_list; arg_list = arg_list -> nextp) {
00766         expr_out (fp, (expptr) arg_list -> datap);
00767         if (arg_list -> nextp != (chainp) NULL)
00768 
00769 /* Might want to add a hook in here to accomodate the style setting which
00770    wants spaces after commas */
00771 
00772             nice_printf (fp, ",");
00773     } /* for arg_list */
00774 
00775     nice_printf (fp, ")");
00776 } /* output_arg_list */
00777 
00778 
00779 
00780  static void
00781 #ifdef KR_headers
00782 output_unary(fp, e)
00783         FILE *fp;
00784         struct Exprblock *e;
00785 #else
00786 output_unary(FILE *fp, struct Exprblock *e)
00787 #endif
00788 {
00789     if (e == NULL)
00790         return;
00791 
00792     switch (e -> opcode) {
00793         case OPNEG:
00794                 if (e->vtype == TYREAL && dneg) {
00795                         e->opcode = OPNEG_KLUDGE;
00796                         output_binary(fp,e);
00797                         e->opcode = OPNEG;
00798                         break;
00799                         }
00800         case OPNEG1:
00801         case OPNOT:
00802         case OPABS:
00803         case OPBITNOT:
00804         case OPWHATSIN:
00805         case OPPREINC:
00806         case OPPREDEC:
00807         case OPADDR:
00808         case OPIDENTITY:
00809         case OPCHARCAST:
00810         case OPDABS:
00811             output_binary (fp, e);
00812             break;
00813         case OPCALL:
00814         case OPCCALL:
00815             nice_printf (fp, "Sorry, no OPCALL yet");
00816             break;
00817         default:
00818             erri ("output_unary: bad opcode", (int) e -> opcode);
00819             break;
00820     } /* switch */
00821 } /* output_unary */
00822 
00823 
00824  static char *
00825 #ifdef KR_headers
00826 findconst(m)
00827         register long m;
00828 #else
00829 findconst(register long m)
00830 #endif
00831 {
00832         register struct Literal *litp, *litpe;
00833 
00834         litp = litpool;
00835         for(litpe = litp + nliterals; litp < litpe; litp++)
00836                 if (litp->litnum ==  m)
00837                         return litp->cds[0];
00838         Fatal("findconst failure!");
00839         return 0;
00840         }
00841 
00842  static int
00843 #ifdef KR_headers
00844 opconv_fudge(fp, e)
00845         FILE *fp;
00846         struct Exprblock *e;
00847 #else
00848 opconv_fudge(FILE *fp, struct Exprblock *e)
00849 #endif
00850 {
00851         /* special handling for conversions, ichar and character*1 */
00852         register expptr lp;
00853         register union Expression *Offset;
00854         register char *cp;
00855         int lt;
00856         char buf[8], *s;
00857         unsigned int k;
00858         Namep np;
00859         Addrp ap;
00860 
00861         if (!(lp = e->leftp))   /* possible with erroneous Fortran */
00862                 return 1;
00863         lt = lp->headblock.vtype;
00864         if (lt == TYCHAR) {
00865                 switch(lp->tag) {
00866                         case TNAME:
00867                                 nice_printf(fp, "*(unsigned char *)");
00868                                 out_name(fp, (Namep)lp);
00869                                 return 1;
00870                         case TCONST:
00871  tconst:
00872                                 cp = lp->constblock.Const.ccp;
00873  tconst1:
00874                                 k = *(unsigned char *)cp;
00875                                 if (k < 128) { /* ASCII character */
00876                                         sprintf(buf, chr_fmt[k], k);
00877                                         nice_printf(fp, "'%s'", buf);
00878                                         }
00879                                 else
00880                                         nice_printf(fp, "%d", k);
00881                                 return 1;
00882                         case TADDR:
00883                                 switch(lp->addrblock.vstg) {
00884                                     case STGMEMNO:
00885                                         if (halign && e->vtype != TYCHAR) {
00886                                                 nice_printf(fp, "*(%s *)",
00887                                                     c_type_decl(e->vtype,0));
00888                                                 expr_out(fp, lp);
00889                                                 return 1;
00890                                                 }
00891                                         cp = findconst(lp->addrblock.memno);
00892                                         goto tconst1;
00893                                     case STGCONST:
00894                                         goto tconst;
00895                                     }
00896                                 lp->addrblock.vtype = tyint;
00897                                 Offset = lp->addrblock.memoffset;
00898                                 switch(lp->addrblock.uname_tag) {
00899                                   case UNAM_REF:
00900                                         nice_printf(fp, "*(unsigned char *)");
00901                                         return 0;
00902                                   case UNAM_NAME:
00903                                         np = lp->addrblock.user.name;
00904                                         if (ONEOF(np->vstg,
00905                                             M(STGCOMMON)|M(STGEQUIV)))
00906                                                 Offset = mkexpr(OPMINUS, Offset,
00907                                                         ICON(np->voffset));
00908                                         }
00909                                 lp->addrblock.memoffset = Offset ?
00910                                         mkexpr(OPSTAR, Offset,
00911                                                 ICON(typesize[tyint]))
00912                                         : ICON(0);
00913                                 lp->addrblock.isarray = 1;
00914                                 /* STGCOMMON or STGEQUIV would cause */
00915                                 /* voffset to be added in a second time */
00916                                 lp->addrblock.vstg = STGUNKNOWN;
00917                                 nice_printf(fp, "*(unsigned char *)&");
00918                                 return 0;
00919                         default:
00920                                 badtag("opconv_fudge", lp->tag);
00921                         }
00922                 }
00923         if (lt != e->vtype) {
00924                 s = c_type_decl(e->vtype, 0);
00925                 if (ISCOMPLEX(lt)) {
00926                         np = (Namep)e->leftp;
00927                         switch(np->tag) {
00928                           case TNAME:
00929                                 nice_printf(fp, "(%s) %s.r", s,
00930                                         np->cvarname);
00931                                 return 1;
00932                           case TADDR:
00933                                 ap = (Addrp)np;
00934                                 switch(ap->uname_tag) {
00935                                   case UNAM_IDENT:
00936                                         nice_printf(fp, "(%s) %s.r", s,
00937                                                 ap->user.ident);
00938                                         return 1;
00939                                   case UNAM_NAME:
00940                                         nice_printf(fp, "(%s) ", s);
00941                                         out_addr(fp, ap);
00942                                         nice_printf(fp, ".r");
00943                                         return 1;
00944                                   }
00945                           default:
00946                                 fatali("Unexpected tag %d in opconv_fudge",
00947                                         np->tag);
00948                           }
00949                         }
00950                 nice_printf(fp, "(%s) ", s);
00951                 }
00952         return 0;
00953         }
00954 
00955 
00956  static void
00957 #ifdef KR_headers
00958 output_binary(fp, e)
00959         FILE *fp;
00960         struct Exprblock *e;
00961 #else
00962 output_binary(FILE *fp, struct Exprblock *e)
00963 #endif
00964 {
00965     char *format;
00966     extern table_entry opcode_table[];
00967     int prec;
00968 
00969     if (e == NULL || e -> tag != TEXPR)
00970         return;
00971 
00972 /* Instead of writing a huge switch, I've incorporated the output format
00973    into a table.  Things like "%l" and "%r" stand for the left and
00974    right subexpressions.  This should allow both prefix and infix
00975    functions to be specified (e.g. "(%l * %r", "z_div (%l, %r").  Of
00976    course, I should REALLY think out the ramifications of writing out
00977    straight text, as opposed to some intermediate format, which could
00978    figure out and optimize on the the number of required blanks (we don't
00979    want "x - (-y)" to become "x --y", for example).  Special cases (such as
00980    incomplete implementations) could still be implemented as part of the
00981    switch, they will just have some dummy value instead of the string
00982    pattern.  Another difficulty is the fact that the complex functions
00983    will differ from the integer and real ones */
00984 
00985 /* Handle a special case.  We don't want to output "x + - 4", or "y - - 3"
00986 */
00987     if ((e -> opcode == OPPLUS || e -> opcode == OPMINUS) &&
00988             e -> rightp && e -> rightp -> tag == TCONST &&
00989             isnegative_const (&(e -> rightp -> constblock)) &&
00990             is_negatable (&(e -> rightp -> constblock))) {
00991 
00992         e -> opcode = (e -> opcode == OPPLUS) ? OPMINUS : OPPLUS;
00993         negate_const (&(e -> rightp -> constblock));
00994     } /* if e -> opcode == PLUS or MINUS */
00995 
00996     prec = op_precedence (e -> opcode);
00997     format = op_format (e -> opcode);
00998 
00999     if (format != SPECIAL_FMT) {
01000         while (*format) {
01001             if (*format == '%') {
01002                 int arg_prec, use_paren = 0;
01003                 expptr lp, rp;
01004 
01005                 switch (*(format + 1)) {
01006                     case 'l':
01007                         lp = e->leftp;
01008                         if (lp && lp->tag == TEXPR) {
01009                             arg_prec = op_precedence(lp->exprblock.opcode);
01010 
01011                             use_paren = arg_prec &&
01012                                 (arg_prec < prec || (arg_prec == prec &&
01013                                     is_right_assoc (prec)));
01014                         } /* if e -> leftp */
01015                         if (e->opcode == OPCONV && opconv_fudge(fp,e))
01016                                 break;
01017                         if (use_paren)
01018                             nice_printf (fp, "(");
01019                         expr_out(fp, lp);
01020                         if (use_paren)
01021                             nice_printf (fp, ")");
01022                         break;
01023                     case 'r':
01024                         rp = e->rightp;
01025                         if (rp && rp->tag == TEXPR) {
01026                             arg_prec = op_precedence(rp->exprblock.opcode);
01027 
01028                             use_paren = arg_prec &&
01029                                 (arg_prec < prec || (arg_prec == prec &&
01030                                     is_left_assoc (prec)));
01031                             use_paren = use_paren ||
01032                                 (rp->exprblock.opcode == OPNEG
01033                                 && prec >= op_precedence(OPMINUS));
01034                         } /* if e -> rightp */
01035                         if (use_paren)
01036                             nice_printf (fp, "(");
01037                         expr_out(fp, rp);
01038                         if (use_paren)
01039                             nice_printf (fp, ")");
01040                         break;
01041                     case '\0':
01042                     case '%':
01043                         nice_printf (fp, "%%");
01044                         break;
01045                     default:
01046                         erri ("output_binary: format err: '%%%c' illegal",
01047                                 (int) *(format + 1));
01048                         break;
01049                 } /* switch */
01050                 format += 2;
01051             } else
01052                 nice_printf (fp, "%c", *format++);
01053         } /* while *format */
01054     } else {
01055 
01056 /* Handle Special cases of formatting */
01057 
01058         switch (e -> opcode) {
01059                 case OPCCALL:
01060                 case OPCALL:
01061                         out_call (fp, (int) e -> opcode, e -> vtype,
01062                                         e -> vleng, e -> leftp, e -> rightp);
01063                         break;
01064 
01065                 case OPCOMMA_ARG:
01066                         doin_setbound = 1;
01067                         nice_printf(fp, "(");
01068                         expr_out(fp, e->leftp);
01069                         nice_printf(fp, ", &");
01070                         doin_setbound = 0;
01071                         expr_out(fp, e->rightp);
01072                         nice_printf(fp, ")");
01073                         break;
01074 
01075                 case OPADDR:
01076                 default:
01077                         nice_printf (fp, "Sorry, can't format OPCODE '%d'",
01078                                 e -> opcode);
01079                         break;
01080                 }
01081 
01082     } /* else */
01083 } /* output_binary */
01084 
01085  void
01086 #ifdef KR_headers
01087 out_call(outfile, op, ftype, len, name, args)
01088         FILE *outfile;
01089         int op;
01090         int ftype;
01091         expptr len;
01092         expptr name;
01093         expptr args;
01094 #else
01095 out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
01096 #endif
01097 {
01098     chainp arglist;             /* Pointer to any actual arguments */
01099     chainp cp;                  /* Iterator over argument lists */
01100     Addrp ret_val = (Addrp) NULL;
01101                                 /* Function return value buffer, if any is
01102                                    required */
01103     int byvalue;                /* True iff we're calling a C library
01104                                    routine */
01105     int done_once;              /* Used for writing commas to   outfile   */
01106     int narg, t;
01107     register expptr q;
01108     long L;
01109     Argtypes *at;
01110     Atype *A, *Ac;
01111     Namep np;
01112     extern int forcereal;
01113 
01114 /* Don't use addresses if we're calling a C function */
01115 
01116     byvalue = op == OPCCALL;
01117 
01118     if (args)
01119         arglist = args -> listblock.listp;
01120     else
01121         arglist = CHNULL;
01122 
01123 /* If this is a CHARACTER function, the first argument is the result */
01124 
01125     if (ftype == TYCHAR)
01126         if (ISICON (len)) {
01127             ret_val = (Addrp) (arglist -> datap);
01128             arglist = arglist -> nextp;
01129         } else {
01130             err ("adjustable character function");
01131             return;
01132         } /* else */
01133 
01134 /* If this is a COMPLEX function, the first argument is the result */
01135 
01136     else if (ISCOMPLEX (ftype)) {
01137         ret_val = (Addrp) (arglist -> datap);
01138         arglist = arglist -> nextp;
01139     } /* if ISCOMPLEX */
01140 
01141     /* prepare to cast procedure parameters -- set A if we know how */
01142     np = name->tag == TEXPR && name->exprblock.opcode == OPWHATSIN
01143         ? (Namep)name->exprblock.leftp : (Namep)name;
01144 
01145     A = Ac = 0;
01146     if (np->tag == TNAME && (at = np->arginfo)) {
01147         if (at->nargs > 0)
01148                 A = at->atypes;
01149         if (Ansi && (at->defined || at->nargs > 0))
01150                 Ac = at->atypes;
01151         }
01152 
01153 /* Now we can actually start to write out the function invocation */
01154 
01155     if (ftype == TYREAL && forcereal)
01156         nice_printf(outfile, "(real)");
01157     if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
01158         nice_printf (outfile, "(");
01159         expr_out (outfile, name);
01160         nice_printf (outfile, ")");
01161         }
01162     else
01163         expr_out(outfile, name);
01164 
01165     nice_printf(outfile, "(");
01166 
01167     if (ret_val) {
01168         if (ISCOMPLEX (ftype))
01169             nice_printf (outfile, "&");
01170         expr_out (outfile, (expptr) ret_val);
01171         if (Ac)
01172                 Ac++;
01173 
01174 /* The length of the result of a character function is the second argument */
01175 /* It should be in place from putcall(), so we won't touch it explicitly */
01176 
01177     } /* if ret_val */
01178     done_once = ret_val ? TRUE : FALSE;
01179 
01180 /* Now run through the named arguments */
01181 
01182     narg = -1;
01183     for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
01184 
01185         if (done_once)
01186             nice_printf (outfile, ", ");
01187         narg++;
01188 
01189         if (!( q = (expptr)cp->datap) )
01190                 continue;
01191 
01192         if (q->tag == TADDR) {
01193                 if (q->addrblock.vtype > TYERROR) {
01194                         /* I/O block */
01195                         nice_printf(outfile, "&%s", q->addrblock.user.ident);
01196                         continue;
01197                         }
01198                 if (!byvalue && q->addrblock.isarray
01199                 && q->addrblock.vtype != TYCHAR
01200                 && q->addrblock.memoffset->tag == TCONST) {
01201 
01202                         /* check for 0 offset -- after */
01203                         /* correcting for equivalence. */
01204                         L = q->addrblock.memoffset->constblock.Const.ci;
01205                         if (ONEOF(q->addrblock.vstg, M(STGCOMMON)|M(STGEQUIV))
01206                                         && q->addrblock.uname_tag == UNAM_NAME)
01207                                 L -= q->addrblock.user.name->voffset;
01208                         if (L)
01209                                 goto skip_deref;
01210 
01211                         if (Ac && narg < at->dnargs
01212                          && q->headblock.vtype != (t = Ac[narg].type)
01213                          && t > TYADDR && t < TYSUBR)
01214                                 nice_printf(outfile, "(%s*)", typename[t]);
01215 
01216                         /* &x[0] == x */
01217                         /* This also prevents &sizeof(doublereal)[0] */
01218 
01219                         switch(q->addrblock.uname_tag) {
01220                             case UNAM_NAME:
01221                                 out_name(outfile, q->addrblock.user.name);
01222                                 continue;
01223                             case UNAM_IDENT:
01224                                 nice_printf(outfile, "%s",
01225                                         q->addrblock.user.ident);
01226                                 continue;
01227                             case UNAM_CHARP:
01228                                 nice_printf(outfile, "%s",
01229                                         q->addrblock.user.Charp);
01230                                 continue;
01231                             case UNAM_EXTERN:
01232                                 extern_out(outfile,
01233                                         &extsymtab[q->addrblock.memno]);
01234                                 continue;
01235                             }
01236                         }
01237                 }
01238 
01239 /* Skip over the dereferencing operator generated only for the
01240    intermediate file */
01241  skip_deref:
01242         if (q -> tag == TEXPR && q -> exprblock.opcode == OPWHATSIN)
01243             q = q -> exprblock.leftp;
01244 
01245         if (q->headblock.vclass == CLPROC) {
01246             if (Castargs && (q->tag != TNAME
01247                                 || q->nameblock.vprocclass != PTHISPROC)
01248                          && (q->tag != TADDR
01249                                 || q->addrblock.uname_tag != UNAM_NAME
01250                                 || q->addrblock.user.name->vprocclass
01251                                                                 != PTHISPROC))
01252                 {
01253                 if (A && (t = A[narg].type) >= 200)
01254                         t %= 100;
01255                 else {
01256                         t = q->headblock.vtype;
01257                         if (q->tag == TNAME && q->nameblock.vimpltype)
01258                                 t = TYUNKNOWN;
01259                         }
01260                 nice_printf(outfile, "(%s)", usedcasts[t] = casttypes[t]);
01261                 }
01262             }
01263         else if (Ac && narg < at->dnargs
01264                 && q->headblock.vtype != (t = Ac[narg].type)
01265                 && t > TYADDR && t < TYSUBR)
01266                 nice_printf(outfile, "(%s*)", typename[t]);
01267 
01268         if ((q -> tag == TADDR || q-> tag == TNAME) &&
01269                 (byvalue || q -> headblock.vstg != STGREG)) {
01270             if (q -> headblock.vtype != TYCHAR)
01271               if (byvalue) {
01272 
01273                 if (q -> tag == TADDR &&
01274                         q -> addrblock.uname_tag == UNAM_NAME &&
01275                         ! q -> addrblock.user.name -> vdim &&
01276                         oneof_stg(q -> addrblock.user.name, q -> addrblock.vstg,
01277                                         M(STGARG)|M(STGEQUIV)) &&
01278                         ! ISCOMPLEX(q->addrblock.user.name->vtype))
01279                     nice_printf (outfile, "*");
01280                 else if (q -> tag == TNAME
01281                         && oneof_stg(&q->nameblock, q -> nameblock.vstg,
01282                                 M(STGARG)|M(STGEQUIV))
01283                         && !(q -> nameblock.vdim))
01284                     nice_printf (outfile, "*");
01285 
01286               } else {
01287                 expptr memoffset;
01288 
01289                 if (q->tag == TADDR &&
01290                         !ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
01291                         && (
01292                         ONEOF(q->addrblock.vstg,
01293                                 M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
01294                         || ((memoffset = q->addrblock.memoffset)
01295                                 && (!ISICON(memoffset)
01296                                 || memoffset->constblock.Const.ci)))
01297                         || ONEOF(q->addrblock.vstg,
01298                                         M(STGINIT)|M(STGAUTO)|M(STGBSS))
01299                                 && !q->addrblock.isarray)
01300                     nice_printf (outfile, "&");
01301                 else if (q -> tag == TNAME
01302                         && !oneof_stg(&q->nameblock, q -> nameblock.vstg,
01303                                 M(STGARG)|M(STGEXT)|M(STGEQUIV)))
01304                     nice_printf (outfile, "&");
01305             } /* else */
01306 
01307             expr_out (outfile, q);
01308         } /* if q -> tag == TADDR || q -> tag == TNAME */
01309 
01310 /* Might be a Constant expression, e.g. string length, character constants */
01311 
01312         else if (q -> tag == TCONST) {
01313             if (tyioint == TYLONG)
01314                 Longfmt = "%ldL";
01315             out_const(outfile, &q->constblock);
01316             Longfmt = "%ld";
01317             }
01318 
01319 /* Must be some other kind of expression, or register var, or constant.
01320    In particular, this is likely to be a temporary variable assignment
01321    which was generated in p1put_call */
01322 
01323         else if (!ISCOMPLEX (q -> headblock.vtype) && !ISCHAR (q)){
01324             int use_paren = q -> tag == TEXPR &&
01325                     op_precedence (q -> exprblock.opcode) <=
01326                     op_precedence (OPCOMMA);
01327 
01328             if (use_paren) nice_printf (outfile, "(");
01329             expr_out (outfile, q);
01330             if (use_paren) nice_printf (outfile, ")");
01331         } /* if !ISCOMPLEX */
01332         else
01333             err ("out_call:  unknown parameter");
01334 
01335     } /* for (cp = arglist */
01336 
01337     if (arglist)
01338         frchain (&arglist);
01339 
01340     nice_printf (outfile, ")");
01341 
01342 } /* out_call */
01343 
01344 
01345  char *
01346 #ifdef KR_headers
01347 flconst(buf, x)
01348         char *buf;
01349         char *x;
01350 #else
01351 flconst(char *buf, char *x)
01352 #endif
01353 {
01354         sprintf(buf, fl_fmt_string, x);
01355         return buf;
01356         }
01357 
01358  char *
01359 #ifdef KR_headers
01360 dtos(x)
01361         double x;
01362 #else
01363 dtos(double x)
01364 #endif
01365 {
01366         static char buf[64];
01367 #ifdef USE_DTOA
01368         g_fmt(buf, x);
01369 #else
01370         sprintf(buf, db_fmt_string, x);
01371 #endif
01372         return strcpy(mem(strlen(buf)+1,0), buf);
01373         }
01374 
01375 char tr_tab[Table_size];
01376 
01377 /* out_init -- Initialize the data structures used by the routines in
01378    output.c.  These structures include the output format to be used for
01379    Float, Double, Complex, and Double Complex constants. */
01380 
01381  void
01382 out_init(Void)
01383 {
01384     extern int tab_size;
01385     register char *s;
01386 
01387     s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
01388     while(*s)
01389         tr_tab[*s++] = 3;
01390     tr_tab['>'] = 1;
01391 
01392         opeqable[OPPLUS] = 1;
01393         opeqable[OPMINUS] = 1;
01394         opeqable[OPSTAR] = 1;
01395         opeqable[OPSLASH] = 1;
01396         opeqable[OPMOD] = 1;
01397         opeqable[OPLSHIFT] = 1;
01398         opeqable[OPBITAND] = 1;
01399         opeqable[OPBITXOR] = 1;
01400         opeqable[OPBITOR ] = 1;
01401 
01402 
01403 /* Set the output format for both types of floating point constants */
01404 
01405     if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
01406         fl_fmt_string = Ansi == 1 ? "%sf" : "(float)%s";
01407 
01408     if (db_fmt_string == NULL || *db_fmt_string == '\0')
01409         db_fmt_string = "%.17g";
01410 
01411 /* Set the output format for both types of complex constants.  They will
01412    have string parameters rather than float or double so that the decimal
01413    point may be added to the strings generated by the {db,fl}_fmt_string
01414    formats above */
01415 
01416     if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
01417         cm_fmt_string = "{%s,%s}";
01418     } /* if cm_fmt_string == NULL */
01419 
01420     if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
01421         dcm_fmt_string = "{%s,%s}";
01422     } /* if dcm_fmt_string == NULL */
01423 
01424     tab_size = 4;
01425 } /* out_init */
01426 
01427 
01428  void
01429 #ifdef KR_headers
01430 extern_out(fp, extsym)
01431         FILE *fp;
01432         Extsym *extsym;
01433 #else
01434 extern_out(FILE *fp, Extsym *extsym)
01435 #endif
01436 {
01437     if (extsym == (Extsym *) NULL)
01438         return;
01439 
01440     nice_printf (fp, "%s", extsym->cextname);
01441 
01442 } /* extern_out */
01443 
01444 
01445 
01446  static void
01447 #ifdef KR_headers
01448 output_list(fp, listp)
01449         FILE *fp;
01450         struct Listblock *listp;
01451 #else
01452 output_list(FILE *fp, struct Listblock *listp)
01453 #endif
01454 {
01455     int did_one = 0;
01456     chainp elts;
01457 
01458     nice_printf (fp, "(");
01459     if (listp)
01460         for (elts = listp -> listp; elts; elts = elts -> nextp) {
01461             if (elts -> datap) {
01462                 if (did_one)
01463                     nice_printf (fp, ", ");
01464                 expr_out (fp, (expptr) elts -> datap);
01465                 did_one = 1;
01466             } /* if elts -> datap */
01467         } /* for elts */
01468     nice_printf (fp, ")");
01469 } /* output_list */
01470 
01471 
01472  void
01473 #ifdef KR_headers
01474 out_asgoto(outfile, expr)
01475         FILE *outfile;
01476         expptr expr;
01477 #else
01478 out_asgoto(FILE *outfile, expptr expr)
01479 #endif
01480 {
01481     chainp value;
01482     Namep namep;
01483     int k;
01484 
01485     if (expr == (expptr) NULL) {
01486         err ("out_asgoto:  NULL variable expr");
01487         return;
01488     } /* if expr */
01489 
01490     nice_printf (outfile, Ansi ? "switch (" : "switch ((int)"); /*)*/
01491     expr_out (outfile, expr);
01492     nice_printf (outfile, ") {\n");
01493     next_tab (outfile);
01494 
01495 /* The initial addrp value will be stored as a namep pointer */
01496 
01497     switch(expr->tag) {
01498         case TNAME:
01499                 /* local variable */
01500                 namep = &expr->nameblock;
01501                 break;
01502         case TEXPR:
01503                 if (expr->exprblock.opcode == OPWHATSIN
01504                  && expr->exprblock.leftp->tag == TNAME)
01505                         /* argument */
01506                         namep = &expr->exprblock.leftp->nameblock;
01507                 else
01508                         goto bad;
01509                 break;
01510         case TADDR:
01511                 if (expr->addrblock.uname_tag == UNAM_NAME) {
01512                         /* initialized local variable */
01513                         namep = expr->addrblock.user.name;
01514                         break;
01515                         }
01516         default:
01517  bad:
01518                 err("out_asgoto:  bad expr");
01519                 return;
01520         }
01521 
01522     for(k = 0, value = namep -> varxptr.assigned_values; value;
01523             value = value->nextp, k++) {
01524         nice_printf (outfile, "case %d: goto %s;\n", k,
01525                 user_label((long)value->datap));
01526     } /* for value */
01527     prev_tab (outfile);
01528 
01529     nice_printf (outfile, "}\n");
01530 } /* out_asgoto */
01531 
01532  void
01533 #ifdef KR_headers
01534 out_if(outfile, expr)
01535         FILE *outfile;
01536         expptr expr;
01537 #else
01538 out_if(FILE *outfile, expptr expr)
01539 #endif
01540 {
01541     nice_printf (outfile, "if (");
01542     expr_out (outfile, expr);
01543     nice_printf (outfile, ") {\n");
01544     next_tab (outfile);
01545 } /* out_if */
01546 
01547  static void
01548 #ifdef KR_headers
01549 output_rbrace(outfile, s)
01550         FILE *outfile;
01551         char *s;
01552 #else
01553 output_rbrace(FILE *outfile, char *s)
01554 #endif
01555 {
01556         extern int last_was_label;
01557         register char *fmt;
01558 
01559         if (last_was_label) {
01560                 last_was_label = 0;
01561                 fmt = ";%s";
01562                 }
01563         else
01564                 fmt = "%s";
01565         nice_printf(outfile, fmt, s);
01566         }
01567 
01568  void
01569 #ifdef KR_headers
01570 out_else(outfile)
01571         FILE *outfile;
01572 #else
01573 out_else(FILE *outfile)
01574 #endif
01575 {
01576     prev_tab (outfile);
01577     output_rbrace(outfile, "} else {\n");
01578     next_tab (outfile);
01579 } /* out_else */
01580 
01581  void
01582 #ifdef KR_headers
01583 elif_out(outfile, expr)
01584         FILE *outfile;
01585         expptr expr;
01586 #else
01587 elif_out(FILE *outfile, expptr expr)
01588 #endif
01589 {
01590     prev_tab (outfile);
01591     output_rbrace(outfile, "} else ");
01592     out_if (outfile, expr);
01593 } /* elif_out */
01594 
01595  void
01596 #ifdef KR_headers
01597 endif_out(outfile)
01598         FILE *outfile;
01599 #else
01600 endif_out(FILE *outfile)
01601 #endif
01602 {
01603     prev_tab (outfile);
01604     output_rbrace(outfile, "}\n");
01605 } /* endif_out */
01606 
01607  void
01608 #ifdef KR_headers
01609 end_else_out(outfile)
01610         FILE *outfile;
01611 #else
01612 end_else_out(FILE *outfile)
01613 #endif
01614 {
01615     prev_tab (outfile);
01616     output_rbrace(outfile, "}\n");
01617 } /* end_else_out */
01618 
01619 
01620 
01621  void
01622 #ifdef KR_headers
01623 compgoto_out(outfile, index, labels)
01624         FILE *outfile;
01625         expptr index;
01626         expptr labels;
01627 #else
01628 compgoto_out(FILE *outfile, expptr index, expptr labels)
01629 #endif
01630 {
01631     char *s1, *s2;
01632 
01633     if (index == ENULL)
01634         err ("compgoto_out:  null index for computed goto");
01635     else if (labels && labels -> tag != TLIST)
01636         erri ("compgoto_out:  expected label list, got tag '%d'",
01637                 labels -> tag);
01638     else {
01639         chainp elts;
01640         int i = 1;
01641 
01642         s2 = /*(*/ ") {\n"; /*}*/
01643         if (Ansi)
01644                 s1 = "switch ("; /*)*/
01645         else if (index->tag == TNAME || index->tag == TEXPR
01646                                 && index->exprblock.opcode == OPWHATSIN)
01647                 s1 = "switch ((int)"; /*)*/
01648         else {
01649                 s1 = "switch ((int)(";
01650                 s2 = ")) {\n"; /*}*/
01651                 }
01652         nice_printf(outfile, s1);
01653         expr_out (outfile, index);
01654         nice_printf (outfile, s2);
01655         next_tab (outfile);
01656 
01657         for (elts = labels -> listblock.listp; elts; elts = elts -> nextp, i++) {
01658             if (elts -> datap) {
01659                 if (ISICON(((expptr) (elts -> datap))))
01660                     nice_printf (outfile, "case %d:  goto %s;\n", i,
01661                         user_label(((expptr)(elts->datap))->constblock.Const.ci));
01662                 else
01663                     err ("compgoto_out:  bad label in label list");
01664             } /* if (elts -> datap) */
01665         } /* for elts */
01666         prev_tab (outfile);
01667         nice_printf (outfile, /*{*/ "}\n");
01668     } /* else */
01669 } /* compgoto_out */
01670 
01671 
01672  void
01673 #ifdef KR_headers
01674 out_for(outfile, init, test, inc)
01675         FILE *outfile;
01676         expptr init;
01677         expptr test;
01678         expptr inc;
01679 #else
01680 out_for(FILE *outfile, expptr init, expptr test, expptr inc)
01681 #endif
01682 {
01683     nice_printf (outfile, "for (");
01684     expr_out (outfile, init);
01685     nice_printf (outfile, "; ");
01686     expr_out (outfile, test);
01687     nice_printf (outfile, "; ");
01688     expr_out (outfile, inc);
01689     nice_printf (outfile, ") {\n");
01690     next_tab (outfile);
01691 } /* out_for */
01692 
01693 
01694  void
01695 #ifdef KR_headers
01696 out_end_for(outfile)
01697         FILE *outfile;
01698 #else
01699 out_end_for(FILE *outfile)
01700 #endif
01701 {
01702     prev_tab (outfile);
01703     nice_printf (outfile, "}\n");
01704 } /* out_end_for */