home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / rtt / rttout.c < prev    next >
C/C++ Source or Header  |  2002-01-18  |  120KB  |  3,827 lines
  1. #include "rtt.h"
  2.  
  3. #define NotId 0  /* declarator is not simple identifier */
  4. #define IsId  1  /* declarator is simple identifier */
  5.  
  6. #define OrdFunc -1   /* indicates ordinary C function - non-token value */
  7.  
  8. /*
  9.  * VArgAlwnc - allowance for the variable part of an argument list in the
  10.  *  most general version of an operation. If it is too small, storage must
  11.  *  be malloced. 3 was chosen because over 90 percent of all writes have
  12.  *  3 or fewer arguments. It is possible that 4 would be a better number,
  13.  *  but 5 is probably overkill.
  14.  */
  15. #define VArgAlwnc 3
  16.  
  17. /*
  18.  * Prototypes for static functions.
  19.  */
  20. static void cnv_fnc       (struct token *t, int typcd,
  21.                                struct node *src, struct node *dflt,
  22.                                struct node *dest, int indent);
  23. static void chk_conj      (struct node *n);
  24. static void chk_nl        (int indent);
  25. static void chk_rsltblk   (int indent);
  26. static void comp_def      (struct node *n);
  27. static int     does_call     (struct node *expr);
  28. static void failure       (int indent, int brace);
  29. static void interp_def    (struct node *n);
  30. static int     len_sel       (struct node *sel,
  31.                                struct parminfo *strt_prms,
  32.                                struct parminfo *end_prms, int indent);
  33. static void line_dir      (int nxt_line, char *new_fname);
  34. static int     only_proto    (struct node *n);
  35. static void parm_locs     (struct sym_entry *op_params);
  36. static void parm_tnd      (struct sym_entry *sym);
  37. static void prt_runerr    (struct token *t, struct node *num,
  38.                                struct node *val, int indent);
  39. static void prt_tok       (struct token *t, int indent);
  40. static void prt_var       (struct node *n, int indent);
  41. static int     real_def      (struct node *n);
  42. static int     retval_dcltor (struct node *dcltor, int indent);
  43. static void ret_value     (struct token *t, struct node *n,
  44.                                int indent);
  45. static void ret_1_arg     (struct token *t, struct node *args,
  46.                                int typcd, char *vwrd_asgn, char *arg_rep,
  47.                                int indent);
  48. static int     rt_walk       (struct node *n, int indent, int brace);
  49. static void spcl_start    (struct sym_entry *op_params);
  50. static int     tdef_or_extr  (struct node *n);
  51. static void tend_ary      (int n);
  52. static void tend_init     (void);
  53. static void tnd_var       (struct sym_entry *sym, char *strct_ptr, char *access, int indent);
  54. static void tok_line      (struct token *t, int indent);
  55. static void typ_asrt      (int typcd, struct node *desc,
  56.                                struct token *tok, int indent);
  57. static int     typ_case      (struct node *var, struct node *slct_lst,
  58.                                struct node *dflt,
  59.                                int (*walk)(struct node *n, int xindent,
  60.                                  int brace), int maybe_var, int indent);
  61. static void untend        (int indent);
  62.  
  63. extern char *progname;
  64.  
  65. int op_type = OrdFunc;  /* type of operation */
  66. char lc_letter;         /* f = function, o = operator, k = keyword */
  67. char uc_letter;         /* F = function, O = operator, K = keyword */
  68. char prfx1;             /* 1st char of unique prefix for operation */
  69. char prfx2;             /* 2nd char of unique prefix for operation */
  70. char *fname = "";       /* current source file name */
  71. int line = 0;           /* current source line number */
  72. int nxt_sbuf;           /* next string buffer index */
  73. int nxt_cbuf;           /* next cset buffer index */
  74. int abs_ret = SomeType; /* type from abstract return(s) */
  75.  
  76. int nl = 0;             /* flag indicating the a new-line should be output */
  77. static int no_nl = 0;   /* flag to suppress line directives */
  78.  
  79. static int ntend;       /* number of tended descriptor needed */
  80. static char *tendstrct; /* expression to access struct of tended descriptors */
  81. static char *rslt_loc;  /* expression to access result location */
  82. static int varargs = 0; /* flag: operation takes variable number of arguments */
  83.  
  84. static int no_ret_val;  /* function has return statement with no value */
  85. static struct node *fnc_head; /* header of function being "copied" to output */
  86.  
  87. /*
  88.  * chk_nl - if a new-line is required, output it and indent the next line.
  89.  */
  90. static void chk_nl(indent)
  91. int indent;
  92.    {
  93.    int col;
  94.  
  95.    if (nl)  {
  96.       /*
  97.        * new-line required.
  98.        */
  99.       putc('\n', out_file);
  100.       ++line;
  101.       for (col = 0; col < indent; ++col)
  102.          putc(' ', out_file);
  103.       nl = 0;
  104.       }
  105.    }
  106.  
  107. /*
  108.  * line_dir - Output a line directive.
  109.  */
  110. static void line_dir(nxt_line, new_fname)
  111. int nxt_line;
  112. char *new_fname;
  113.    {
  114.    char *s;
  115.  
  116.    /*
  117.     * Make sure line directives are desired in the output. Normally,
  118.     *  blank lines surround the directive for readability. However,`
  119.     *  a preceding blank line is suppressed at the beginning of the
  120.     *  output file. In addition, a blank line is suppressed after
  121.     *  the directive if it would force the line number on the directive
  122.     *  to be 0.
  123.     */
  124.    if (line_cntrl) {
  125.       fprintf(out_file, "\n");
  126.       if (line != 0)
  127.          fprintf(out_file, "\n");
  128.       if (nxt_line == 1)
  129.          fprintf(out_file, "#line %d \"", nxt_line);
  130.       else
  131.          fprintf(out_file, "#line %d \"", nxt_line - 1);
  132.       for (s = new_fname; *s != '\0'; ++s) {
  133.          if (*s == '"' || *s == '\\')
  134.             putc('\\', out_file);
  135.          putc(*s, out_file);
  136.          }
  137.       if (nxt_line == 1)
  138.          fprintf(out_file, "\"");
  139.       else
  140.          fprintf(out_file, "\"\n");
  141.       nl = 1;
  142.       --nxt_line;
  143.       }
  144.     else if ((nxt_line > line || fname != new_fname) && line != 0) {
  145.       /*
  146.        * Line directives are disabled, but we are in a situation where
  147.        *  one or two new-lines are desirable.
  148.        */
  149.       if (nxt_line > line + 1 || fname != new_fname)
  150.          fprintf(out_file, "\n");
  151.       nl = 1;
  152.       --nxt_line;
  153.       }
  154.    line = nxt_line;
  155.    fname = new_fname;
  156.    }
  157.  
  158. /*
  159.  * prt_str - print a string to the output file, possibly preceded by
  160.  *   a new-line and indenting.
  161.  */
  162. void prt_str(s, indent)
  163. char *s;
  164. int indent;
  165.    {
  166.    chk_nl(indent);
  167.    fprintf(out_file, "%s", s);
  168.    }
  169.  
  170. /*
  171.  * tok_line - determine if a line directive is needed to synchronize the
  172.  *  output file name and line number with an input token.
  173.  */
  174. static void tok_line(t, indent)
  175. struct token *t;
  176. int indent;
  177.    {
  178.    int nxt_line;
  179.  
  180.    /*
  181.     * Line directives may be suppressed at certain points during code
  182.     *  output. This is done either by rtt itself using the no_nl flag, or
  183.     *  for macros, by the preprocessor using a flag in the token.
  184.     */
  185.    if (no_nl)
  186.       return;
  187.    if (t->flag & LineChk) {
  188.       /*
  189.        * If blank lines can be used in place of a line directive and no
  190.        *  more than 3 are needed, use them. If the line number and file
  191.        *  name are correct, but we need a new-line, we must output a
  192.        *  line directive so the line number is reset after the "new-line".
  193.        */
  194.       nxt_line = t->line;
  195.       if (fname != t->fname  || line > nxt_line || line + 2 < nxt_line)
  196.          line_dir(nxt_line, t->fname);
  197.       else if (nl && line == nxt_line)
  198.          line_dir(nxt_line, t->fname);
  199.       else if (line != nxt_line) {
  200.          nl = 1;
  201.          --nxt_line;
  202.          while (line < nxt_line) { /* above condition limits # interactions */
  203.             putc('\n', out_file);
  204.             ++line;
  205.             }
  206.          }
  207.       }
  208.    chk_nl(indent);
  209.    }
  210.  
  211. /*
  212.  * prt_tok - print a token.
  213.  */
  214. static void prt_tok(t, indent)
  215. struct token *t;
  216. int indent;
  217.    {
  218.    char *s;
  219.  
  220.    tok_line(t, indent); /* synchronize file name and line number */
  221.  
  222.    /*
  223.     * Most tokens contain a string of their exact image. However, string
  224.     *  and character literals lack the surrounding quotes.
  225.     */
  226.    s = t->image;
  227.    switch (t->tok_id) {
  228.       case StrLit:
  229.          fprintf(out_file, "\"%s\"", s);
  230.          break;
  231.       case LStrLit:
  232.          fprintf(out_file, "L\"%s\"", s);
  233.          break;
  234.       case CharConst:
  235.          fprintf(out_file, "'%s'", s);
  236.          break;
  237.       case LCharConst:
  238.          fprintf(out_file, "L'%s'", s);
  239.          break;
  240.       default:
  241.          fprintf(out_file, "%s", s);
  242.       }
  243.    }
  244.  
  245. /*
  246.  * untend - output code to removed the tended descriptors in this
  247.  *  function from the global tended list.
  248.  */
  249. static void untend(indent)
  250. int indent;
  251.    {
  252.    ForceNl();
  253.    prt_str("tend = ", indent);
  254.    fprintf(out_file, "%s.previous;", tendstrct);
  255.    ForceNl();
  256.    /*
  257.     * For varargs operations, the tended structure might have been
  258.     *  malloced. If so, it must be freed.
  259.     */
  260.    if (varargs) {
  261.       prt_str("if (r_tendp != (struct tend_desc *)&r_tend)", indent);
  262.       ForceNl();
  263.       prt_str("free((pointer)r_tendp);", 2 * indent);
  264.       }
  265.    }
  266.  
  267. /*
  268.  * tnd_var - output an expression to accessed a tended variable.
  269.  */
  270. static void tnd_var(sym, strct_ptr, access, indent)
  271. struct sym_entry *sym;
  272. char *strct_ptr;
  273. char *access;
  274. int indent;
  275.    {
  276.    /*
  277.     * A variable that is a specific block pointer type must be cast
  278.     *  to that pointer type in such a way that it can be used as either
  279.     *  an lvalue or an rvalue:  *(struct b_??? **)&???.vword.bptr
  280.     */
  281.    if (strct_ptr != NULL) {
  282.       prt_str("(*(struct ", indent);
  283.       prt_str(strct_ptr, indent);
  284.       prt_str("**)&", indent);
  285.       }
  286.  
  287.    if (sym->id_type & ByRef) {
  288.       /*
  289.        * The tended variable is being accessed indirectly through
  290.        *  a pointer (that is, it is accessed as the argument to a body
  291.        *  function); dereference its identifier.
  292.        */
  293.       prt_str("(*", indent);
  294.       prt_str(sym->image, indent);
  295.       prt_str(")", indent);
  296.       }
  297.    else {
  298.       if (sym->t_indx >= 0) {
  299.          /*
  300.           * The variable is accessed directly as part of the tended structure.
  301.           */
  302.          prt_str(tendstrct, indent);
  303.          fprintf(out_file, ".d[%d]", sym->t_indx);
  304.          }
  305.       else {
  306.          /*
  307.           * This is a direct access to an operation parameter.
  308.           */
  309.          prt_str("r_args[", indent);
  310.          fprintf(out_file, "%d]", sym->u.param_info.param_num + 1);
  311.          }
  312.       }
  313.    prt_str(access, indent);  /* access the vword for tended pointers */
  314.    if (strct_ptr != NULL)
  315.       prt_str(")", indent);
  316.    }
  317.  
  318. /*
  319.  * prt_var - print a variable.
  320.  */
  321. static void prt_var(n, indent)
  322. struct node *n;
  323. int indent;
  324.    {
  325.    struct token *t;
  326.    struct sym_entry *sym;
  327.  
  328.    t = n->tok;
  329.    tok_line(t, indent); /* synchronize file name and line nuber */
  330.    sym = n->u[0].sym;
  331.    switch (sym->id_type & ~ByRef) {
  332.       case TndDesc:
  333.          /*
  334.           * Simple tended descriptor.
  335.           */
  336.          tnd_var(sym, NULL, "", indent);
  337.          break;
  338.       case TndStr:
  339.          /*
  340.           * Tended character pointer.
  341.           */
  342.          tnd_var(sym, NULL, ".vword.sptr", indent);
  343.          break;
  344.       case TndBlk:
  345.          /*
  346.           * Tended block pointer.
  347.           */
  348.          tnd_var(sym, sym->u.tnd_var.blk_name, ".vword.bptr",
  349.             indent);
  350.          break;
  351.       case RtParm:
  352.       case DrfPrm:
  353.          switch (sym->u.param_info.cur_loc) {
  354.             case PrmTend:
  355.                /*
  356.                 * Simple tended parameter.
  357.                 */
  358.                tnd_var(sym, NULL, "", indent);
  359.                break;
  360.             case PrmCStr:
  361.                /*
  362.                 * Parameter converted to a (tended) string.
  363.                 */
  364.                tnd_var(sym, NULL, ".vword.sptr", indent);
  365.                break;
  366.             case PrmInt:
  367.                /*
  368.                 * Parameter converted to a C integer.
  369.                 */
  370.                chk_nl(indent);
  371.                fprintf(out_file, "r_i%d", sym->u.param_info.param_num);
  372.                break;
  373.             case PrmDbl:
  374.                /*
  375.                 * Parameter converted to a C double.
  376.                 */
  377.                chk_nl(indent);
  378.                fprintf(out_file, "r_d%d", sym->u.param_info.param_num);
  379.                break;
  380.             default:
  381.                errt2(t, "Conflicting conversions for: ", t->image);
  382.             }
  383.          break;
  384.       case RtParm | VarPrm:
  385.       case DrfPrm | VarPrm:
  386.          /*
  387.           * Parameter representing variable part of argument list.
  388.           */
  389.          prt_str("(&", indent);
  390.          if (sym->t_indx >= 0)
  391.             fprintf(out_file, "%s.d[%d])", tendstrct, sym->t_indx);
  392.          else
  393.             fprintf(out_file, "r_args[%d])", sym->u.param_info.param_num + 1);
  394.          break;
  395.       case VArgLen:
  396.          /*
  397.           * Length of variable part of argument list.
  398.           */
  399.          prt_str("(r_nargs - ", indent);
  400.          fprintf(out_file, "%d)", params->u.param_info.param_num);
  401.          break;
  402.       case RsltLoc:
  403.          /*
  404.           * "result" the result location of the operation.
  405.           */
  406.          prt_str(rslt_loc, indent);
  407.          break;
  408.       case Label:
  409.          /*
  410.           * Statement label.
  411.           */
  412.          prt_str(sym->image, indent);
  413.          break;
  414.       case OtherDcl:
  415.          /*
  416.           * Some other type of variable: accessed by identifier. If this
  417.           *  is a body function, it may be passed by reference and need
  418.           *  a level of pointer dereferencing.
  419.           */
  420.          if (sym->id_type & ByRef)
  421.             prt_str("(*",indent);
  422.          prt_str(sym->image, indent);
  423.          if (sym->id_type & ByRef)
  424.             prt_str(")",indent);
  425.          break;
  426.       }
  427.    }
  428.  
  429. /*
  430.  * does_call - determine if an expression contains a function call by
  431.  *  walking its syntax tree.
  432.  */
  433. static int does_call(expr)
  434. struct node *expr;
  435.    {
  436.    int n_subs;
  437.    int i;
  438.  
  439.    if (expr == NULL)
  440.       return 0;
  441.    if (expr->nd_id == BinryNd && expr->tok->tok_id == ')')
  442.       return 1;      /* found a function call */
  443.  
  444.    switch (expr->nd_id) {
  445.       case ExactCnv: case PrimryNd: case SymNd:
  446.          n_subs = 0;
  447.          break;
  448.       case CompNd:
  449.          /*
  450.           * Check field 0 below, field 1 is not a subtree, check field 2 here.
  451.           */
  452.          n_subs = 1;
  453.          if (does_call(expr->u[2].child))
  454.              return 1;
  455.          break;
  456.       case IcnTypNd: case PstfxNd: case PreSpcNd: case PrefxNd:
  457.          n_subs = 1;
  458.          break;
  459.       case AbstrNd: case BinryNd: case CommaNd: case ConCatNd: case LstNd:
  460.       case StrDclNd:
  461.          n_subs = 2;
  462.          break;
  463.       case TrnryNd:
  464.          n_subs = 3;
  465.          break;
  466.       case QuadNd:
  467.          n_subs = 4;
  468.          break;
  469.       default:
  470.          fprintf(stdout, "rtt internal error: unknown node type\n");
  471.          exit(EXIT_FAILURE);
  472.          }
  473.  
  474.    for (i = 0; i < n_subs; ++i)
  475.       if (does_call(expr->u[i].child))
  476.           return 1;
  477.  
  478.    return 0;
  479.    }
  480.  
  481. /*
  482.  * prt_runerr - print code to implement runerr().
  483.  */
  484. static void prt_runerr(t, num, val, indent)
  485. struct token *t;
  486. struct node *num;
  487. struct node *val;
  488. int indent;
  489.    {
  490.    if (op_type == OrdFunc)
  491.       errt1(t, "'runerr' may not be used in an ordinary C function");
  492.  
  493.    tok_line(t, indent);  /* synchronize file name and line number */
  494.    prt_str("{", indent);
  495.    ForceNl();
  496.    prt_str("err_msg(", indent);
  497.    c_walk(num, indent, 0);                /* error number */
  498.    if (val == NULL)
  499.       prt_str(", NULL);", indent);        /* no offending value */
  500.    else {
  501.       prt_str(", &(", indent);
  502.       c_walk(val, indent, 0);             /* offending value */
  503.       prt_str("));", indent);
  504.       }
  505.    /*
  506.     * Handle error conversion. Indicate that operation may fail because
  507.     *  of error conversion and produce the necessary code.
  508.     */
  509.    cur_impl->ret_flag |= DoesEFail;
  510.    failure(indent, 1);
  511.    prt_str("}", indent);
  512.    ForceNl();
  513.    }
  514.  
  515. /*
  516.  * typ_name - convert a type code to a string that can be used to
  517.  *  output "T_" or "D_" type codes.
  518.  */
  519. char *typ_name(typcd, tok)
  520. int typcd;
  521. struct token *tok;
  522.    {
  523.    if (typcd == Empty_type)
  524.       errt1(tok, "it is meaningless to assert a type of empty_type");
  525.    else if (typcd == Any_value)
  526.       errt1(tok, "it is useless to assert a type of any_value");
  527.    else if (typcd < 0 || typcd == str_typ)
  528.       return NULL;
  529.    else
  530.       return icontypes[typcd].cap_id;
  531.    /*NOTREACHED*/
  532.    return 0;            /* avoid gcc warning */
  533.    }
  534.  
  535. /*
  536.  * Produce a C conditional expression to check a descriptor for a
  537.  *  particular type.
  538.  */
  539. static void typ_asrt(typcd, desc, tok, indent)
  540. int typcd;
  541. struct node *desc;
  542. struct token *tok;
  543. int indent;
  544.    {
  545.    tok_line(tok, indent);
  546.  
  547.    if (typcd == str_typ) {
  548.       /*
  549.        * Check dword for the absense of a "not qualifier" flag.
  550.        */
  551.       prt_str("(!((", indent);
  552.       c_walk(desc, indent, 0);
  553.       prt_str(").dword & F_Nqual))", indent);
  554.       }
  555.    else if (typcd == TypVar) {
  556.       /*
  557.        * Check dword for the presense of a "variable" flag.
  558.        */
  559.       prt_str("(((", indent);
  560.       c_walk(desc, indent, 0);
  561.       prt_str(").dword & D_Var) == D_Var)", indent);
  562.       }
  563.    else if (typcd == int_typ) {
  564.       /*
  565.        * If large integers are supported, an integer can be either
  566.        *  an ordinary integer or a large integer.
  567.        */
  568.       ForceNl();
  569.       prt_str("#ifdef LargeInts", 0);
  570.       ForceNl();
  571.       prt_str("(((", indent);
  572.       c_walk(desc, indent, 0);
  573.       prt_str(").dword == D_Integer) || ((", indent);
  574.       c_walk(desc, indent, 0);
  575.       prt_str(").dword == D_Lrgint))", indent);
  576.       ForceNl();
  577.       prt_str("#else\t\t\t\t\t/* LargeInts */", 0);
  578.       ForceNl();
  579.       prt_str("((", indent);
  580.       c_walk(desc, indent, 0);
  581.       prt_str(").dword == D_Integer)", indent);
  582.       ForceNl();
  583.       prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
  584.       ForceNl();
  585.       }
  586.    else {
  587.       /*
  588.        * Check dword for a specific type code.
  589.        */
  590.       prt_str("((", indent);
  591.       c_walk(desc, indent, 0);
  592.       prt_str(").dword == D_", indent);
  593.       prt_str(typ_name(typcd, tok), indent);
  594.       prt_str(")", indent);
  595.       }
  596.    }
  597.  
  598. /*
  599.  * retval_dcltor - convert the "declarator" part of function declaration
  600.  *  into a declarator for the variable "r_retval" of the same type
  601.  *  as the function result type, outputing the new declarator. This
  602.  *  variable is a temporary location to store the result of the argument
  603.  *  to a C return statement.
  604.  */
  605. static int retval_dcltor(dcltor, indent)
  606. struct node *dcltor;
  607. int indent;
  608.    {
  609.    int flag;
  610.  
  611.    switch (dcltor->nd_id) {
  612.       case ConCatNd:
  613.          c_walk(dcltor->u[0].child, indent, 0);
  614.          retval_dcltor(dcltor->u[1].child, indent);
  615.          return NotId;
  616.       case PrimryNd:
  617.          /*
  618.           * We have reached the function name. Replace it with "r_retval"
  619.           *  and tell caller we have found it.
  620.           */
  621.          prt_str("r_retval", indent);
  622.          return IsId;
  623.       case PrefxNd:
  624.          /*
  625.           * (...)
  626.           */
  627.          prt_str("(", indent);
  628.          flag = retval_dcltor(dcltor->u[0].child, indent);
  629.          prt_str(")", indent);
  630.          return flag;
  631.       case BinryNd:
  632.          if (dcltor->tok->tok_id == ')') {
  633.             /*
  634.              * Function declaration. If this is the declarator that actually
  635.              *  defines the function being processed, discard the paramater
  636.              *  list including parentheses.
  637.              */
  638.             if (retval_dcltor(dcltor->u[0].child, indent) == NotId) {
  639.                prt_str("(", indent);
  640.                c_walk(dcltor->u[1].child, indent, 0);
  641.                prt_str(")", indent);
  642.                }
  643.             }
  644.          else {
  645.             /*
  646.              * Array.
  647.              */
  648.             retval_dcltor(dcltor->u[0].child, indent);
  649.             prt_str("[", indent);
  650.             c_walk(dcltor->u[1].child, indent, 0);
  651.             prt_str("]", indent);
  652.             }
  653.          return NotId;
  654.       }
  655.    err1("rtt internal error detected in function retval_dcltor()");
  656.    /*NOTREACHED*/
  657.    return 0;            /* avoid gcc warning */
  658.    }
  659.  
  660. /*
  661.  * cnv_fnc - produce code to handle RTT cnv: and def: constructs.
  662.  */
  663. static void cnv_fnc(t, typcd, src, dflt, dest, indent)
  664. struct token *t;
  665. int typcd;
  666. struct node *src;
  667. struct node *dflt;
  668. struct node *dest;
  669. int indent;
  670.    {
  671.    int dflt_to_ptr;
  672.    int loc;
  673.    int is_cstr;
  674.  
  675.    if (src->nd_id == SymNd && src->u[0].sym->id_type & VarPrm)
  676.       errt1(t, "converting entire variable part of param list not supported");
  677.  
  678.    tok_line(t, indent); /* synchronize file name and line number */
  679.  
  680.    /*
  681.     * Initial assumptions: result of conversion is a tended location
  682.     *   and is not tended C string.
  683.     */
  684.    loc = PrmTend;
  685.    is_cstr = 0;
  686.  
  687.   /*
  688.    * Print the name of the conversion function. If it is a conversion
  689.    *  with a default value, determine (through dflt_to_prt) if the
  690.    *  default value is passed by-reference instead of by-value.
  691.    */
  692.    prt_str(cnv_name(typcd, dflt, &dflt_to_ptr), indent);
  693.    prt_str("(", indent);
  694.  
  695.    /*
  696.     * Determine what parameter scope, if any, is established by this
  697.     *  conversion. If the conversion needs a buffer, allocate it and
  698.     *  put it in the argument list.
  699.     */
  700.    switch (typcd) {
  701.       case TypCInt:
  702.       case TypECInt:
  703.          loc = PrmInt;
  704.          break;
  705.       case TypCDbl:
  706.          loc = PrmDbl;
  707.          break;
  708.       case TypCStr:
  709.          is_cstr = 1;
  710.          break;
  711.       case TypTStr:
  712.          fprintf(out_file, "r_sbuf[%d], ", nxt_sbuf++);
  713.          break;
  714.       case TypTCset:
  715.          fprintf(out_file, "&r_cbuf[%d], ", nxt_cbuf++);
  716.          break;
  717.       }
  718.  
  719.    /*
  720.     * Output source of conversion.
  721.     */
  722.    prt_str("&(", indent);
  723.    c_walk(src, indent, 0);
  724.    prt_str("), ", indent);
  725.  
  726.    /*
  727.     * If there is a default value, output it, taking its address if necessary.
  728.     */
  729.    if (dflt != NULL) {
  730.       if (dflt_to_ptr)
  731.          prt_str("&(", indent);
  732.       c_walk(dflt, indent, 0);
  733.       if (dflt_to_ptr)
  734.          prt_str("), ", indent);
  735.       else
  736.          prt_str(", ", indent);
  737.       }
  738.  
  739.    /*
  740.     * Output the destination of the conversion. This may or may not be
  741.     *  the same as the source.
  742.     */
  743.    prt_str("&(", indent);
  744.    if (dest == NULL) {
  745.       /*
  746.        * Convert "in place", changing the location of a paramater if needed.
  747.        */
  748.       if (src->nd_id == SymNd && src->u[0].sym->id_type & (RtParm | DrfPrm)) {
  749.          if (src->u[0].sym->id_type & DrfPrm)
  750.             src->u[0].sym->u.param_info.cur_loc = loc;
  751.          else
  752.             errt1(t, "only dereferenced parameter can be converted in-place");
  753.          }
  754.       else if ((loc != PrmTend) | is_cstr)
  755.          errt1(t,
  756.             "only ordinary parameters can be converted in-place to C values");
  757.       c_walk(src, indent, 0);
  758.       if (is_cstr) {
  759.          /*
  760.           * The parameter must be accessed as a tended C string, but only
  761.           *  now, after the "destination" code has been produced as a full
  762.           *  descriptor.
  763.           */
  764.          src->u[0].sym->u.param_info.cur_loc = PrmCStr;
  765.          }
  766.       }
  767.    else {
  768.       /*
  769.        * Convert to an explicit destination.
  770.        */
  771.       if (is_cstr) {
  772.          /*
  773.           * Access the destination as a full descriptor even though it
  774.           *  must be declared as a tended C string.
  775.           */
  776.          if (dest->nd_id != SymNd || (dest->u[0].sym->id_type != TndStr &&
  777.                dest->u[0].sym->id_type != TndDesc))
  778.             errt1(t,
  779.              "dest. of C_string conv. must be tended descriptor or char *");
  780.          tnd_var(dest->u[0].sym, NULL, "", indent);
  781.          }
  782.       else
  783.          c_walk(dest, indent, 0);
  784.       }
  785.    prt_str("))", indent);
  786.    }
  787.  
  788. /*
  789.  * cnv_name - produce name of conversion routine. Warning, name is
  790.  *   constructed in a static buffer. Also determine if a default
  791.  *   must be passed "by reference".
  792.  */
  793. char *cnv_name(typcd, dflt, dflt_to_ptr)
  794. int typcd;
  795. struct node *dflt;
  796. int *dflt_to_ptr;
  797.    {
  798.    static char buf[15];
  799.    int by_ref;
  800.  
  801.    /*
  802.     * The names of simple conversion and defaulting conversions have
  803.     *  the same suffixes, but different prefixes.
  804.     */
  805.    if (dflt == NULL)
  806.       strcpy(buf , "cnv_");
  807.    else
  808.        strcpy(buf, "def_");
  809.  
  810.    by_ref = 0;
  811.    switch (typcd) {
  812.       case TypCInt:
  813.          strcat(buf, "c_int");
  814.          break;
  815.       case TypCDbl:
  816.          strcat(buf, "c_dbl");
  817.          break;
  818.       case TypCStr:
  819.          strcat(buf, "c_str");
  820.          break;
  821.       case TypTStr:
  822.          strcat(buf, "tstr");
  823.          by_ref = 1;
  824.          break;
  825.       case TypTCset:
  826.          strcat(buf, "tcset");
  827.          by_ref = 1;
  828.          break;
  829.       case TypEInt:
  830.          strcat(buf, "eint");
  831.          break;
  832.       case TypECInt:
  833.          strcat(buf, "ec_int");
  834.          break;
  835.       default:
  836.          if (typcd == cset_typ) {
  837.             strcat(buf, "cset");
  838.             by_ref = 1;
  839.             }
  840.          else if (typcd == int_typ)
  841.             strcat(buf, "int");
  842.          else if (typcd == real_typ)
  843.             strcat(buf, "real");
  844.          else if (typcd == str_typ) {
  845.             strcat(buf, "str");
  846.             by_ref = 1;
  847.             }
  848.       }
  849.    if (dflt_to_ptr != NULL)
  850.       *dflt_to_ptr = by_ref;
  851.    return buf;
  852.    }
  853.  
  854. /*
  855.  * ret_value - produce code to set the result location of an operation
  856.  *  using the expression on a return or suspend.
  857.  */
  858. static void ret_value(t, n, indent)
  859. struct token *t;
  860. struct node *n;
  861. int indent;
  862.    {
  863.    struct node *caller;
  864.    struct node *args;
  865.    int typcd;
  866.  
  867.    if (n == NULL)
  868.       errt1(t, "there is no default return value for run-time operations");
  869.  
  870.    if (n->nd_id == SymNd && n->u[0].sym->id_type == RsltLoc) {
  871.       /*
  872.        * return/suspend result;
  873.        *
  874.        *   result already where it needs to be.
  875.        */
  876.       return;
  877.       }
  878.  
  879.    if (n->nd_id == PrefxNd && n->tok != NULL) {
  880.       switch (n->tok->tok_id) {
  881.          case C_Integer:
  882.             /*
  883.              * return/suspend C_integer <expr>;
  884.              */
  885.             prt_str(rslt_loc, indent);
  886.             prt_str(".vword.integr = ", indent);
  887.             c_walk(n->u[0].child, indent + IndentInc, 0);
  888.             prt_str(";", indent);
  889.             ForceNl();
  890.             prt_str(rslt_loc, indent);
  891.             prt_str(".dword = D_Integer;", indent);
  892.             chkabsret(t, int_typ);  /* compare return with abstract return */
  893.             return;
  894.          case C_Double:
  895.             /*
  896.              * return/suspend C_double <expr>;
  897.              */
  898.             prt_str(rslt_loc, indent);
  899.             prt_str(".vword.bptr = (union block *)alcreal(", indent);
  900.             c_walk(n->u[0].child, indent + IndentInc, 0);
  901.             prt_str(");", indent + IndentInc);
  902.             ForceNl();
  903.             prt_str(rslt_loc, indent);
  904.             prt_str(".dword = D_Real;", indent);
  905.             /*
  906.              * The allocation of the real block may fail.
  907.              */
  908.             chk_rsltblk(indent);
  909.             chkabsret(t, real_typ); /* compare return with abstract return */
  910.             return;
  911.          case C_String:
  912.             /*
  913.              * return/suspend C_string <expr>;
  914.              */
  915.             prt_str(rslt_loc, indent);
  916.             prt_str(".vword.sptr = ", indent);
  917.             c_walk(n->u[0].child, indent + IndentInc, 0);
  918.             prt_str(";", indent);
  919.             ForceNl();
  920.             prt_str(rslt_loc, indent);
  921.             prt_str(".dword = strlen(", indent);
  922.             prt_str(rslt_loc, indent);
  923.             prt_str(".vword.sptr);", indent);
  924.             chkabsret(t, str_typ); /* compare return with abstract return */
  925.             return;
  926.          }
  927.       }
  928.    else if (n->nd_id == BinryNd && n->tok->tok_id == ')') {
  929.       /*
  930.        * Return value is in form of function call, see if it is really
  931.        *  a descriptor constructor.
  932.        */
  933.       caller = n->u[0].child;
  934.       args = n->u[1].child;
  935.       if (caller->nd_id == SymNd) {
  936.          switch (caller->tok->tok_id) {
  937.             case IconType:
  938.                typcd = caller->u[0].sym->u.typ_indx;
  939.                switch (icontypes[typcd].rtl_ret) {
  940.                   case TRetBlkP:
  941.                      /*
  942.                       * return/suspend <type>(<block-pntr>);
  943.                       */
  944.                      ret_1_arg(t, args, typcd, ".vword.bptr = (union block *)",
  945.                         "(bp)", indent);
  946.                      break;
  947.                   case TRetDescP:
  948.                      /*
  949.                       * return/suspend <type>(<desc-pntr>);
  950.                       */
  951.                      ret_1_arg(t, args, typcd, ".vword.descptr = (dptr)",
  952.                         "(dp)", indent);
  953.                      break;
  954.                   case TRetCharP:
  955.                      /*
  956.                       * return/suspend <type>(<char-pntr>);
  957.                       */
  958.                      ret_1_arg(t, args, typcd, ".vword.sptr = (char *)",
  959.                         "(s)", indent);
  960.                      break;
  961.                   case TRetCInt:
  962.                      /*
  963.                       * return/suspend <type>(<integer>);
  964.                       */
  965.                      ret_1_arg(t, args, typcd, ".vword.integr = (word)",
  966.                         "(i)", indent);
  967.                      break;
  968.                   case TRetSpcl:
  969.                      if (typcd == str_typ) {
  970.                         /*
  971.                          * return/suspend string(<len>, <char-pntr>);
  972.                          */
  973.                         if (args == NULL || args->nd_id != CommaNd ||
  974.                            args->u[0].child->nd_id == CommaNd)
  975.                            errt1(t, "wrong no. of args for string(n, s)");
  976.                         prt_str(rslt_loc, indent);
  977.                         prt_str(".vword.sptr = ", indent);
  978.                         c_walk(args->u[1].child, indent + IndentInc, 0);
  979.                         prt_str(";", indent);
  980.                         ForceNl();
  981.                         prt_str(rslt_loc, indent);
  982.                         prt_str(".dword = ", indent);
  983.                         c_walk(args->u[0].child, indent + IndentInc, 0);
  984.                         prt_str(";", indent);
  985.                         }
  986.                      else if (typcd == stv_typ) {
  987.                         /*
  988.                          * return/suspend tvsubs(<desc-pntr>, <start>, <len>);
  989.                          */
  990.                         if (args == NULL || args->nd_id != CommaNd ||
  991.                            args->u[0].child->nd_id != CommaNd ||
  992.                            args->u[0].child->u[0].child->nd_id == CommaNd)
  993.                            errt1(t, "wrong no. of args for tvsubs(dp, i, j)");
  994.                         no_nl = 1;
  995.                         prt_str("SubStr(&", indent);
  996.                         prt_str(rslt_loc, indent);
  997.                         prt_str(", ", indent);
  998.                         c_walk(args->u[0].child->u[0].child, indent + IndentInc,
  999.                            0);
  1000.                         prt_str(", ", indent + IndentInc);
  1001.                         c_walk(args->u[1].child, indent + IndentInc, 0);
  1002.                         prt_str(", ", indent + IndentInc);
  1003.                         c_walk(args->u[0].child->u[1].child, indent + IndentInc,
  1004.                           0);
  1005.                         prt_str(");", indent + IndentInc);
  1006.                         no_nl = 0;
  1007.                         /*
  1008.                          * The allocation of the substring trapped variable
  1009.                          *   block may fail.
  1010.                          */
  1011.                         chk_rsltblk(indent);
  1012.                         chkabsret(t, stv_typ); /* compare to abstract return */
  1013.                         }
  1014.                      break;
  1015.                   }
  1016.                chkabsret(t, typcd); /* compare return with abstract return */
  1017.                return;
  1018.             case Named_var:
  1019.                /*
  1020.                 * return/suspend named_var(<desc-pntr>);
  1021.                 */
  1022.                if (args == NULL || args->nd_id == CommaNd)
  1023.                   errt1(t, "wrong no. of args for named_var(dp)");
  1024.                prt_str(rslt_loc, indent);
  1025.                prt_str(".vword.descptr = ", indent);
  1026.                c_walk(args, indent + IndentInc, 0);
  1027.                prt_str(";", indent);
  1028.                ForceNl();
  1029.                prt_str(rslt_loc, indent);
  1030.                prt_str(".dword = D_Var;", indent);
  1031.                chkabsret(t, TypVar); /* compare return with abstract return */
  1032.                return;
  1033.             case Struct_var:
  1034.                /*
  1035.                 * return/suspend struct_var(<desc-pntr>, <block_pntr>);
  1036.                 */
  1037.                if (args == NULL || args->nd_id != CommaNd ||
  1038.                   args->u[0].child->nd_id == CommaNd)
  1039.                   errt1(t, "wrong no. of args for struct_var(dp, bp)");
  1040.                prt_str(rslt_loc, indent);
  1041.                prt_str(".vword.descptr = (dptr)", indent);
  1042.                c_walk(args->u[1].child, indent + IndentInc, 0);
  1043.                prt_str(";", indent);
  1044.                ForceNl();
  1045.                prt_str(rslt_loc, indent);
  1046.                prt_str(".dword = D_Var + ((word *)", indent);
  1047.                c_walk(args->u[0].child, indent + IndentInc, 0);
  1048.                prt_str(" - (word *)", indent+IndentInc);
  1049.                prt_str(rslt_loc, indent);
  1050.                prt_str(".vword.descptr);", indent+IndentInc);
  1051.                ForceNl();
  1052.                chkabsret(t, TypVar); /* compare return with abstract return */
  1053.                return;
  1054.             }
  1055.          }
  1056.       }
  1057.  
  1058.    /*
  1059.     * If it is not one of the special returns, it is just a return of
  1060.     *  a descriptor.
  1061.     */
  1062.    prt_str(rslt_loc, indent);
  1063.    prt_str(" = ", indent);
  1064.    c_walk(n, indent + IndentInc, 0);
  1065.    prt_str(";", indent);
  1066.    chkabsret(t, SomeType); /* check for preceding abstract return */
  1067.    }
  1068.  
  1069. /*
  1070.  * ret_1_arg - produce code for a special return/suspend with one argument.
  1071.  */
  1072. static void ret_1_arg(t, args, typcd, vwrd_asgn, arg_rep, indent)
  1073. struct token *t;
  1074. struct node *args;
  1075. int typcd;
  1076. char *vwrd_asgn;
  1077. char *arg_rep;
  1078. int indent;
  1079.    {
  1080.    if (args == NULL || args->nd_id == CommaNd)
  1081.       errt3(t, "wrong no. of args for", icontypes[typcd].id, arg_rep);
  1082.  
  1083.    /*
  1084.     * Assignment to vword of result descriptor.
  1085.     */
  1086.    prt_str(rslt_loc, indent);
  1087.    prt_str(vwrd_asgn, indent);
  1088.    c_walk(args, indent + IndentInc, 0);
  1089.    prt_str(";", indent);
  1090.    ForceNl();
  1091.  
  1092.    /*
  1093.     * Assignment to dword of result descriptor.
  1094.     */
  1095.    prt_str(rslt_loc, indent);
  1096.    prt_str(".dword = D_", indent);
  1097.    prt_str(icontypes[typcd].cap_id, indent);
  1098.    prt_str(";", indent);
  1099.    }
  1100.  
  1101. /*
  1102.  * chk_rsltblk - the result value contains an allocated block, make sure
  1103.  *    the allocation succeeded.
  1104.  */
  1105. static void chk_rsltblk(indent)
  1106. int indent;
  1107.    {
  1108.    ForceNl();
  1109.    prt_str("if (", indent);
  1110.    prt_str(rslt_loc, indent);
  1111.    prt_str(".vword.bptr == NULL) {", indent);
  1112.    ForceNl();
  1113.    prt_str("err_msg(307, NULL);", indent + IndentInc);
  1114.    ForceNl();
  1115.    /*
  1116.     * Handle error conversion. Indicate that operation may fail because
  1117.     *  of error conversion and produce the necessary code.
  1118.     */
  1119.    cur_impl->ret_flag |= DoesEFail;
  1120.    failure(indent + IndentInc, 1);
  1121.    prt_str("}", indent + IndentInc);
  1122.    ForceNl();
  1123.    }
  1124.  
  1125. /*
  1126.  * failure - produce code for fail or efail.
  1127.  */
  1128. static void failure(indent, brace)
  1129. int indent;
  1130. int brace;
  1131.    {
  1132.    /*
  1133.     * If there are tended variables, they must be removed from the tended
  1134.     *  list. The C function may or may not return an explicit signal.
  1135.     */
  1136.    ForceNl();
  1137.    if (ntend != 0) {
  1138.       if (!brace)
  1139.          prt_str("{", indent);
  1140.       untend(indent);
  1141.       ForceNl();
  1142.       if (fnc_ret == RetSig)
  1143.          prt_str("return A_Resume;", indent);
  1144.       else
  1145.          prt_str("return;", indent);
  1146.       if (!brace) {
  1147.          ForceNl();
  1148.          prt_str("}", indent);
  1149.          }
  1150.       }
  1151.    else
  1152.       if (fnc_ret == RetSig)
  1153.          prt_str("return A_Resume;", indent);
  1154.       else
  1155.          prt_str("return;", indent);
  1156.    ForceNl();
  1157.    }
  1158.  
  1159. /*
  1160.  * c_walk - walk the syntax tree for extended C code and output the
  1161.  *  corresponding ordinary C. Return and indication of whether execution
  1162.  *  falls through the code.
  1163.  */
  1164. int c_walk(n, indent, brace)
  1165. struct node *n;
  1166. int indent;
  1167. int brace;
  1168.    {
  1169.    struct token *t;
  1170.    struct node *n1;
  1171.    struct sym_entry *sym;
  1172.    int fall_thru;
  1173.    int save_break;
  1174.    static int does_break = 0;
  1175.    static int may_brnchto;  /* may reach end of code by branching into middle */
  1176.  
  1177.    if (n == NULL)
  1178.       return 1;
  1179.  
  1180.    t =  n->tok;
  1181.  
  1182.    switch (n->nd_id) {
  1183.       case PrimryNd:
  1184.          switch (t->tok_id) {
  1185.             case Fail:
  1186.                if (op_type == OrdFunc)
  1187.                   errt1(t, "'fail' may not be used in an ordinary C function");
  1188.                cur_impl->ret_flag |= DoesFail;
  1189.                failure(indent, brace);
  1190.            chkabsret(t, SomeType);  /* check preceding abstract return */
  1191.            return 0;
  1192.         case Errorfail:
  1193.            if (op_type == OrdFunc)
  1194.           errt1(t,
  1195.               "'errorfail' may not be used in an ordinary C function");
  1196.            cur_impl->ret_flag |= DoesEFail;
  1197.            failure(indent, brace);
  1198.            return 0;
  1199.             case Break:
  1200.            prt_tok(t, indent);
  1201.            prt_str(";", indent);
  1202.                does_break = 1;
  1203.                return 0;
  1204.         default:
  1205.                /*
  1206.                 * Other "primary" expressions are just their token image,
  1207.                 *  possibly followed by a semicolon.
  1208.                 */
  1209.            prt_tok(t, indent);
  1210.            if (t->tok_id == Continue)
  1211.           prt_str(";", indent);
  1212.                return 1;
  1213.         }
  1214.       case PrefxNd:
  1215.      switch (t->tok_id) {
  1216.         case Sizeof:
  1217.            prt_tok(t, indent);                /* sizeof */
  1218.            prt_str("(", indent);
  1219.            c_walk(n->u[0].child, indent, 0);
  1220.            prt_str(")", indent);
  1221.            return 1;
  1222.         case '{':
  1223.                /*
  1224.                 * Initializer list.
  1225.                 */
  1226.            prt_tok(t, indent + IndentInc);     /* { */
  1227.            c_walk(n->u[0].child, indent + IndentInc, 0);
  1228.            prt_str("}", indent + IndentInc);
  1229.            return 1;
  1230.         case Default:
  1231.            prt_tok(t, indent - IndentInc);     /* default (un-indented) */
  1232.            prt_str(": ", indent - IndentInc);
  1233.            fall_thru = c_walk(n->u[0].child, indent, 0);
  1234.                may_brnchto = 1;
  1235.                return fall_thru;
  1236.         case Goto:
  1237.            prt_tok(t, indent);                 /* goto */
  1238.            prt_str(" ", indent);
  1239.            c_walk(n->u[0].child, indent, 0);
  1240.            prt_str(";", indent);
  1241.            return 0;
  1242.         case Return:
  1243.            if (n->u[0].child != NULL)
  1244.           no_ret_val = 0;  /* note that return statement has no value */
  1245.  
  1246.            if (op_type == OrdFunc || fnc_ret == RetInt ||
  1247.           fnc_ret == RetDbl) {
  1248.           /*
  1249.            * ordinary C return: ignore C_integer, C_double, and
  1250.            *  C_string qualifiers on return expression (the first
  1251.            *  two may legally occur when fnc_ret is RetInt or RetDbl).
  1252.            */
  1253.           n1 = n->u[0].child;
  1254.           if (n1 != NULL && n1->nd_id == PrefxNd && n1->tok != NULL) {
  1255.              switch (n1->tok->tok_id) {
  1256.             case C_Integer:
  1257.             case C_Double:
  1258.             case C_String:
  1259.                n1 = n1->u[0].child;
  1260.             }
  1261.              }
  1262.           if (ntend != 0) {
  1263.                      /*
  1264.                       * There are tended variables that must be removed from
  1265.                       *  the tended list.
  1266.                       */
  1267.              if (!brace)
  1268.             prt_str("{", indent);
  1269.              if (does_call(n1)) {
  1270.             /*
  1271.              * The return expression contains a function call;
  1272.                          *  the variables must remain tended while it is
  1273.                          *  computed, so compute it into a temporary variable
  1274.                          *  named r_retval.Output a declaration for r_retval;
  1275.                          *  its type must match the return type of the C
  1276.                          *  function.
  1277.                          */
  1278.             ForceNl();
  1279.             prt_str("register ", indent);
  1280.             if (op_type == OrdFunc) {
  1281.                no_nl = 1;
  1282.                just_type(fnc_head->u[0].child, indent, 0);
  1283.                prt_str(" ", indent);
  1284.                retval_dcltor(fnc_head->u[1].child, indent);
  1285.                prt_str(";", indent);
  1286.                no_nl = 0;
  1287.                }
  1288.             else if (fnc_ret == RetInt)
  1289.                prt_str("C_integer r_retval;", indent);
  1290.             else    /* fnc_ret == RetDbl */
  1291.                prt_str("double r_retval;", indent);
  1292.             ForceNl();
  1293.  
  1294.                         /*
  1295.                          * Output code to compute the return value, untend
  1296.                          *  the variable, then return the value.
  1297.                          */
  1298.             prt_str("r_retval = ", indent);
  1299.             c_walk(n1, indent + IndentInc, 0);
  1300.             prt_str(";", indent);
  1301.             untend(indent);
  1302.             ForceNl();
  1303.             prt_str("return r_retval;", indent);
  1304.             }
  1305.              else {
  1306.                         /*
  1307.                          * It is safe to untend the variables and return
  1308.                          *  the result value directly with a return
  1309.                          *  statement.
  1310.                          */
  1311.             untend(indent);
  1312.             ForceNl();
  1313.             prt_tok(t, indent);    /* return */
  1314.             prt_str(" ", indent);
  1315.             c_walk(n1, indent, 0);
  1316.             prt_str(";", indent);
  1317.             }
  1318.              if (!brace) {
  1319.             ForceNl();
  1320.             prt_str("}", indent);
  1321.             }
  1322.              ForceNl();
  1323.              }
  1324.           else {
  1325.                      /*
  1326.                       * There are no tended variable, just output the
  1327.                       *  return expression.
  1328.                       */
  1329.              prt_tok(t, indent);     /* return */
  1330.              prt_str(" ", indent);
  1331.              c_walk(n1, indent, 0);
  1332.              prt_str(";", indent);
  1333.              }
  1334.  
  1335.                   /*
  1336.                    * If this is a body function, check the return against
  1337.                    *  preceding abstract returns.
  1338.                    */
  1339.           if (fnc_ret == RetInt)
  1340.              chkabsret(n->tok, int_typ);
  1341.                   else if (fnc_ret == RetDbl)
  1342.                      chkabsret(n->tok, real_typ);
  1343.                   }
  1344.                else {
  1345.                   /*
  1346.                    * Return from Icon operation. Indicate that the operation
  1347.                    *  returns, compute the value into the result location,
  1348.                    *  untend variables if necessary, and return a signal
  1349.                    *  if the function requires one.
  1350.                    */
  1351.                   cur_impl->ret_flag |= DoesRet;
  1352.                   ForceNl();
  1353.                   if (!brace) {
  1354.                      prt_str("{", indent);
  1355.                      ForceNl();
  1356.                      }
  1357.                   ret_value(t, n->u[0].child, indent);
  1358.                   if (ntend != 0)
  1359.                      untend(indent);
  1360.                   ForceNl();
  1361.                   if (fnc_ret == RetSig)
  1362.                      prt_str("return A_Continue;", indent);
  1363.                   else if (fnc_ret == RetNoVal)
  1364.                      prt_str("return;", indent);
  1365.                   ForceNl();
  1366.                   if (!brace) {
  1367.                      prt_str("}", indent);
  1368.                      ForceNl();
  1369.                      }
  1370.                   }
  1371.                return 0;
  1372.             case Suspend:
  1373.                if (op_type == OrdFunc)
  1374.                   errt1(t, "'suspend' may not be used in an ordinary C function"
  1375.                      );
  1376.                cur_impl->ret_flag |= DoesSusp; /* note suspension */
  1377.                ForceNl();
  1378.                if (!brace) {
  1379.                   prt_str("{", indent);
  1380.                   ForceNl();
  1381.                   }
  1382.                prt_str("register int signal;", indent + IndentInc);
  1383.                ForceNl();
  1384.                ret_value(t, n->u[0].child, indent);
  1385.                ForceNl();
  1386.                /*
  1387.                 * The operator suspends by calling the success continuation
  1388.                 *  if there is one or just returns if there is none. For
  1389.                 *  the interpreter, interp() is the success continuation.
  1390.                 *  A non-A_Resume signal from the success continuation must
  1391.                 *  returned to the caller. If there are tended variables
  1392.                 *  they must be removed from the tended list before a signal
  1393.                 *  is returned.
  1394.                 */
  1395.                if (iconx_flg) {
  1396. #ifdef EventMon
  1397.           switch (op_type) {
  1398.           case TokFunction:
  1399.              prt_str(
  1400.                "if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {",
  1401.                  indent);
  1402.              break;
  1403.           case Operator:
  1404.           case Keyword:
  1405.              prt_str(
  1406.                "if ((signal = interp(G_Osusp, r_args)) != A_Resume) {",
  1407.                  indent);
  1408.              break;
  1409.           default:
  1410.              prt_str(
  1411.                "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
  1412.                  indent);
  1413.           }
  1414. #else                    /* EventMon */
  1415.           prt_str(
  1416.             "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
  1417.               indent);
  1418. #endif                    /* EventMon */
  1419.           }
  1420.                else {
  1421.                   prt_str("if (r_s_cont == (continuation)NULL) {", indent);
  1422.                   if (ntend != 0)
  1423.                      untend(indent + IndentInc);
  1424.                   ForceNl();
  1425.                   prt_str("return A_Continue;", indent + IndentInc);
  1426.                   ForceNl();
  1427.                   prt_str("}", indent + IndentInc);
  1428.                   ForceNl();
  1429.                   prt_str("else if ((signal = (*r_s_cont)()) != A_Resume) {",
  1430.                      indent);
  1431.                   }
  1432.                ForceNl();
  1433.                if (ntend != 0)
  1434.                   untend(indent + IndentInc);
  1435.                ForceNl();
  1436.                prt_str("return signal;", indent + IndentInc);
  1437.                ForceNl();
  1438.                prt_str("}", indent + IndentInc);
  1439.                if (!brace) {
  1440.                   prt_str("}", indent);
  1441.                   ForceNl();
  1442.                   }
  1443.                return 1;
  1444.             case '(':
  1445.                /*
  1446.                 * Parenthesized expression.
  1447.                 */
  1448.                prt_tok(t, indent);     /* ( */
  1449.                fall_thru = c_walk(n->u[0].child, indent, 0);
  1450.                prt_str(")", indent);
  1451.                return fall_thru;
  1452.             default:
  1453.                /*
  1454.                 * All other prefix expressions are printed as the token
  1455.                 *  image of the operation followed by the operand.
  1456.                 */
  1457.                prt_tok(t, indent);
  1458.                c_walk(n->u[0].child, indent, 0);
  1459.                return 1;
  1460.             }
  1461.       case PstfxNd:
  1462.          /*
  1463.           * All postfix expressions are printed as the operand followed
  1464.           *  by the token image of the operation.
  1465.           */
  1466.          fall_thru = c_walk(n->u[0].child, indent, 0);
  1467.          prt_tok(t, indent);
  1468.          return fall_thru;
  1469.       case PreSpcNd:
  1470.          /*
  1471.           * This prefix expression (pointer indication in a declaration) needs
  1472.           *  a space after it.
  1473.           */
  1474.          prt_tok(t, indent);
  1475.          c_walk(n->u[0].child, indent, 0);
  1476.          prt_str(" ", indent);
  1477.          return 1;
  1478.       case SymNd:
  1479.          /*
  1480.           * Identifier.
  1481.           */
  1482.          prt_var(n, indent);
  1483.          return 1;
  1484.       case BinryNd:
  1485.          switch (t->tok_id) {
  1486.             case '[':
  1487.                /*
  1488.                 * subscripting expression or declaration: <expr> [ <expr> ]
  1489.                 */
  1490.                n1 = n->u[0].child;
  1491.                c_walk(n->u[0].child, indent, 0);
  1492.                prt_str("[", indent);
  1493.                c_walk(n->u[1].child, indent, 0);
  1494.                prt_str("]", indent);
  1495.                return 1;
  1496.             case '(':
  1497.                /*
  1498.                 * cast: ( <type> ) <expr>
  1499.                 */
  1500.                prt_tok(t, indent);  /* ) */
  1501.                c_walk(n->u[0].child, indent, 0);
  1502.                prt_str(")", indent);
  1503.                c_walk(n->u[1].child, indent, 0);
  1504.                return 1;
  1505.             case ')':
  1506.                /*
  1507.                 * function call or declaration: <expr> ( <expr-list> )
  1508.                 */
  1509.                c_walk(n->u[0].child, indent, 0);
  1510.                prt_str("(", indent);
  1511.                c_walk(n->u[1].child, indent, 0);
  1512.                prt_tok(t, indent);   /* ) */
  1513.                return call_ret(n->u[0].child);
  1514.             case Struct:
  1515.             case Union:
  1516.                /*
  1517.                 * struct/union <ident>
  1518.                 * struct/union <opt-ident> { <field-list> }
  1519.                 */
  1520.                prt_tok(t, indent);   /* struct or union */
  1521.                prt_str(" ", indent);
  1522.                c_walk(n->u[0].child, indent, 0);
  1523.                if (n->u[1].child != NULL) {
  1524.                   /*
  1525.                    * Field declaration list.
  1526.                    */
  1527.                   prt_str(" {", indent);
  1528.                   c_walk(n->u[1].child, indent + IndentInc, 0);
  1529.                   ForceNl();
  1530.                   prt_str("}", indent);
  1531.                   }
  1532.                return 1;
  1533.             case TokEnum:
  1534.                /*
  1535.                 * enum <ident>
  1536.                 * enum <opt-ident> { <enum-list> }
  1537.                 */
  1538.                prt_tok(t, indent);   /* enum */
  1539.                prt_str(" ", indent);
  1540.                c_walk(n->u[0].child, indent, 0);
  1541.                if (n->u[1].child != NULL) {
  1542.                   /*
  1543.                    * enumerator list.
  1544.                    */
  1545.                   prt_str(" {", indent);
  1546.                   c_walk(n->u[1].child, indent + IndentInc, 0);
  1547.                   prt_str("}", indent);
  1548.                   }
  1549.                return 1;
  1550.             case ';':
  1551.                /*
  1552.                 * <type-specs> <declarator> ;
  1553.                 */
  1554.                c_walk(n->u[0].child, indent, 0);
  1555.                prt_str(" ", indent);
  1556.                c_walk(n->u[1].child, indent, 0);
  1557.                prt_tok(t, indent);  /* ; */
  1558.                return 1;
  1559.             case ':':
  1560.                /*
  1561.                 * <label> : <statement>
  1562.                 */
  1563.                c_walk(n->u[0].child, indent, 0);
  1564.                prt_tok(t, indent);   /* : */
  1565.                prt_str(" ", indent);
  1566.                fall_thru = c_walk(n->u[1].child, indent, 0);
  1567.                may_brnchto = 1;
  1568.                return fall_thru;
  1569.             case Case:
  1570.                /*
  1571.                 * case <expr> : <statement>
  1572.                 */
  1573.                prt_tok(t, indent - IndentInc);  /* case (un-indented) */
  1574.                prt_str(" ", indent);
  1575.                c_walk(n->u[0].child, indent - IndentInc, 0);
  1576.                prt_str(": ", indent - IndentInc);
  1577.                fall_thru = c_walk(n->u[1].child, indent, 0);
  1578.                may_brnchto = 1;
  1579.                return fall_thru;
  1580.             case Switch:
  1581.                /*
  1582.                 * switch ( <expr> ) <statement>
  1583.                 *
  1584.                 * <statement> is double indented so that case and default
  1585.                 * statements can be un-indented and come out indented 1
  1586.                 * with respect to the switch. Statements that are not
  1587.                 * "labeled" with case or default are indented one more
  1588.                 * than those that are labeled.
  1589.                 */
  1590.                prt_tok(t, indent);  /* switch */
  1591.                prt_str(" (", indent);
  1592.                c_walk(n->u[0].child, indent, 0);
  1593.                prt_str(")", indent);
  1594.                prt_str(" ", indent);
  1595.                save_break = does_break;
  1596.                fall_thru = c_walk(n->u[1].child, indent + 2 * IndentInc, 0);
  1597.                fall_thru |= does_break;
  1598.                does_break = save_break;
  1599.                return fall_thru;
  1600.             case While: {
  1601.                struct node *n0;
  1602.                /*
  1603.                 * While ( <expr> ) <statement>
  1604.                 */
  1605.                n0 = n->u[0].child;
  1606.                prt_tok(t, indent);  /* while */
  1607.                prt_str(" (", indent);
  1608.                c_walk(n0, indent, 0);
  1609.                prt_str(")", indent);
  1610.                prt_str(" ", indent);
  1611.                save_break = does_break;
  1612.                c_walk(n->u[1].child, indent + IndentInc, 0);
  1613.                /*
  1614.                 * check for an infinite loop, while (1) ... :
  1615.                 *  a condition consisting of an IntConst with image=="1"
  1616.                 *  and no breaks in the body.
  1617.                 */
  1618.                if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
  1619.                    !strcmp(n0->tok->image,"1") && !does_break)
  1620.                   fall_thru = 0;
  1621.                else
  1622.                   fall_thru = 1;
  1623.                does_break = save_break;
  1624.                return fall_thru;
  1625.                }
  1626.             case Do:
  1627.                /*
  1628.                 * do <statement> <while> ( <expr> )
  1629.                 */
  1630.                prt_tok(t, indent);  /* do */
  1631.                prt_str(" ", indent);
  1632.                c_walk(n->u[0].child, indent + IndentInc, 0);
  1633.                ForceNl();
  1634.                prt_str("while (", indent);
  1635.                save_break = does_break;
  1636.                c_walk(n->u[1].child, indent, 0);
  1637.                does_break = save_break;
  1638.                prt_str(");", indent);
  1639.                return 1;
  1640.             case '.':
  1641.             case Arrow:
  1642.                /*
  1643.                 * Field access: <expr> . <expr>  and  <expr> -> <expr>
  1644.                 */
  1645.                c_walk(n->u[0].child, indent, 0);
  1646.                prt_tok(t, indent);   /* . or -> */
  1647.                c_walk(n->u[1].child, indent, 0);
  1648.                return 1;
  1649.             case Runerr:
  1650.                /*
  1651.                 * runerr ( <error-number> )
  1652.                 * runerr ( <error-number> , <offending-value> )
  1653.                 */
  1654.                prt_runerr(t, n->u[0].child, n->u[1].child, indent);
  1655.                return 0;
  1656.             case Is:
  1657.                /*
  1658.                 * is : <type> ( <expr> )
  1659.                 */
  1660.                typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
  1661.                   n->u[0].child->tok, indent);
  1662.                return 1;
  1663.             default:
  1664.                /*
  1665.                 * All other binary expressions are infix notation and
  1666.                 *  are printed with spaces around the operator.
  1667.                 */
  1668.                c_walk(n->u[0].child, indent, 0);
  1669.                prt_str(" ", indent);
  1670.                prt_tok(t, indent);
  1671.                prt_str(" ", indent);
  1672.                c_walk(n->u[1].child, indent, 0);
  1673.                return 1;
  1674.             }
  1675.       case LstNd:
  1676.          /*
  1677.           * <declaration-part> <declaration-part>
  1678.           *
  1679.           * Need space between parts
  1680.           */
  1681.          c_walk(n->u[0].child, indent, 0);
  1682.          prt_str(" ", indent);
  1683.          c_walk(n->u[1].child, indent, 0);
  1684.          return 1;
  1685.       case ConCatNd:
  1686.          /*
  1687.           * <some-code> <some-code>
  1688.           *
  1689.           * Various lists of code parts that do not need space between them.
  1690.           */
  1691.          if (c_walk(n->u[0].child, indent, 0))
  1692.             return c_walk(n->u[1].child, indent, 0);
  1693.          else {
  1694.             /*
  1695.              * Cannot directly reach the second piece of code, see if
  1696.              *  it is possible to branch into it.
  1697.              */
  1698.             may_brnchto = 0;
  1699.             fall_thru = c_walk(n->u[1].child, indent, 0);
  1700.             return may_brnchto & fall_thru;
  1701.             }
  1702.       case CommaNd:
  1703.          /*
  1704.           * <expr> , <expr>
  1705.           */
  1706.          c_walk(n->u[0].child, indent, 0);
  1707.          prt_tok(t, indent);
  1708.          prt_str(" ", indent);
  1709.          return c_walk(n->u[1].child, indent, 0);
  1710.       case StrDclNd:
  1711.          /*
  1712.           * Structure field declaration. Bit field declarations have
  1713.           *  a semicolon and a field width.
  1714.           */
  1715.          c_walk(n->u[0].child, indent, 0);
  1716.          if (n->u[1].child != NULL) {
  1717.             prt_str(": ", indent);
  1718.             c_walk(n->u[1].child, indent, 0);
  1719.             }
  1720.          return 1;
  1721.       case CompNd:
  1722.          /*
  1723.           * Compound statement.
  1724.           */
  1725.          if (brace)
  1726.             tok_line(t, indent); /* just synch. file name and line number */
  1727.          else
  1728.             prt_tok(t, indent);  /* { */
  1729.          c_walk(n->u[0].child, indent, 0);
  1730.          /*
  1731.           * we are in an inner block. tended locations may need to
  1732.           *  be set to values from declaration initializations.
  1733.           */
  1734.          for (sym = n->u[1].sym; sym!= NULL; sym = sym->u.tnd_var.next) {
  1735.             if (sym->u.tnd_var.init != NULL) {
  1736.                prt_str(tendstrct, IndentInc);
  1737.                fprintf(out_file, ".d[%d]", sym->t_indx);
  1738.                switch (sym->id_type) {
  1739.                   case TndDesc:
  1740.                      prt_str(" = ", IndentInc);
  1741.                      break;
  1742.                   case TndStr:
  1743.                      prt_str(".vword.sptr = ", IndentInc);
  1744.                      break;
  1745.                   case TndBlk:
  1746.                      prt_str(".vword.bptr = (union block *)",
  1747.                         IndentInc);
  1748.                      break;
  1749.                   }
  1750.                c_walk(sym->u.tnd_var.init, 2 * IndentInc, 0);
  1751.                prt_str(";", 2 * IndentInc);
  1752.                ForceNl();
  1753.                }
  1754.             }
  1755.          /*
  1756.           * If there are no declarations, suppress braces that
  1757.           *  may be required for a one-statement body; we already
  1758.           *  have a set.
  1759.           */
  1760.          if (n->u[0].child == NULL && n->u[1].sym == NULL)
  1761.             fall_thru = c_walk(n->u[2].child, indent, 1);
  1762.          else
  1763.             fall_thru = c_walk(n->u[2].child, indent, 0);
  1764.          if (!brace) {
  1765.             ForceNl();
  1766.             prt_str("}", indent);
  1767.             }
  1768.          return fall_thru;
  1769.       case TrnryNd:
  1770.          switch (t->tok_id) {
  1771.             case '?':
  1772.                /*
  1773.                 * <expr> ? <expr> : <expr>
  1774.                 */
  1775.                c_walk(n->u[0].child, indent, 0);
  1776.                prt_str(" ", indent);
  1777.                prt_tok(t, indent);  /* ? */
  1778.                prt_str(" ", indent);
  1779.                c_walk(n->u[1].child, indent, 0);
  1780.                prt_str(" : ", indent);
  1781.                c_walk(n->u[2].child, indent, 0);
  1782.                return 1;
  1783.             case If:
  1784.                /*
  1785.                 * if ( <expr> ) <statement>
  1786.                 * if ( <expr> ) <statement> else <statement>
  1787.                 */
  1788.                prt_tok(t, indent);  /* if */
  1789.                prt_str(" (", indent);
  1790.                c_walk(n->u[0].child, indent + IndentInc, 0);
  1791.                prt_str(") ", indent);
  1792.                fall_thru = c_walk(n->u[1].child, indent + IndentInc, 0);
  1793.                n1 = n->u[2].child;
  1794.                if (n1 == NULL)
  1795.                   fall_thru = 1;
  1796.                else {
  1797.                   /*
  1798.                    * There is an else statement. Don't indent an
  1799.                    *  "else if"
  1800.                    */
  1801.                   ForceNl();
  1802.                   prt_str("else ", indent);
  1803.                   if (n1->nd_id == TrnryNd && n1->tok->tok_id == If)
  1804.                      fall_thru |= c_walk(n1, indent, 0);
  1805.                   else
  1806.                      fall_thru |= c_walk(n1, indent + IndentInc, 0);
  1807.                   }
  1808.                return fall_thru;
  1809.             case Type_case:
  1810.                /*
  1811.                 * type_case <expr> of { <section-list> }
  1812.                 * type_case <expr> of { <section-list> <default-clause> }
  1813.                 */
  1814.                return typ_case(n->u[0].child, n->u[1].child, n->u[2].child,
  1815.                   c_walk, 1, indent);
  1816.             case Cnv:
  1817.                /*
  1818.                 * cnv : <type> ( <source> , <destination> )
  1819.                 */
  1820.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
  1821.                   n->u[2].child,
  1822.                   indent);
  1823.                return 1;
  1824.             }
  1825.       case QuadNd:
  1826.          switch (t->tok_id) {
  1827.             case For:
  1828.                /*
  1829.                 * for ( <expr> ; <expr> ; <expr> ) <statement>
  1830.                 */
  1831.                prt_tok(t, indent);  /* for */
  1832.                prt_str(" (", indent);
  1833.                c_walk(n->u[0].child, indent, 0);
  1834.                prt_str("; ", indent);
  1835.                c_walk(n->u[1].child, indent, 0);
  1836.                prt_str("; ", indent);
  1837.                c_walk(n->u[2].child, indent, 0);
  1838.                prt_str(") ", indent);
  1839.                save_break = does_break;
  1840.                c_walk(n->u[3].child, indent + IndentInc, 0);
  1841.                if (n->u[1].child == NULL && !does_break)
  1842.                   fall_thru = 0;
  1843.                else
  1844.                   fall_thru = 1;
  1845.                does_break = save_break;
  1846.                return fall_thru;
  1847.             case Def:
  1848.                /*
  1849.                 * def : <type> ( <source> , <default> , <destination> )
  1850.                 */
  1851.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
  1852.                   n->u[3].child, indent);
  1853.                return 1;
  1854.             }
  1855.       }
  1856.    /*NOTREACHED*/
  1857.    return 0;            /* avoid gcc warning */
  1858.    }
  1859.  
  1860. /*
  1861.  * call_ret - decide whether a function being called might return.
  1862.  */
  1863. int call_ret(n)
  1864. struct node *n;
  1865.    {
  1866.    /*
  1867.     * Assume functions return except for c_exit(), fatalerr(), and syserr().
  1868.     */
  1869.    if (n->tok != NULL &&
  1870.       (strcmp("c_exit",   n->tok->image) == 0 ||
  1871.        strcmp("fatalerr", n->tok->image) == 0 ||
  1872.        strcmp("syserr",   n->tok->image) == 0))
  1873.       return 0;
  1874.    else
  1875.       return 1;
  1876.    }
  1877.  
  1878. /*
  1879.  * new_prmloc - allocate an array large enough to hold a flag for every
  1880.  *  parameter of the current operation. This flag indicates where
  1881.  *  the parameter is in terms of scopes created by conversions.
  1882.  */
  1883. struct parminfo *new_prmloc()
  1884.    {
  1885.    struct parminfo *parminfo;
  1886.    int nparams;
  1887.    int i;
  1888.  
  1889.    if (params == NULL)
  1890.       return NULL;
  1891.    nparams = params->u.param_info.param_num + 1;
  1892.    parminfo = alloc(nparams * sizeof(struct parminfo));
  1893.    for (i = 0; i < nparams; ++i) {
  1894.       parminfo[i].cur_loc = 0;
  1895.       parminfo [i].parm_mod = 0;
  1896.       }
  1897.    return parminfo;
  1898.    }
  1899.  
  1900. /*
  1901.  * ld_prmloc - load parameter location information that has been
  1902.  *  saved in an arrary into the symbol table.
  1903.  */
  1904. void ld_prmloc(parminfo)
  1905. struct parminfo *parminfo;
  1906.    {
  1907.    struct sym_entry *sym;
  1908.    int param_num;
  1909.  
  1910.    for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
  1911.       param_num = sym->u.param_info.param_num;
  1912.       if (sym->id_type & DrfPrm) {
  1913.          sym->u.param_info.cur_loc = parminfo[param_num].cur_loc;
  1914.          sym->u.param_info.parm_mod = parminfo[param_num].parm_mod;
  1915.          }
  1916.       }
  1917.    }
  1918.  
  1919. /*
  1920.  * sv_prmloc - save parameter location information from the the symbol table
  1921.  *  into an array.
  1922.  */
  1923. void sv_prmloc(parminfo)
  1924. struct parminfo *parminfo;
  1925.    {
  1926.    struct sym_entry *sym;
  1927.    int param_num;
  1928.  
  1929.    for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
  1930.       param_num = sym->u.param_info.param_num;
  1931.       if (sym->id_type & DrfPrm) {
  1932.          parminfo[param_num].cur_loc = sym->u.param_info.cur_loc;
  1933.          parminfo[param_num].parm_mod = sym->u.param_info.parm_mod;
  1934.          }
  1935.       }
  1936.    }
  1937.  
  1938. /*
  1939.  * mrg_prmloc - merge parameter location information in the symbol table
  1940.  *  with other information already saved in an array. This may result
  1941.  *  in conflicting location information, but conflicts are only detected
  1942.  *  when a parameter is actually used.
  1943.  */
  1944. void mrg_prmloc(parminfo)
  1945. struct parminfo *parminfo;
  1946.    {
  1947.    struct sym_entry *sym;
  1948.    int param_num;
  1949.  
  1950.    for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
  1951.       param_num = sym->u.param_info.param_num;
  1952.       if (sym->id_type & DrfPrm) {
  1953.          parminfo[param_num].cur_loc |= sym->u.param_info.cur_loc;
  1954.          parminfo[param_num].parm_mod |= sym->u.param_info.parm_mod;
  1955.          }
  1956.       }
  1957.    }
  1958.  
  1959. /*
  1960.  * clr_prmloc - indicate that this execution path contributes nothing
  1961.  *   to the location of parameters.
  1962.  */
  1963. void clr_prmloc()
  1964.    {
  1965.    struct sym_entry *sym;
  1966.  
  1967.    for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
  1968.       if (sym->id_type & DrfPrm) {
  1969.          sym->u.param_info.cur_loc = 0;
  1970.          sym->u.param_info.parm_mod = 0;
  1971.          }
  1972.       }
  1973.    }
  1974.  
  1975. /*
  1976.  * typ_case - translate a type_case statement into C. This is called
  1977.  *  while walking a syntax tree of either RTL code or C code; the parameter
  1978.  *  "walk" is a function used to process the subtrees within the type_case
  1979.  *  statement.
  1980.  */
  1981. static int typ_case(var, slct_lst, dflt, walk, maybe_var, indent)
  1982. struct node *var;
  1983. struct node *slct_lst;
  1984. struct node *dflt;
  1985. int (*walk)(struct node *n, int xindent, int brace);
  1986. int maybe_var;
  1987. int indent;
  1988.    {
  1989.    struct node *lst;
  1990.    struct node *select;
  1991.    struct node *slctor;
  1992.    struct parminfo *strt_prms;
  1993.    struct parminfo *end_prms;
  1994.    int remaining;
  1995.    int first;
  1996.    int fnd_slctrs;
  1997.    int maybe_str = 1;
  1998.    int dflt_lbl;
  1999.    int typcd;
  2000.    int fall_thru;
  2001.    char *s;
  2002.  
  2003.    /*
  2004.     * This statement involves multiple paths that may establish new
  2005.     *  scopes for parameters. Remember the starting scope information
  2006.     *  and initialize an array in which to compute the final information.
  2007.     */
  2008.    strt_prms = new_prmloc();
  2009.    sv_prmloc(strt_prms);
  2010.    end_prms = new_prmloc();
  2011.  
  2012.    /*
  2013.     * First look for cases that must be checked with "if" statements.
  2014.     *  These include string qualifiers and variables.
  2015.     */
  2016.    remaining = 0;      /* number of cases skipped in first pass */
  2017.    first = 1;          /* next case to be output is the first */
  2018.    if (dflt == NULL)
  2019.       fall_thru = 1;
  2020.    else
  2021.       fall_thru = 0;
  2022.    for (lst = slct_lst; lst != NULL; lst = lst->u[0].child) {
  2023.       select = lst->u[1].child;
  2024.       fnd_slctrs = 0; /* flag: found type selections for clause for this pass */
  2025.       /*
  2026.        * A selection clause may include several types.
  2027.        */
  2028.       for (slctor = select->u[0].child; slctor != NULL; slctor =
  2029.         slctor->u[0].child) {
  2030.          typcd = icn_typ(slctor->u[1].child);
  2031.          if(typ_name(typcd, slctor->u[1].child->tok) == NULL) {
  2032.             /*
  2033.              * This type must be checked with the "if". Is this the
  2034.              *  first condition checked for this clause? Is this the
  2035.              *  first clause output?
  2036.              */
  2037.             if (fnd_slctrs)
  2038.                prt_str(" || ", indent);
  2039.             else {
  2040.                if (first)
  2041.                   first = 0;
  2042.                else {
  2043.                   ForceNl();
  2044.                   prt_str("else ", indent);
  2045.                   }
  2046.                prt_str("if (", indent);
  2047.                fnd_slctrs = 1;
  2048.                }
  2049.  
  2050.             /*
  2051.              * Output type check
  2052.              */
  2053.             typ_asrt(typcd, var, slctor->u[1].child->tok, indent + IndentInc);
  2054.  
  2055.             if (typcd == str_typ)
  2056.                maybe_str = 0;  /* string has been taken care of */
  2057.             else if (typcd == Variable)
  2058.                maybe_var = 0;  /* variable has been taken care of */
  2059.             }
  2060.          else
  2061.             ++remaining;
  2062.          }
  2063.       if (fnd_slctrs) {
  2064.          /*
  2065.           * We have found and output type selections for this clause;
  2066.           *  output the body of the clause. Remember any changes to
  2067.           *  paramter locations caused by type conversions within the
  2068.           *  clause.
  2069.           */
  2070.          prt_str(") {", indent + IndentInc);
  2071.          ForceNl();
  2072.          if ((*walk)(select->u[1].child, indent + IndentInc, 1)) {
  2073.             fall_thru |= 1;
  2074.             mrg_prmloc(end_prms);
  2075.             }
  2076.          prt_str("}", indent + IndentInc);
  2077.          ForceNl();
  2078.          ld_prmloc(strt_prms);
  2079.          }
  2080.       }
  2081.    /*
  2082.     * The rest of the cases can be checked with a "switch" statement, look
  2083.     *  for them..
  2084.     */
  2085.    if (remaining == 0) {
  2086.       if (dflt != NULL) {
  2087.          /*
  2088.           * There are no cases to handle with a switch statement, but there
  2089.           *  is a default clause; handle it with an "else".
  2090.           */
  2091.          prt_str("else {", indent);
  2092.          ForceNl();
  2093.          fall_thru |= (*walk)(dflt, indent + IndentInc, 1);
  2094.          ForceNl();
  2095.          prt_str("}", indent + IndentInc);
  2096.          ForceNl();
  2097.          }
  2098.       }
  2099.    else {
  2100.       /*
  2101.        * If an "if" statement was output, the "switch" must be in its "else"
  2102.        *   clause.
  2103.        */
  2104.       if (!first)
  2105.          prt_str("else ", indent);
  2106.  
  2107.       /*
  2108.        * A switch statement cannot handle types that are not simple type
  2109.        *  codes. If these have not taken care of, output code to check them.
  2110.        *  This will either branch around the switch statement or into
  2111.        *  its default clause.
  2112.        */
  2113.       if (maybe_str || maybe_var) {
  2114.          dflt_lbl = lbl_num++;      /* allocate a label number */
  2115.          prt_str("{", indent);
  2116.          ForceNl();
  2117.          prt_str("if (((", indent);
  2118.          c_walk(var, indent + IndentInc, 0);
  2119.          prt_str(").dword & D_Typecode) != D_Typecode) ", indent);
  2120.          ForceNl();
  2121.          prt_str("goto L", indent + IndentInc);
  2122.          fprintf(out_file, "%d;  /* default */ ", dflt_lbl);
  2123.          ForceNl();
  2124.          }
  2125.  
  2126.       no_nl = 1; /* suppress #line directives */
  2127.       prt_str("switch (Type(", indent);
  2128.       c_walk(var, indent + IndentInc, 0);
  2129.       prt_str(")) {", indent + IndentInc);
  2130.       no_nl = 0;
  2131.       ForceNl();
  2132.  
  2133.       /*
  2134.        * Loop through the case clauses producing code for them.
  2135.        */
  2136.       for (lst = slct_lst; lst != NULL; lst = lst->u[0].child) {
  2137.          select = lst->u[1].child;
  2138.          fnd_slctrs = 0;
  2139.          /*
  2140.           * A selection clause may include several types.
  2141.           */
  2142.          for (slctor = select->u[0].child; slctor != NULL; slctor =
  2143.            slctor->u[0].child) {
  2144.             typcd = icn_typ(slctor->u[1].child);
  2145.             s = typ_name(typcd, slctor->u[1].child->tok);
  2146.             if (s != NULL) {
  2147.                /*
  2148.                 * A type selection has been found that can be checked
  2149.                 *  in the switch statement. Note that large integers
  2150.                 *  require special handling.
  2151.                 */
  2152.                fnd_slctrs = 1;
  2153.  
  2154.            if (typcd == int_typ) {
  2155.          ForceNl();
  2156.          prt_str("#ifdef LargeInts", 0);
  2157.          ForceNl();
  2158.          prt_str("case T_Lrgint:  ", indent + IndentInc);
  2159.          ForceNl();
  2160.          prt_str("#endif /* LargeInts */", 0);
  2161.          ForceNl();
  2162.            }
  2163.  
  2164.                prt_str("case T_", indent + IndentInc);
  2165.                prt_str(s, indent + IndentInc);
  2166.                prt_str(": ", indent + IndentInc);
  2167.                }
  2168.             }
  2169.          if (fnd_slctrs) {
  2170.             /*
  2171.              * We have found and output type selections for this clause;
  2172.              *  output the body of the clause. Remember any changes to
  2173.              *  paramter locations caused by type conversions within the
  2174.              *  clause.
  2175.              */
  2176.             ForceNl();
  2177.             if ((*walk)(select->u[1].child, indent + 2 * IndentInc, 0)) {
  2178.                fall_thru |= 1;
  2179.                ForceNl();
  2180.                prt_str("break;", indent + 2 * IndentInc);
  2181.                mrg_prmloc(end_prms);
  2182.                }
  2183.             ForceNl();
  2184.             ld_prmloc(strt_prms);
  2185.             }
  2186.          }
  2187.       if (dflt != NULL) {
  2188.          /*
  2189.           * This type_case statement has a default clause. If there is
  2190.           *  a branch into this clause, output the label. Remember any
  2191.           *  changes to paramter locations caused by type conversions
  2192.           *  within the clause.
  2193.           */
  2194.          ForceNl();
  2195.          prt_str("default:", indent + 1 * IndentInc);
  2196.          ForceNl();
  2197.          if (maybe_str || maybe_var) {
  2198.             prt_str("L", 0);
  2199.             fprintf(out_file, "%d: ;  /* default */", dflt_lbl);
  2200.             ForceNl();
  2201.             }
  2202.          if ((*walk)(dflt, indent + 2 * IndentInc, 0)) {
  2203.             fall_thru |= 1;
  2204.             mrg_prmloc(end_prms);
  2205.             }
  2206.          ForceNl();
  2207.          ld_prmloc(strt_prms);
  2208.          }
  2209.       prt_str("}", indent + IndentInc);
  2210.  
  2211.       if (maybe_str || maybe_var) {
  2212.          if (dflt == NULL) {
  2213.             /*
  2214.              * There is a branch around the switch statement. Output
  2215.              *  the label.
  2216.              */
  2217.             ForceNl();
  2218.             prt_str("L", 0);
  2219.             fprintf(out_file, "%d: ;  /* default */", dflt_lbl);
  2220.             }
  2221.          ForceNl();
  2222.          prt_str("}", indent + IndentInc);
  2223.          }
  2224.       ForceNl();
  2225.       }
  2226.  
  2227.    /*
  2228.     * Put ending parameter locations into effect.
  2229.     */
  2230.    mrg_prmloc(end_prms);
  2231.    ld_prmloc(end_prms);
  2232.    if (strt_prms != NULL)
  2233.       free(strt_prms);
  2234.    if (end_prms != NULL)
  2235.       free(end_prms);
  2236.    return fall_thru;
  2237.    }
  2238.  
  2239. /*
  2240.  * chk_conj - see if the left argument of a conjunction is an in-place
  2241.  *   conversion of a parameter other than a conversion to C_integer or
  2242.  *   C_double. If so issue a warning.
  2243.  */
  2244. static void chk_conj(n)
  2245. struct node *n;
  2246.    {
  2247.    struct node *cnv_type;
  2248.    struct node *src;
  2249.    struct node *dest;
  2250.    int typcd;
  2251.  
  2252.    if (n->nd_id == BinryNd && n->tok->tok_id == And)
  2253.       n = n->u[1].child;
  2254.  
  2255.    switch (n->nd_id) {
  2256.       case TrnryNd:
  2257.          /*
  2258.           * Must be Cnv.
  2259.           */
  2260.          cnv_type = n->u[0].child;
  2261.          src = n->u[1].child;
  2262.          dest = n->u[2].child;
  2263.          break;
  2264.       case QuadNd:
  2265.          /*
  2266.           * Must be Def.
  2267.           */
  2268.          cnv_type = n->u[0].child;
  2269.          src = n->u[1].child;
  2270.          dest = n->u[3].child;
  2271.          break;
  2272.       default:
  2273.          return;   /* not a  conversion */
  2274.       }
  2275.  
  2276.    /*
  2277.     * A conversion has been found. See if it meets the criteria for
  2278.     *  issuing a warning.
  2279.     */
  2280.  
  2281.    if (src->nd_id != SymNd || !(src->u[0].sym->id_type & DrfPrm))
  2282.       return;  /* not a dereferenced parameter */
  2283.  
  2284.    typcd = icn_typ(cnv_type);
  2285.    switch (typcd) {
  2286.       case TypCInt:
  2287.       case TypCDbl:
  2288.       case TypECInt:
  2289.          return;
  2290.       }
  2291.  
  2292.    if (dest != NULL)
  2293.       return;   /* not an in-place convertion */
  2294.  
  2295.    fprintf(stderr,
  2296.     "%s: file %s, line %d, warning: in-place conversion may or may not be\n",
  2297.       progname, cnv_type->tok->fname, cnv_type->tok->line);
  2298.    fprintf(stderr, "\tundone on subsequent failure.\n");
  2299.    }
  2300.  
  2301. /*
  2302.  * len_sel - translate a clause form a len_case statement into a C case
  2303.  *  clause. Return an indication of whether execution falls through the
  2304.  *  clause.
  2305.  */
  2306. static int len_sel(sel, strt_prms, end_prms, indent)
  2307. struct node *sel;
  2308. struct parminfo *strt_prms;
  2309. struct parminfo *end_prms;
  2310. int indent;
  2311.    {
  2312.    int fall_thru;
  2313.  
  2314.    prt_str("case ", indent);
  2315.    prt_tok(sel->tok, indent + IndentInc);           /* integer selection */
  2316.    prt_str(":", indent + IndentInc);
  2317.    fall_thru = rt_walk(sel->u[0].child, indent + IndentInc, 0);/* clause body */
  2318.    ForceNl();
  2319.  
  2320.    if (fall_thru) {
  2321.       prt_str("break;", indent + IndentInc);
  2322.       ForceNl();
  2323.       /*
  2324.        * Remember any changes to paramter locations caused by type conversions
  2325.        *  within the clause.
  2326.        */
  2327.       mrg_prmloc(end_prms);
  2328.       }
  2329.  
  2330.    ld_prmloc(strt_prms);
  2331.    return fall_thru;
  2332.    }
  2333.  
  2334. /*
  2335.  * rt_walk - walk the part of the syntax tree containing rtt code, producing
  2336.  *   code for the most-general version of the routine.
  2337.  */
  2338. static int rt_walk(n, indent, brace)
  2339. struct node *n;
  2340. int indent;
  2341. int brace;
  2342.    {
  2343.    struct token *t, *t1;
  2344.    struct node *n1, *errnum;
  2345.    int fall_thru;
  2346.  
  2347.    if (n == NULL)
  2348.       return 1;
  2349.  
  2350.    t =  n->tok;
  2351.  
  2352.    switch (n->nd_id) {
  2353.       case PrefxNd:
  2354.          switch (t->tok_id) {
  2355.             case '{':
  2356.                /*
  2357.                 * RTL code: { <actions> }
  2358.                 */
  2359.                if (brace)
  2360.                   tok_line(t, indent); /* just synch file name and line num */
  2361.                else
  2362.                   prt_tok(t, indent);  /* { */
  2363.                fall_thru = rt_walk(n->u[0].child, indent, 1);
  2364.                if (!brace)
  2365.                   prt_str("}", indent);
  2366.                return fall_thru;
  2367.             case '!':
  2368.                /*
  2369.                 * RTL type-checking and conversions: ! <simple-type-check>
  2370.                 */
  2371.                prt_tok(t, indent);
  2372.                rt_walk(n->u[0].child, indent, 0);
  2373.                return 1;
  2374.             case Body:
  2375.             case Inline:
  2376.                /*
  2377.                 * RTL code: body { <c-code> }
  2378.                 *           inline { <c-code> }
  2379.                 */
  2380.                fall_thru = c_walk(n->u[0].child, indent, brace);
  2381.                if (!fall_thru)
  2382.                   clr_prmloc();
  2383.                return fall_thru;
  2384.             }
  2385.          break;
  2386.       case BinryNd:
  2387.          switch (t->tok_id) {
  2388.             case Runerr:
  2389.                /*
  2390.                 * RTL code: runerr( <message-number> )
  2391.                 *           runerr( <message-number>, <descriptor> )
  2392.                 */
  2393.                prt_runerr(t, n->u[0].child, n->u[1].child, indent);
  2394.  
  2395.                /*
  2396.                 * Execution cannot continue on this execution path.
  2397.                 */
  2398.                clr_prmloc();
  2399.                return 0;
  2400.             case And:
  2401.                /*
  2402.                 * RTL type-checking and conversions:
  2403.                 *   <type-check> && <type_check>
  2404.                 */
  2405.                chk_conj(n->u[0].child);  /* is a warning needed? */
  2406.                rt_walk(n->u[0].child, indent, 0);
  2407.                prt_str(" ", indent);
  2408.                prt_tok(t, indent);       /* && */
  2409.                prt_str(" ", indent);
  2410.                rt_walk(n->u[1].child, indent, 0);
  2411.                return 1;
  2412.             case Is:
  2413.                /*
  2414.                 * RTL type-checking and conversions:
  2415.                 *   is: <icon-type> ( <variable> )
  2416.                 */
  2417.                typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
  2418.                   n->u[0].child->tok, indent);
  2419.                return 1;
  2420.             }
  2421.          break;
  2422.       case ConCatNd:
  2423.          /*
  2424.           * "Glue" for two constructs.
  2425.           */
  2426.          fall_thru = rt_walk(n->u[0].child, indent, 0);
  2427.          return fall_thru & rt_walk(n->u[1].child, indent, 0);
  2428.       case AbstrNd:
  2429.          /*
  2430.           * Ignore abstract type computations while producing C code
  2431.           *  for library routines.
  2432.           */
  2433.          return 1;
  2434.       case TrnryNd:
  2435.          switch (t->tok_id) {
  2436.             case If: {
  2437.                /*
  2438.                 * RTL code for "if" statements:
  2439.                 *  if <type-check> then <action>
  2440.                 *  if <type-check> then <action> else <action>
  2441.                 *
  2442.                 *  <type-check> may include parameter conversions that create
  2443.                 *  new scoping. It is necessary to keep track of paramter
  2444.                 *  types and locations along success and failure paths of
  2445.                 *  these conversions. The "then" and "else" actions may
  2446.                 *  also establish new scopes.
  2447.                 */
  2448.                struct parminfo *then_prms = NULL;
  2449.                struct parminfo *else_prms;
  2450.  
  2451.                /*
  2452.                 * Save the current parameter locations. These are in
  2453.                 *  effect on the failure path of any type conversions
  2454.                 *  in the condition of the "if".
  2455.                 */
  2456.                else_prms = new_prmloc();
  2457.                sv_prmloc(else_prms);
  2458.  
  2459.                prt_tok(t, indent);       /* if */
  2460.                prt_str(" (", indent);
  2461.                n1 = n->u[0].child;
  2462.                rt_walk(n1, indent + IndentInc, 0);   /* type check */
  2463.                prt_str(") {", indent);
  2464.  
  2465.                /*
  2466.                 * If the condition is negated, the failure path is to the "then"
  2467.                 *  and the success path is to the "else".
  2468.                 */
  2469.                if (n1->nd_id == PrefxNd && n1->tok->tok_id == '!') {
  2470.                   then_prms = else_prms;
  2471.                   else_prms = new_prmloc();
  2472.                   sv_prmloc(else_prms);
  2473.                   ld_prmloc(then_prms);
  2474.                   }
  2475.  
  2476.                /*
  2477.                 * Then Clause.
  2478.                 */
  2479.                fall_thru = rt_walk(n->u[1].child, indent + IndentInc, 1);
  2480.                ForceNl();
  2481.                prt_str("}", indent + IndentInc);
  2482.  
  2483.                /*
  2484.                 * Determine if there is an else clause and merge parameter
  2485.                 *  location information from the alternate paths through
  2486.                 *  the statement.
  2487.                 */
  2488.                n1 = n->u[2].child;
  2489.                if (n1 == NULL) {
  2490.                   if (fall_thru)
  2491.                      mrg_prmloc(else_prms);
  2492.                   ld_prmloc(else_prms);
  2493.                   fall_thru = 1;
  2494.                   }
  2495.                else {
  2496.                   if (then_prms == NULL)
  2497.                      then_prms = new_prmloc();
  2498.                   if (fall_thru)
  2499.                      sv_prmloc(then_prms);
  2500.                   ld_prmloc(else_prms);
  2501.                   ForceNl();
  2502.                   prt_str("else {", indent);
  2503.                   if (rt_walk(n1, indent + IndentInc, 1)) {  /* else clause */
  2504.                      fall_thru = 1;
  2505.                      mrg_prmloc(then_prms);
  2506.                      }
  2507.                   ForceNl();
  2508.                   prt_str("}", indent + IndentInc);
  2509.                   ld_prmloc(then_prms);
  2510.                   }
  2511.                ForceNl();
  2512.                if (then_prms != NULL)
  2513.                   free(then_prms);
  2514.                if (else_prms != NULL)
  2515.                   free(else_prms);
  2516.                }
  2517.                return fall_thru;
  2518.             case Len_case: {
  2519.                /*
  2520.                 * RTL code:
  2521.                 *   len_case <variable> of {
  2522.                 *      <integer>: <action>
  2523.                 *        ...
  2524.                 *      default: <action>
  2525.                 *      }
  2526.                 */
  2527.                struct parminfo *strt_prms;
  2528.                struct parminfo *end_prms;
  2529.  
  2530.                /*
  2531.                 * A case may contain parameter conversions that create new
  2532.                 *  scopes. Remember the parameter locations at the start
  2533.                 *  of the len_case statement.
  2534.                 */
  2535.                strt_prms = new_prmloc();
  2536.                sv_prmloc(strt_prms);
  2537.                end_prms = new_prmloc();
  2538.  
  2539.                n1 = n->u[0].child;
  2540.                if (!(n1->u[0].sym->id_type & VArgLen))
  2541.               errt1(t, "len_case must select on length of vararg");
  2542.                /*
  2543.                 * The len_case statement is implemented as a C switch
  2544.                 *  statement.
  2545.                 */
  2546.                prt_str("switch (", indent);
  2547.                prt_var(n1, indent);
  2548.                prt_str(") {", indent);
  2549.                ForceNl();
  2550.                fall_thru = 0;
  2551.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  2552.                   n1 = n1->u[0].child)
  2553.                      fall_thru |= len_sel(n1->u[1].child, strt_prms, end_prms,
  2554.                         indent + IndentInc);
  2555.                fall_thru |= len_sel(n1, strt_prms, end_prms,
  2556.                   indent + IndentInc);
  2557.  
  2558.                /*
  2559.                 * Handle default clause.
  2560.                 */
  2561.                prt_str("default:", indent + IndentInc);
  2562.                ForceNl();
  2563.                fall_thru |= rt_walk(n->u[2].child, indent + 2 * IndentInc, 0);
  2564.                ForceNl();
  2565.                prt_str("}", indent + IndentInc);
  2566.                ForceNl();
  2567.  
  2568.                /*
  2569.                 * Put into effect the location of parameters at the end
  2570.                 *  of the len_case statement.
  2571.                 */
  2572.                mrg_prmloc(end_prms);
  2573.                ld_prmloc(end_prms);
  2574.                if (strt_prms != NULL)
  2575.                   free(strt_prms);
  2576.                if (end_prms != NULL)
  2577.                   free(end_prms);
  2578.                }
  2579.                return fall_thru;
  2580.             case Type_case: {
  2581.                /*
  2582.                 * RTL code:
  2583.                 *   type_case <variable> of {
  2584.                 *       <icon_type> : ... <icon_type> : <action>
  2585.                 *          ...
  2586.                 *       }
  2587.                 *
  2588.                 *   last clause may be: default: <action>
  2589.                 */
  2590.                int maybe_var;
  2591.                struct node *var;
  2592.                struct sym_entry *sym;
  2593.  
  2594.                /*
  2595.                 * If we can determine that the value being checked is
  2596.                 *  not a variable reference, we don't have to produce code
  2597.                 *  to check for that possibility.
  2598.                 */
  2599.                maybe_var = 1;
  2600.                var = n->u[0].child;
  2601.                if (var->nd_id == SymNd) {
  2602.                   sym = var->u[0].sym;
  2603.                   switch(sym->id_type) {
  2604.                      case DrfPrm:
  2605.                      case OtherDcl:
  2606.                      case TndDesc:
  2607.                      case TndStr:
  2608.                      case RsltLoc:
  2609.                         if (sym->nest_lvl > 1) {
  2610.                            /*
  2611.                             * The thing being tested is either a
  2612.                             *  dereferenced parameter or a local
  2613.                             *  descriptor which could only have been
  2614.                             *  set by a conversion which does not
  2615.                             *  produce a variable reference.
  2616.                             */
  2617.                            maybe_var = 0;
  2618.                            }
  2619.                       }
  2620.                   }
  2621.                return typ_case(var, n->u[1].child, n->u[2].child, rt_walk,
  2622.                   maybe_var, indent);
  2623.                }
  2624.             case Cnv:
  2625.                /*
  2626.                 * RTL code: cnv: <type> ( <source> )
  2627.                 *           cnv: <type> ( <source> , <destination> )
  2628.                 */
  2629.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
  2630.                   n->u[2].child, indent);
  2631.                return 1;
  2632.             case Arith_case: {
  2633.                /*
  2634.                 * arith_case (<variable>, <variable>) of {
  2635.                 *   C_integer: <statement>
  2636.                 *   integer: <statement>
  2637.                 *   C_double: <statement>
  2638.                 *   }
  2639.                 *
  2640.                 * This construct does type conversions and provides
  2641.                 *  alternate execution paths. It is necessary to keep
  2642.                 *  track of parameter locations.
  2643.                 */
  2644.                struct parminfo *strt_prms;
  2645.                struct parminfo *end_prms;
  2646.                struct parminfo *tmp_prms;
  2647.  
  2648.                strt_prms = new_prmloc();
  2649.                sv_prmloc(strt_prms);
  2650.                end_prms = new_prmloc();
  2651.                tmp_prms = new_prmloc();
  2652.  
  2653.                fall_thru = 0;
  2654.  
  2655.                n1 = n->u[2].child;   /* contains actions for the 3 cases */
  2656.  
  2657.                /*
  2658.                 * Set up an error number node for use in runerr().
  2659.                 */
  2660.                t1 = copy_t(t);
  2661.                t1->tok_id = IntConst;
  2662.                t1->image = "102";
  2663.                errnum = node0(PrimryNd, t1);
  2664.  
  2665.                /*
  2666.                 * Try converting both arguments to a C_integer.
  2667.                 */
  2668.                tok_line(t, indent);
  2669.                prt_str("if (", indent);
  2670.                cnv_fnc(t, TypECInt, n->u[0].child, NULL, NULL, indent);
  2671.                prt_str(" && ", indent);
  2672.                cnv_fnc(t, TypECInt, n->u[1].child, NULL, NULL, indent);
  2673.                prt_str(") ", indent);
  2674.                ForceNl();
  2675.                if (rt_walk(n1->u[0].child, indent + IndentInc, 0)) {
  2676.                   fall_thru |= 1;
  2677.                   mrg_prmloc(end_prms);
  2678.                   }
  2679.                ForceNl();
  2680.  
  2681.                /*
  2682.                 * Try converting both arguments to an integer.
  2683.                 */
  2684.                prt_str("#ifdef LargeInts", 0);
  2685.                ForceNl();
  2686.                ld_prmloc(strt_prms);
  2687.                tok_line(t, indent);
  2688.                prt_str("else if (", indent);
  2689.                cnv_fnc(t, TypEInt, n->u[0].child, NULL, NULL, indent);
  2690.                prt_str(" && ", indent);
  2691.                cnv_fnc(t, TypEInt, n->u[1].child, NULL, NULL, indent);
  2692.                prt_str(") ", indent);
  2693.                ForceNl();
  2694.                if (rt_walk(n1->u[1].child, indent + IndentInc, 0)) {
  2695.                   fall_thru |= 1;
  2696.                   mrg_prmloc(end_prms);
  2697.                   }
  2698.                ForceNl();
  2699.                prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
  2700.                ForceNl();
  2701.  
  2702.                /*
  2703.                 * Try converting both arguments to a C_double
  2704.                 */
  2705.                ld_prmloc(strt_prms);
  2706.                prt_str("else {", indent);
  2707.                ForceNl();
  2708.                tok_line(t, indent + IndentInc);
  2709.                prt_str("if (!", indent + IndentInc);
  2710.                cnv_fnc(t, TypCDbl, n->u[0].child, NULL, NULL,
  2711.                   indent + IndentInc);
  2712.                prt_str(")", indent + IndentInc);
  2713.                ForceNl();
  2714.                sv_prmloc(tmp_prms);   /* use original parm locs for error */
  2715.                ld_prmloc(strt_prms);
  2716.                prt_runerr(t, errnum, n->u[0].child, indent + 2 * IndentInc);
  2717.                ld_prmloc(tmp_prms);
  2718.                tok_line(t, indent + IndentInc);
  2719.                prt_str("if (!", indent + IndentInc);
  2720.                cnv_fnc(t, TypCDbl, n->u[1].child, NULL, NULL,
  2721.                   indent + IndentInc);
  2722.                prt_str(") ", indent + IndentInc);
  2723.                ForceNl();
  2724.                sv_prmloc(tmp_prms);   /* use original parm locs for error */
  2725.                ld_prmloc(strt_prms);
  2726.                prt_runerr(t, errnum, n->u[1].child, indent + 2 * IndentInc);
  2727.                ld_prmloc(tmp_prms);
  2728.                if (rt_walk(n1->u[2].child, indent + IndentInc, 0)) {
  2729.                   fall_thru |= 1;
  2730.                   mrg_prmloc(end_prms);
  2731.                   }
  2732.                ForceNl();
  2733.                prt_str("}", indent + IndentInc);
  2734.                ForceNl();
  2735.  
  2736.                ld_prmloc(end_prms);
  2737.                free(strt_prms);
  2738.                free(end_prms);
  2739.                free(tmp_prms);
  2740.                free_tree(errnum);
  2741.                return fall_thru;
  2742.                }
  2743.             }
  2744.       case QuadNd:
  2745.          /*
  2746.           * RTL code: def: <type> ( <source> , <default>)
  2747.           *           def: <type> ( <source> , <default> , <destination> )
  2748.           */
  2749.          cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
  2750.             n->u[3].child, indent);
  2751.          return 1;
  2752.       }
  2753.    /*NOTREACHED*/
  2754.    return 0;  /* avoid gcc warning */
  2755.    }
  2756.  
  2757. /*
  2758.  * spcl_dcls - print special declarations for tended variables, parameter
  2759.  *  conversions, and buffers.
  2760.  */
  2761. void spcl_dcls(op_params)
  2762. struct sym_entry *op_params; /* operation parameters or NULL */
  2763.    {
  2764.    register struct sym_entry *sym;
  2765.    struct sym_entry *sym1;
  2766.  
  2767.    /*
  2768.     * Output declarations for buffers and locations to hold conversions
  2769.     *  to C values.
  2770.     */
  2771.    spcl_start(op_params);
  2772.  
  2773.    /*
  2774.     * Determine if this operation takes a variable number of arguments.
  2775.     *  Use that information in deciding how large a tended array to
  2776.     *  declare.
  2777.     */
  2778.    varargs = (op_params != NULL && op_params->id_type & VarPrm);
  2779.    if (varargs)
  2780.       tend_ary(ntend + VArgAlwnc - 1);
  2781.    else
  2782.       tend_ary(ntend);
  2783.  
  2784.    if (varargs) {
  2785.       /*
  2786.        * This operation takes a variable number of arguments. A declaration
  2787.        *  for a tended array has been made that will usually hold them, but
  2788.        *  sometimes it is necessary to malloc() a tended array at run
  2789.        *  time. Produce code to check for this.
  2790.        */
  2791.       cur_impl->ret_flag |= DoesEFail;  /* error conversion from allocation */
  2792.       prt_str("struct tend_desc *r_tendp;", IndentInc);
  2793.       ForceNl();
  2794.       prt_str("int r_n;\n", IndentInc);
  2795.       ++line;
  2796.       ForceNl();
  2797.       prt_str("if (r_nargs <= ", IndentInc);
  2798.       fprintf(out_file, "%d)", op_params->u.param_info.param_num + VArgAlwnc);
  2799.       ForceNl();
  2800.       prt_str("r_tendp = (struct tend_desc *)&r_tend;", 2 * IndentInc);
  2801.       ForceNl();
  2802.       prt_str("else {", IndentInc);
  2803.       ForceNl();
  2804.       prt_str(
  2805.        "r_tendp = (struct tend_desc *)malloc((sizeof(struct tend_desc)",
  2806.          2 * IndentInc);
  2807.       ForceNl();
  2808.       prt_str("", 3 * IndentInc);
  2809.       fprintf(out_file, "+ (r_nargs + %d) * sizeof(struct descrip)));",
  2810.          ntend - 2 - op_params->u.param_info.param_num);
  2811.       ForceNl();
  2812.       prt_str("if (r_tendp == NULL) {", 2 * IndentInc);
  2813.       ForceNl();
  2814.       prt_str("err_msg(305, NULL);", 3 * IndentInc);
  2815.       ForceNl();
  2816.       prt_str("return A_Resume;", 3 * IndentInc);
  2817.       ForceNl();
  2818.       prt_str("}", 3 * IndentInc);
  2819.       ForceNl();
  2820.       prt_str("}", 2 * IndentInc);
  2821.       ForceNl();
  2822.       tendstrct = "(*r_tendp)";
  2823.       }
  2824.    else
  2825.       tendstrct = "r_tend";
  2826.  
  2827.    /*
  2828.     * Produce code to initialize the tended array. These are for tended
  2829.     *  declarations and parameters.
  2830.     */
  2831.    tend_init();  /* initializations for tended declarations. */
  2832.    if (varargs) {
  2833.       /*
  2834.        * This operation takes a variable number of arguments. Produce code
  2835.        *  to dereference or copy this into its portion of the tended
  2836.        *  array.
  2837.        */
  2838.       prt_str("for (r_n = ", IndentInc);
  2839.       fprintf(out_file, "%d; r_n < r_nargs; ++r_n)",
  2840.           op_params->u.param_info.param_num);
  2841.       ForceNl();
  2842.       if (op_params->id_type & DrfPrm) {
  2843.          prt_str("deref(&r_args[r_n], &", IndentInc * 2);
  2844.          fprintf(out_file, "%s.d[r_n + %d]);", tendstrct, ntend - 1 -
  2845.             op_params->u.param_info.param_num);
  2846.          }
  2847.       else {
  2848.          prt_str(tendstrct, IndentInc * 2);
  2849.          fprintf(out_file, ".d[r_n + %d] = r_args[r_n];", ntend - 1 -
  2850.             op_params->u.param_info.param_num);
  2851.          }
  2852.       ForceNl();
  2853.       sym = op_params->u.param_info.next;
  2854.       }
  2855.    else
  2856.       sym = op_params; /* no variable part of arg list */
  2857.  
  2858.    /*
  2859.     * Go through the fixed part of the parameter list, producing code
  2860.     *  to copy/dereference parameters into the tended array.
  2861.     */
  2862.    while (sym != NULL) {
  2863.       /*
  2864.        * A there may be identifiers for dereferenced and/or undereferenced
  2865.        *  versions of a paramater. If there are both, sym1 references the
  2866.        *  second identifier.
  2867.        */
  2868.       sym1 = sym->u.param_info.next;
  2869.       if (sym1 != NULL && sym->u.param_info.param_num !=
  2870.          sym1->u.param_info.param_num)
  2871.             sym1 = NULL;    /* the next entry is not for the same parameter */
  2872.  
  2873.       /*
  2874.        * If there are not enough arguments to supply a value for this
  2875.        *  parameter, set it to the null value.
  2876.        */
  2877.       prt_str("if (", IndentInc);
  2878.       fprintf(out_file, "r_nargs > %d) {", sym->u.param_info.param_num);
  2879.       ForceNl();
  2880.       parm_tnd(sym);
  2881.       if (sym1 != NULL) {
  2882.          ForceNl();
  2883.          parm_tnd(sym1);
  2884.          }
  2885.       ForceNl();
  2886.       prt_str("} else {", IndentInc);
  2887.       ForceNl();
  2888.       prt_str(tendstrct, IndentInc * 2);
  2889.       fprintf(out_file, ".d[%d].dword = D_Null;", sym->t_indx);
  2890.       if (sym1 != NULL) {
  2891.          ForceNl();
  2892.          prt_str(tendstrct, IndentInc * 2);
  2893.          fprintf(out_file, ".d[%d].dword = D_Null;", sym1->t_indx);
  2894.          }
  2895.       ForceNl();
  2896.       prt_str("}", 2 * IndentInc);
  2897.       ForceNl();
  2898.       if (sym1 == NULL)
  2899.          sym = sym->u.param_info.next;
  2900.       else
  2901.          sym = sym1->u.param_info.next;
  2902.       }
  2903.  
  2904.    /*
  2905.     * Finish setting up the tended array structure and link it into the tended
  2906.     *  list.
  2907.     */
  2908.    if (ntend != 0) {
  2909.       prt_str(tendstrct, IndentInc);
  2910.       if (varargs)
  2911.          fprintf(out_file, ".num = %d + Max(r_nargs - %d, 0);", ntend - 1,
  2912.             op_params->u.param_info.param_num);
  2913.       else
  2914.          fprintf(out_file, ".num = %d;", ntend);
  2915.       ForceNl();
  2916.       prt_str(tendstrct, IndentInc);
  2917.       prt_str(".previous = tend;", IndentInc);
  2918.       ForceNl();
  2919.       prt_str("tend = (struct tend_desc *)&", IndentInc);
  2920.       fprintf(out_file, "%s;", tendstrct);
  2921.       ForceNl();
  2922.       }
  2923.    }
  2924.  
  2925. /*
  2926.  * spcl_start - do initial work for outputing special declarations. Output
  2927.  *  declarations for buffers and locations to hold conversions to C values.
  2928.  *  Determine what tended locations are needed for parameters.
  2929.  */
  2930. static void spcl_start(op_params)
  2931. struct sym_entry *op_params;
  2932.    {
  2933.    ForceNl();
  2934.    if (n_tmp_str > 0) {
  2935.       prt_str("char r_sbuf[", IndentInc);
  2936.       fprintf(out_file, "%d][MaxCvtLen];", n_tmp_str);
  2937.       ForceNl();
  2938.       }
  2939.    if (n_tmp_cset > 0) {
  2940.       prt_str("struct b_cset r_cbuf[", IndentInc);
  2941.       fprintf(out_file, "%d];", n_tmp_cset);
  2942.       ForceNl();
  2943.       }
  2944.    if (tend_lst == NULL)
  2945.       ntend = 0;
  2946.    else
  2947.       ntend = tend_lst->t_indx + 1;
  2948.    parm_locs(op_params); /* see what parameter conversion there are */
  2949.    }
  2950.  
  2951. /*
  2952.  * tend_ary - write struct containing array of tended descriptors.
  2953.  */
  2954. static void tend_ary(n)
  2955. int n;
  2956.    {
  2957.    if (n == 0)
  2958.       return;
  2959.    prt_str("struct {", IndentInc);
  2960.    ForceNl();
  2961.    prt_str("struct tend_desc *previous;", 2 * IndentInc);
  2962.    ForceNl();
  2963.    prt_str("int num;", 2 * IndentInc);
  2964.    ForceNl();
  2965.    prt_str("struct descrip d[", 2 * IndentInc);
  2966.    fprintf(out_file, "%d];", n);
  2967.    ForceNl();
  2968.    prt_str("} r_tend;\n", 2 * IndentInc);
  2969.    ++line;
  2970.    ForceNl();
  2971.    }
  2972.  
  2973. /*
  2974.  * tend_init - produce code to initialize entries in the tended array
  2975.  *  corresponding to tended declarations. Default initializations are
  2976.  *  supplied when there is none in the declaration.
  2977.  */
  2978. static void tend_init()
  2979.    {
  2980.    register struct init_tend *tnd;
  2981.  
  2982.    for (tnd = tend_lst; tnd != NULL; tnd = tnd->next) {
  2983.       switch (tnd->init_typ) {
  2984.          case TndDesc:
  2985.             /*
  2986.              * Simple tended declaration.
  2987.              */
  2988.             prt_str(tendstrct, IndentInc);
  2989.             if (tnd->init == NULL)
  2990.                fprintf(out_file, ".d[%d].dword = D_Null;", tnd->t_indx);
  2991.             else {
  2992.                fprintf(out_file, ".d[%d] = ", tnd->t_indx);
  2993.                c_walk(tnd->init, 2 * IndentInc, 0);
  2994.                prt_str(";", 2 * IndentInc);
  2995.                }
  2996.             break;
  2997.          case TndStr:
  2998.             /*
  2999.              * Tended character pointer.
  3000.              */
  3001.             prt_str(tendstrct, IndentInc);
  3002.             if (tnd->init == NULL)
  3003.                fprintf(out_file, ".d[%d] = emptystr;", tnd->t_indx);
  3004.             else {
  3005.                fprintf(out_file, ".d[%d].dword = 0;", tnd->t_indx);
  3006.                ForceNl();
  3007.                prt_str(tendstrct, IndentInc);
  3008.                fprintf(out_file, ".d[%d].vword.sptr = ", tnd->t_indx);
  3009.                c_walk(tnd->init, 2 * IndentInc, 0);
  3010.                prt_str(";", 2 * IndentInc);
  3011.                }
  3012.             break;
  3013.          case TndBlk:
  3014.             /*
  3015.              * A tended block pointer of some kind.
  3016.              */
  3017.             prt_str(tendstrct, IndentInc);
  3018.             if (tnd->init == NULL)
  3019.                fprintf(out_file, ".d[%d] = nullptr;", tnd->t_indx);
  3020.             else {
  3021.                fprintf(out_file, ".d[%d].dword = F_Ptr | F_Nqual;",tnd->t_indx);
  3022.                ForceNl();
  3023.                prt_str(tendstrct, IndentInc);
  3024.                fprintf(out_file, ".d[%d].vword.bptr = (union block *)",
  3025.                    tnd->t_indx);
  3026.                c_walk(tnd->init, 2 * IndentInc, 0);
  3027.                prt_str(";", 2 * IndentInc);
  3028.                }
  3029.             break;
  3030.          }
  3031.       ForceNl();
  3032.       }
  3033.    }
  3034.  
  3035. /*
  3036.  * parm_tnd - produce code to put a parameter in its tended location.
  3037.  */
  3038. static void parm_tnd(sym)
  3039. struct sym_entry *sym;
  3040.    {
  3041.    /*
  3042.     * A parameter may either be dereferenced into its tended location
  3043.     *  or copied.
  3044.     */
  3045.    if (sym->id_type & DrfPrm) {
  3046.       prt_str("deref(&r_args[", IndentInc * 2);
  3047.       fprintf(out_file, "%d], &%s.d[%d]);", sym->u.param_info.param_num,
  3048.          tendstrct, sym->t_indx);
  3049.       }
  3050.    else {
  3051.       prt_str(tendstrct, IndentInc * 2);
  3052.       fprintf(out_file, ".d[%d] = r_args[%d];", sym->t_indx,
  3053.          sym->u.param_info.param_num);
  3054.       }
  3055.    }
  3056.  
  3057. /*
  3058.  * parm_locs - determine what locations are needed to hold parameters and
  3059.  *  their conversions. Produce declarations for the C_integer and C_double
  3060.  *  locations.
  3061.  */
  3062. static void parm_locs(op_params)
  3063. struct sym_entry *op_params;
  3064.    {
  3065.    struct sym_entry *next_parm;
  3066.  
  3067.    /*
  3068.     * Parameters are stored in reverse order: Recurse down the list
  3069.     *  and perform processing on the way back.
  3070.     */
  3071.    if (op_params == NULL)
  3072.       return;
  3073.    next_parm = op_params->u.param_info.next;
  3074.    parm_locs(next_parm);
  3075.  
  3076.    /*
  3077.     * For interpreter routines, extra tended descriptors are only needed
  3078.     *  when both dereferenced and undereferenced values are requested.
  3079.     */
  3080.    if (iconx_flg && (next_parm == NULL ||
  3081.       op_params->u.param_info.param_num != next_parm->u.param_info.param_num))
  3082.       op_params->t_indx = -1;
  3083.    else
  3084.       op_params->t_indx = ntend++;
  3085.    if (op_params->u.param_info.non_tend & PrmInt) {
  3086.       prt_str("C_integer r_i", IndentInc);
  3087.       fprintf(out_file, "%d;", op_params->u.param_info.param_num);
  3088.       ForceNl();
  3089.       }
  3090.    if (op_params->u.param_info.non_tend & PrmDbl) {
  3091.       prt_str("double r_d", IndentInc);
  3092.       fprintf(out_file, "%d;", op_params->u.param_info.param_num);
  3093.       ForceNl();
  3094.       }
  3095.    }
  3096.  
  3097. /*
  3098.  * real_def - see if a declaration really defines storage.
  3099.  */
  3100. static int real_def(n)
  3101. struct node *n;
  3102.    {
  3103.    struct node *dcl_lst;
  3104.  
  3105.    dcl_lst = n->u[1].child;
  3106.    /*
  3107.     * If no variables are being defined this must be a tag declaration.
  3108.     */
  3109.    if (dcl_lst == NULL)
  3110.       return 0;
  3111.  
  3112.    if (only_proto(dcl_lst))
  3113.       return 0;
  3114.  
  3115.    if (tdef_or_extr(n->u[0].child))
  3116.       return 0;
  3117.  
  3118.    return 1;
  3119.    }
  3120.  
  3121. /*
  3122.  * only_proto - see if this declarator list contains only function prototypes.
  3123.  */
  3124. static int only_proto(n)
  3125. struct node *n;
  3126.    {
  3127.    switch (n->nd_id) {
  3128.       case CommaNd:
  3129.          return only_proto(n->u[0].child) & only_proto(n->u[1].child);
  3130.       case ConCatNd:
  3131.          /*
  3132.           * Optional pointer.
  3133.           */
  3134.          return only_proto(n->u[1].child);
  3135.       case BinryNd:
  3136.          switch (n->tok->tok_id) {
  3137.             case '=':
  3138.                return only_proto(n->u[0].child);
  3139.             case '[':
  3140.                /*
  3141.                 * At this point, assume array declarator is not part of
  3142.                 *  prototype.
  3143.                 */
  3144.                return 0;
  3145.             case ')':
  3146.                /*
  3147.                 * Prototype (or forward declaration).
  3148.                 */
  3149.                return 1;
  3150.             }
  3151.       case PrefxNd:
  3152.          /*
  3153.           * Parenthesized.
  3154.           */
  3155.          return only_proto(n->u[0].child);
  3156.       case PrimryNd:
  3157.          /*
  3158.           * At this point, assume it is not a prototype.
  3159.           */
  3160.          return 0;
  3161.       }
  3162.    err1("rtt internal error detected in function only_proto()");
  3163.    /*NOTREACHED*/
  3164.    return 0;  /* avoid gcc warning */
  3165.    }
  3166.  
  3167. /*
  3168.  * tdef_or_extr - see if this is a typedef or extern.
  3169.  */
  3170. static int tdef_or_extr(n)
  3171. struct node *n;
  3172.    {
  3173.    switch (n->nd_id) {
  3174.       case LstNd:
  3175.          return tdef_or_extr(n->u[0].child) | tdef_or_extr(n->u[1].child);
  3176.       case BinryNd:
  3177.          /*
  3178.           * struct, union, or enum.
  3179.           */
  3180.          return 0;
  3181.       case PrimryNd:
  3182.          if (n->tok->tok_id == Extern || n->tok->tok_id == Typedef)
  3183.             return 1;
  3184.          else
  3185.             return 0;
  3186.       }
  3187.    err1("rtt internal error detected in function tdef_or_extr()");
  3188.    /*NOTREACHED*/
  3189.    return 0;  /* avoid gcc warning */
  3190.    }
  3191.  
  3192. /*
  3193.  * dclout - output an ordinary global C declaration.
  3194.  */
  3195. void dclout(n)
  3196. struct node *n;
  3197.    {
  3198.    if (!enable_out)
  3199.       return;        /* output disabled */
  3200.    if (real_def(n))
  3201.       def_fnd = 1;   /* this declaration defines a run-time object */
  3202.    c_walk(n, 0, 0);
  3203.    free_tree(n);
  3204.    }
  3205.  
  3206. /*
  3207.  * fncout - output code for a C function.
  3208.  */
  3209. void fncout(head, prm_dcl, block)
  3210. struct node *head;
  3211. struct node *prm_dcl;
  3212. struct node *block;
  3213.    {
  3214.    if (!enable_out)
  3215.       return;       /* output disabled */
  3216.  
  3217.    def_fnd = 1;     /* this declaration defines a run-time object */
  3218.  
  3219.    nxt_sbuf = 0;    /* clear number of string buffers */
  3220.    nxt_cbuf = 0;    /* clear number of cset buffers */
  3221.  
  3222.    /*
  3223.     * Output the function header and the parameter declarations.
  3224.     */
  3225.    fnc_head = head;
  3226.    c_walk(head, 0, 0);
  3227.    prt_str(" ",  0);
  3228.    c_walk(prm_dcl, 0, 0);
  3229.    prt_str(" ", 0);
  3230.  
  3231.    /*
  3232.     * Handle outer block.
  3233.     */
  3234.    prt_tok(block->tok, IndentInc);          /* { */
  3235.    c_walk(block->u[0].child, IndentInc, 0); /* non-tended declarations */
  3236.    spcl_dcls(NULL);                         /* tended declarations */
  3237.    no_ret_val = 1;
  3238.    c_walk(block->u[2].child, IndentInc, 0); /* statement list */
  3239.    if (ntend != 0 && no_ret_val) {
  3240.       /*
  3241.        * This function contains no return statements with values, assume
  3242.        *  that the programmer is using the implicit return at the end
  3243.        *  of the function and update the tending of descriptors.
  3244.        */
  3245.       untend(IndentInc);
  3246.       }
  3247.    ForceNl();
  3248.    prt_str("}", IndentInc);
  3249.    ForceNl();
  3250.  
  3251.    /*
  3252.     * free storage.
  3253.     */
  3254.    free_tree(head);
  3255.    free_tree(prm_dcl);
  3256.    free_tree(block);
  3257.    pop_cntxt();
  3258.    clr_def();
  3259.    }
  3260.  
  3261. /*
  3262.  * defout - output operation definitions (except for constant keywords)
  3263.  */
  3264. void defout(n)
  3265. struct node *n;
  3266.    {
  3267.    struct sym_entry *sym, *sym1;
  3268.  
  3269.    if (!enable_out)
  3270.       return;       /* output disabled */
  3271.  
  3272.    nxt_sbuf = 0;
  3273.    nxt_cbuf = 0;
  3274.  
  3275.    /*
  3276.     * Somewhat different code is produced for the interpreter and compiler.
  3277.     */
  3278.    if (iconx_flg)
  3279.       interp_def(n);
  3280.    else
  3281.       comp_def(n);
  3282.  
  3283.    free_tree(n);
  3284.    /*
  3285.     * The declarations for the declare statement are not associated with
  3286.     *  any compound statement and must be freed here.
  3287.     */
  3288.    sym = dcl_stk->tended;
  3289.    while (sym != NULL) {
  3290.       sym1 = sym;
  3291.       sym = sym->u.tnd_var.next;
  3292.       free_sym(sym1);
  3293.       }
  3294.    while (decl_lst != NULL) {
  3295.       sym1 = decl_lst;
  3296.       decl_lst = decl_lst->u.declare_var.next;
  3297.       free_sym(sym1);
  3298.       }
  3299.    op_type = OrdFunc;
  3300.    pop_cntxt();
  3301.    clr_def();
  3302.    }
  3303.  
  3304. /*
  3305.  * comp_def - output code for the compiler for operation definitions.
  3306.  */
  3307. static void comp_def(n)
  3308. struct node *n;
  3309.    {
  3310. #ifdef Rttx
  3311.    fprintf(stdout, "rtt was compiled to only support the interpreter, use -x\n");
  3312.    exit(EXIT_FAILURE);
  3313. #else                    /* Rttx */
  3314.    struct sym_entry *sym;
  3315.    struct node *n1;
  3316.    FILE *f_save;
  3317.  
  3318.    char buf1[5];
  3319.    char buf[MaxFileName];
  3320.    char *cname;
  3321.    long min_result;
  3322.    long max_result;
  3323.    int ret_flag;
  3324.    int resume;
  3325.    char *name;
  3326.    char *s;
  3327.  
  3328.    f_save = out_file;
  3329.  
  3330.    /*
  3331.     * Note if the result location is explicitly referenced and note
  3332.     *  how it is accessed in the generated code.
  3333.     */
  3334.    cur_impl->use_rslt = sym_lkup(str_rslt)->u.referenced;
  3335.    rslt_loc = "(*r_rslt)";
  3336.  
  3337.    /*
  3338.     * In several contexts, letters are used to distinguish kinds of operations.
  3339.     */
  3340.    switch (op_type) {
  3341.       case TokFunction:
  3342.          lc_letter = 'f';
  3343.          uc_letter = 'F';
  3344.          break;
  3345.       case Keyword:
  3346.          lc_letter = 'k';
  3347.          uc_letter = 'K';
  3348.          break;
  3349.       case Operator:
  3350.          lc_letter = 'o';
  3351.          uc_letter = 'O';
  3352.       }
  3353.    prfx1 = cur_impl->prefix[0];
  3354.    prfx2 = cur_impl->prefix[1];
  3355.  
  3356.    if (op_type != Keyword) {
  3357.       /*
  3358.        * First pass through the operation: produce most general routine.
  3359.        */
  3360.       fnc_ret = RetSig;  /* most general routine always returns a signal */
  3361.  
  3362.       /*
  3363.        * Compute the file name in which to output the function.
  3364.        */
  3365.       sprintf(buf1, "%c_%c%c", lc_letter, prfx1, prfx2);
  3366.       cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
  3367.       if ((out_file = fopen(cname, "w")) == NULL)
  3368.          err2("cannot open output file", cname);
  3369.       else
  3370.          addrmlst(cname, out_file);
  3371.  
  3372.       prologue(); /* output standard comments and preprocessor directives */
  3373.  
  3374.       /*
  3375.        * Output function header that corresponds to standard calling
  3376.        *  convensions. The function name is constructed from the letter
  3377.        *  for the operation type, the prefix that makes the function
  3378.        *  name unique, and the name of the operation.
  3379.        */
  3380.       fprintf(out_file, "int %c%c%c_%s(r_nargs, r_args, r_rslt, r_s_cont)\n",
  3381.          uc_letter, prfx1, prfx2, cur_impl->name);
  3382.       fprintf(out_file, "int r_nargs;\n");
  3383.       fprintf(out_file, "dptr r_args;\n");
  3384.       fprintf(out_file, "dptr r_rslt;\n");
  3385.       fprintf(out_file, "continuation r_s_cont;");
  3386.       fname = cname;
  3387.       line = 12;
  3388.       ForceNl();
  3389.       prt_str("{", IndentInc);
  3390.       ForceNl();
  3391.  
  3392.       /*
  3393.        * Output ordinary declarations from declare clause.
  3394.        */
  3395.       for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  3396.          c_walk(sym->u.declare_var.tqual, IndentInc, 0);
  3397.          prt_str(" ", IndentInc);
  3398.          c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
  3399.          if ((n1 = sym->u.declare_var.init) != NULL) {
  3400.             prt_str(" = ", IndentInc);
  3401.             c_walk(n1, IndentInc, 0);
  3402.             }
  3403.          prt_str(";", IndentInc);
  3404.          }
  3405.  
  3406.       /*
  3407.        * Output code for special declarations along with code to initial
  3408.        *  them. This includes buffers and tended locations for parameters
  3409.        *  and tended variables.
  3410.        */
  3411.       spcl_dcls(params);
  3412.  
  3413.       if (rt_walk(n, IndentInc, 0)) {  /* body of operation */
  3414.          if (n->nd_id == ConCatNd)
  3415.             s = n->u[1].child->tok->fname;
  3416.          else
  3417.             s = n->tok->fname;
  3418.          fprintf(stderr, "%s: file %s, warning: ", progname, s);
  3419.          fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
  3420.              cur_impl->name);
  3421.          }
  3422.  
  3423.       ForceNl();
  3424.       prt_str("}\n", IndentInc);
  3425.       if (fclose(out_file) != 0)
  3426.          err2("cannot close ", cname);
  3427.       put_c_fl(cname, 1);  /* note name of output file for operation */
  3428.       }
  3429.  
  3430.    /*
  3431.     * Second pass through operation: produce in-line code and special purpose
  3432.     *  routines.
  3433.     */
  3434.    for (sym = params; sym != NULL; sym = sym->u.param_info.next)
  3435.       if (sym->id_type & DrfPrm)
  3436.          sym->u.param_info.cur_loc = PrmTend;  /* reset location of parameter */
  3437.    in_line(n);
  3438.  
  3439.    /*
  3440.     * Insure that the fail/return/suspend statements are consistent
  3441.     *  with the result sequence indicated.
  3442.     */
  3443.    min_result = cur_impl->min_result;
  3444.    max_result = cur_impl->max_result;
  3445.    ret_flag = cur_impl->ret_flag;
  3446.    resume = cur_impl->resume;
  3447.    name = cur_impl->name;
  3448.    if (min_result == NoRsltSeq && ret_flag & (DoesFail|DoesRet|DoesSusp))
  3449.       err2(name,
  3450.          ": result sequence of {}, but fail, return, or suspend present");
  3451.    if (min_result != NoRsltSeq && ret_flag == 0)
  3452.       err2(name,
  3453.          ": result sequence indicated, no fail, return, or suspend present");
  3454.    if (max_result != NoRsltSeq) {
  3455.       if (max_result == 0 && ret_flag & (DoesRet|DoesSusp))
  3456.          err2(name,
  3457.             ": result sequence of 0 length, but return or suspend present");
  3458.       if (max_result != 0 && !(ret_flag & (DoesRet | DoesSusp)))
  3459.          err2(name,
  3460.             ": result sequence length > 0, but no return or suspend present");
  3461.       if ((max_result == UnbndSeq || max_result > 1 || resume) &&
  3462.          !(ret_flag & DoesSusp))
  3463.          err2(name,
  3464.             ": result sequence indicates suspension, but no suspend present");
  3465.       if ((max_result != UnbndSeq && max_result <= 1 && !resume) &&
  3466.          ret_flag & DoesSusp)
  3467.          err2(name,
  3468.             ": result sequence indicates no suspension, but suspend present");
  3469.       }
  3470.    if (min_result != NoRsltSeq && max_result != UnbndSeq &&
  3471.       min_result > max_result)
  3472.       err2(name, ": minimum result sequence length greater than maximum");
  3473.  
  3474.    out_file = f_save;
  3475. #endif                    /* Rttx */
  3476.    }
  3477.  
  3478. /*
  3479.  * interp_def - output code for the interpreter for operation definitions.
  3480.  */
  3481. static void interp_def(n)
  3482. struct node *n;
  3483.    {
  3484.    struct sym_entry *sym;
  3485.    struct node *n1;
  3486.    int nparms;
  3487.    int has_underef;
  3488.    char letter;
  3489.    char *name;
  3490.    char *s;
  3491.  
  3492.    /*
  3493.     * Note how result location is accessed in generated code.
  3494.     */
  3495.    rslt_loc = "r_args[0]";
  3496.  
  3497.    /*
  3498.     * Determine if the operation has any undereferenced parameters.
  3499.     */
  3500.    has_underef = 0;
  3501.    for (sym = params; sym != NULL; sym = sym->u.param_info.next)
  3502.       if (sym->id_type  & RtParm) {
  3503.          has_underef = 1;
  3504.          break;
  3505.          }
  3506.  
  3507.    /*
  3508.     * Determine the nuber of parameters. A negative value is used
  3509.     *  to indicate an operation that takes a variable number of
  3510.     *  arguments.
  3511.     */
  3512.    if (params == NULL)
  3513.       nparms = 0;
  3514.    else {
  3515.       nparms = params->u.param_info.param_num + 1;
  3516.       if (params->id_type & VarPrm)
  3517.          nparms = -nparms;
  3518.       }
  3519.  
  3520.    fnc_ret = RetSig;  /* interpreter routine always returns a signal */
  3521.    name = cur_impl->name;
  3522.  
  3523.    /*
  3524.     * Determine what letter is used to prefix the operation name.
  3525.     */
  3526.    switch (op_type) {
  3527.       case TokFunction:
  3528.  
  3529. #if VMS
  3530.          letter = 'Y';
  3531. #else                    /* VMS */
  3532.          letter = 'Z';
  3533. #endif                    /* VMS */
  3534.  
  3535.          break;
  3536.       case Keyword:
  3537.          letter = 'K';
  3538.          break;
  3539.       case Operator:
  3540.          letter = 'O';
  3541.          }
  3542.  
  3543.    fprintf(out_file, "\n");
  3544.    if (op_type != Keyword) {
  3545.       /*
  3546.        * Output prototype. Operations taking a variable number of arguments
  3547.        *   have an extra parameter: the number of arguments.
  3548.        */
  3549.       fprintf(out_file, "int %c%s (", letter, name);
  3550.       if (params != NULL && (params->id_type & VarPrm))
  3551.          fprintf(out_file, "int r_nargs, ");
  3552.       fprintf(out_file, "dptr r_args);\n");
  3553.       ++line;
  3554.  
  3555.       /*
  3556.        * Output procedure block.
  3557.        */
  3558.       switch (op_type) {
  3559.          case TokFunction:
  3560.             fprintf(out_file, "FncBlock(%s, %d, %d)\n\n", name, nparms,
  3561.                (has_underef ? -1 : 0));
  3562.             ++line;
  3563.             break;
  3564.          case Operator:
  3565.             if (strcmp(cur_impl->op,"\\") == 0)
  3566.                fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
  3567.                   "\\\\");
  3568.             else
  3569.                fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
  3570.                   cur_impl->op);
  3571.             ++line;
  3572.          }
  3573.       }
  3574.  
  3575.    /*
  3576.     * Output function header. Operations taking a variable number of arguments
  3577.     *   have an extra parameter: the number of arguments.
  3578.     */
  3579.    fprintf(out_file, "int %c%s(", letter, name);
  3580.    if (params != NULL && (params->id_type & VarPrm))
  3581.       fprintf(out_file, "r_nargs, ");
  3582.    fprintf(out_file, "r_args)\n");
  3583.    ++line;
  3584.    if (params != NULL && (params->id_type & VarPrm)) {
  3585.       fprintf(out_file, "int r_nargs;\n");
  3586.       ++line;
  3587.       }
  3588.    fprintf(out_file, "dptr r_args;");
  3589.    ++line;
  3590.    ForceNl();
  3591.    prt_str("{", IndentInc);
  3592.  
  3593.    /*
  3594.     * Output ordinary declarations from the declare clause.
  3595.     */
  3596.    ForceNl();
  3597.    for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  3598.       c_walk(sym->u.declare_var.tqual, IndentInc, 0);
  3599.       prt_str(" ", IndentInc);
  3600.       c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
  3601.       if ((n1 = sym->u.declare_var.init) != NULL) {
  3602.          prt_str(" = ", IndentInc);
  3603.          c_walk(n1, IndentInc, 0);
  3604.          }
  3605.       prt_str(";", IndentInc);
  3606.       }
  3607.  
  3608.    /*
  3609.     * Output special declarations and initial processing.
  3610.     */
  3611.    tendstrct = "r_tend";
  3612.    spcl_start(params);
  3613.    tend_ary(ntend);
  3614.    if (has_underef && params != NULL && params->id_type == (VarPrm | DrfPrm))
  3615.       prt_str("int r_n;\n", IndentInc);
  3616.    tend_init();
  3617.  
  3618.    /*
  3619.     * See which parameters need to be dereferenced. If all are dereferenced,
  3620.     *  it is done by before the routine is called.
  3621.     */
  3622.    if (has_underef) {
  3623.       sym = params;
  3624.       if (sym != NULL && sym->id_type & VarPrm) {
  3625.          if (sym->id_type & DrfPrm) {
  3626.             /*
  3627.              * There is a variable part of the parameter list and it
  3628.              *  must be dereferenced.
  3629.              */
  3630.             prt_str("for (r_n = ", IndentInc);
  3631.             fprintf(out_file, "%d; r_n <= r_nargs; ++r_n)",
  3632.                 sym->u.param_info.param_num + 1);
  3633.             ForceNl();
  3634.             prt_str("Deref(r_args[r_n]);", IndentInc * 2);
  3635.             ForceNl();
  3636.             }
  3637.          sym = sym->u.param_info.next;
  3638.          }
  3639.  
  3640.       /*
  3641.        * Produce code to dereference any fixed parameters that need to be.
  3642.        */
  3643.       while (sym != NULL) {
  3644.          if (sym->id_type & DrfPrm) {
  3645.             /*
  3646.              * Tended index of -1 indicates that the parameter can be
  3647.              *  dereferened in-place (this is the usual case).
  3648.              */
  3649.             if (sym->t_indx == -1) {
  3650.                prt_str("Deref(r_args[", IndentInc * 2);
  3651.                fprintf(out_file, "%d]);", sym->u.param_info.param_num + 1);
  3652.                }
  3653.             else {
  3654.                prt_str("deref(&r_args[", IndentInc * 2);
  3655.                fprintf(out_file, "%d], &r_tend.d[%d]);",
  3656.                   sym->u.param_info.param_num + 1, sym->t_indx);
  3657.                }
  3658.             }
  3659.          ForceNl();
  3660.          sym = sym->u.param_info.next;
  3661.          }
  3662.       }
  3663.  
  3664.    /*
  3665.     * Finish setting up the tended array structure and link it into the tended
  3666.     *  list.
  3667.     */
  3668.    if (ntend != 0) {
  3669.       prt_str("r_tend.num = ", IndentInc);
  3670.       fprintf(out_file, "%d;", ntend);
  3671.       ForceNl();
  3672.       prt_str("r_tend.previous = tend;", IndentInc);
  3673.       ForceNl();
  3674.       prt_str("tend = (struct tend_desc *)&r_tend;", IndentInc);
  3675.       ForceNl();
  3676.       }
  3677.  
  3678.    if (rt_walk(n, IndentInc, 0)) { /* body of operation */
  3679.       if (n->nd_id == ConCatNd)
  3680.          s = n->u[1].child->tok->fname;
  3681.       else
  3682.          s = n->tok->fname;
  3683.       fprintf(stderr, "%s: file %s, warning: ", progname, s);
  3684.       fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
  3685.           cur_impl->name);
  3686.       }
  3687.    ForceNl();
  3688.    prt_str("}\n", IndentInc);
  3689.    }
  3690.  
  3691. /*
  3692.  * keyconst - produce code for a constant keyword.
  3693.  */
  3694. void keyconst(t)
  3695. struct token *t;
  3696.    {
  3697.    struct il_code *il;
  3698.    int n;
  3699.  
  3700.    if (iconx_flg) {
  3701.       /*
  3702.        * For the interpreter, output a C function implementing the keyword.
  3703.        */
  3704.       rslt_loc = "r_args[0]";  /* result location */
  3705.  
  3706.       fprintf(out_file, "\n");
  3707.       fprintf(out_file, "int K%s(r_args)\n", cur_impl->name);
  3708.       fprintf(out_file, "dptr r_args;");
  3709.       line += 2;
  3710.       ForceNl();
  3711.       prt_str("{", IndentInc);
  3712.       ForceNl();
  3713.       switch (t->tok_id) {
  3714.          case StrLit:
  3715.             prt_str(rslt_loc, IndentInc);
  3716.             prt_str(".vword.sptr = \"", IndentInc);
  3717.             n = prt_i_str(out_file, t->image, (int)strlen(t->image));
  3718.             prt_str("\";", IndentInc);
  3719.             ForceNl();
  3720.             prt_str(rslt_loc, IndentInc);
  3721.             fprintf(out_file, ".dword = %d;", n);
  3722.             break;
  3723.          case CharConst:
  3724.             prt_str("static struct b_cset cset_blk = ", IndentInc);
  3725.             cset_init(out_file, bitvect(t->image, (int)strlen(t->image)));
  3726.             ForceNl();
  3727.             prt_str(rslt_loc, IndentInc);
  3728.             prt_str(".dword = D_Cset;", IndentInc);
  3729.             ForceNl();
  3730.             prt_str(rslt_loc, IndentInc);
  3731.             prt_str(".vword.bptr = (union block *)&cset_blk;", IndentInc);
  3732.             break;
  3733.          case DblConst:
  3734.             prt_str("static struct b_real real_blk = {T_Real, ", IndentInc);
  3735.             fprintf(out_file, "%s};", t->image);
  3736.             ForceNl();
  3737.             prt_str(rslt_loc, IndentInc);
  3738.             prt_str(".dword = D_Real;", IndentInc);
  3739.             ForceNl();
  3740.             prt_str(rslt_loc, IndentInc);
  3741.             prt_str(".vword.bptr = (union block *)&real_blk;", IndentInc);
  3742.             break;
  3743.          case IntConst:
  3744.             prt_str(rslt_loc, IndentInc);
  3745.             prt_str(".dword = D_Integer;", IndentInc);
  3746.             ForceNl();
  3747.             prt_str(rslt_loc, IndentInc);
  3748.             prt_str(".vword.integr = ", IndentInc);
  3749.             prt_str(t->image, IndentInc);
  3750.             prt_str(";", IndentInc);
  3751.             break;
  3752.          }
  3753.       ForceNl();
  3754.       prt_str("return A_Continue;", IndentInc);
  3755.       ForceNl();
  3756.       prt_str("}\n", IndentInc);
  3757.       ++line;
  3758.       ForceNl();
  3759.       }
  3760.    else {
  3761.       /*
  3762.        * For the compiler, make an entry in the data base for the keyword.
  3763.        */
  3764.       cur_impl->use_rslt = 0;
  3765.  
  3766.       il = new_il(IL_Const, 2);
  3767.       switch (t->tok_id) {
  3768.          case StrLit:
  3769.             il->u[0].n = str_typ;
  3770.             il->u[1].s = alloc(strlen(t->image) + 3);
  3771.             sprintf(il->u[1].s, "\"%s\"", t->image);
  3772.             break;
  3773.          case CharConst:
  3774.             il->u[0].n = cset_typ;
  3775.             il->u[1].s = alloc(strlen(t->image) + 3);
  3776.             sprintf(il->u[1].s, "'%s'", t->image);
  3777.             break;
  3778.          case DblConst:
  3779.             il->u[0].n = real_typ;
  3780.             il->u[1].s = t->image;
  3781.             break;
  3782.          case IntConst:
  3783.             il->u[0].n = int_typ;
  3784.             il->u[1].s = t->image;
  3785.             break;
  3786.          }
  3787.       cur_impl->in_line = il;
  3788.       }
  3789.  
  3790.    /*
  3791.     * Reset the translator and free storage.
  3792.     */
  3793.    op_type = OrdFunc;
  3794.    free_t(t);
  3795.    pop_cntxt();
  3796.    clr_def();
  3797.    }
  3798.  
  3799. /*
  3800.  * keepdir - A preprocessor directive to be kept has been encountered.
  3801.  *   If it is #passthru, print just the body of the directive, otherwise
  3802.  *   print the whole thing.
  3803.  */
  3804. void keepdir(t)
  3805. struct token *t;
  3806.    {
  3807.    char *s;
  3808.  
  3809.    tok_line(t, 0);
  3810.    s = t->image;
  3811.    if (strncmp(s, "#passthru", 9) == 0)
  3812.       s = s + 10;
  3813.    fprintf(out_file, "%s\n", s);
  3814.    line += 1;
  3815.    }
  3816.  
  3817. /*
  3818.  * prologue - print standard comments and preprocessor directives at the
  3819.  *   start of an output file.
  3820.  */
  3821. void prologue()
  3822.    {
  3823.    id_comment(out_file);
  3824.    fprintf(out_file, "%s", compiler_def);
  3825.    fprintf(out_file, "#include \"%s\"\n\n", inclname);
  3826.    }
  3827.