home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / rtt / rttout.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  121KB  |  3,843 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. hidden novalue cnv_fnc       Params((struct token *t, int typcd,
  21.                                struct node *src, struct node *dflt,
  22.                                struct node *dest, int indent));
  23. hidden novalue chk_conj      Params((struct node *n));
  24. hidden novalue chk_nl        Params((int indent));
  25. hidden novalue chk_rsltblk   Params((int indent));
  26. hidden novalue comp_def      Params((struct node *n));
  27. hidden int     does_call     Params((struct node *expr));
  28. hidden novalue failure       Params((int indent, int brace));
  29. hidden novalue interp_def    Params((struct node *n));
  30. hidden int     len_sel       Params((struct node *sel,
  31.                                struct parminfo *strt_prms,
  32.                                struct parminfo *end_prms, int indent));
  33. hidden novalue line_dir      Params((int nxt_line, char *new_fname));
  34. hidden int     only_proto    Params((struct node *n));
  35. hidden novalue parm_locs     Params((struct sym_entry *op_params));
  36. hidden novalue parm_tnd      Params((struct sym_entry *sym));
  37. hidden novalue prt_runerr    Params((struct token *t, struct node *num,
  38.                                struct node *val, int indent));
  39. hidden novalue prt_tok       Params((struct token *t, int indent));
  40. hidden novalue prt_var       Params((struct node *n, int indent));
  41. hidden int     real_def      Params((struct node *n));
  42. hidden int     retval_dcltor Params((struct node *dcltor, int indent));
  43. hidden novalue ret_value     Params((struct token *t, struct node *n,
  44.                                int indent));
  45. hidden novalue ret_1_arg     Params((struct token *t, struct node *args,
  46.                                int typcd, char *vwrd_asgn, char *arg_rep,
  47.                                int indent));
  48. hidden int     rt_walk       Params((struct node *n, int indent, int brace));
  49. hidden novalue spcl_start    Params((struct sym_entry *op_params));
  50. hidden int     tdef_or_extr  Params((struct node *n));
  51. hidden novalue tend_ary      Params((int n));
  52. hidden novalue tend_init     Params((noargs));
  53. hidden novalue tnd_var       Params((struct sym_entry *sym, char *strct_ptr, char *access, int indent));
  54. hidden novalue tok_line      Params((struct token *t, int indent));
  55. hidden novalue typ_asrt      Params((int typcd, struct node *desc,
  56.                                struct token *tok, int indent));
  57. hidden int     typ_case      Params((struct node *var, struct node *slct_lst,
  58.                                struct node *dflt,
  59.                                int (*walk)Params((struct node *n, int xindent,
  60.                                  int brace)), int maybe_var, int indent));
  61. hidden novalue untend        Params((int indent));
  62.  
  63. extern char *progname;
  64.  
  65. #if MVS
  66. extern char *src_file_nm;
  67. #endif                                  /* MVS */
  68.  
  69. int op_type = OrdFunc;  /* type of operation */
  70. char lc_letter;         /* f = function, o = operator, k = keyword */
  71. char uc_letter;         /* F = function, O = operator, K = keyword */
  72. char prfx1;             /* 1st char of unique prefix for operation */
  73. char prfx2;             /* 2nd char of unique prefix for operation */
  74. char *fname = "";       /* current source file name */
  75. int line = 0;           /* current source line number */
  76. int nxt_sbuf;           /* next string buffer index */
  77. int nxt_cbuf;           /* next cset buffer index */
  78. int abs_ret = SomeType; /* type from abstract return(s) */
  79.  
  80. int nl = 0;             /* flag indicating the a new-line should be output */
  81. static int no_nl = 0;   /* flag to suppress line directives */
  82.  
  83. static int ntend;       /* number of tended descriptor needed */
  84. static char *tendstrct; /* expression to access struct of tended descriptors */
  85. static char *rslt_loc;  /* expression to access result location */
  86. static int varargs = 0; /* flag: operation takes variable number of arguments */
  87.  
  88. static int no_ret_val;  /* function has return statement with no value */
  89. static struct node *fnc_head; /* header of function being "copied" to output */
  90.  
  91. /*
  92.  * chk_nl - if a new-line is required, output it and indent the next line.
  93.  */
  94. static novalue chk_nl(indent)
  95. int indent;
  96.    {
  97.    int col;
  98.  
  99.    if (nl)  {
  100.       /*
  101.        * new-line required.
  102.        */
  103.       putc('\n', out_file);
  104.       ++line;
  105.       for (col = 0; col < indent; ++col)
  106.          putc(' ', out_file);
  107.       nl = 0;
  108.       }
  109.    }
  110.  
  111. /*
  112.  * line_dir - Output a line directive.
  113.  */
  114. static novalue line_dir(nxt_line, new_fname)
  115. int nxt_line;
  116. char *new_fname;
  117.    {
  118.    char *s;
  119.  
  120.    /*
  121.     * Make sure line directives are desired in the output. Normally,
  122.     *  blank lines surround the directive for readability. However,`
  123.     *  a preceding blank line is suppressed at the beginning of the
  124.     *  output file. In addition, a blank line is suppressed after
  125.     *  the directive if it would force the line number on the directive
  126.     *  to be 0.
  127.     */
  128.    if (line_cntrl) {
  129.       fprintf(out_file, "\n");
  130.       if (line != 0)
  131.          fprintf(out_file, "\n");
  132.       if (nxt_line == 1)
  133.          fprintf(out_file, "#line %d \"", nxt_line);
  134.       else
  135.          fprintf(out_file, "#line %d \"", nxt_line - 1);
  136.       for (s = new_fname; *s != '\0'; ++s) {
  137.          if (*s == '"' || *s == '\\')
  138.             putc('\\', out_file);
  139.          putc(*s, out_file);
  140.          }
  141.       if (nxt_line == 1)
  142.          fprintf(out_file, "\"");
  143.       else
  144.          fprintf(out_file, "\"\n");
  145.       nl = 1;
  146.       --nxt_line;
  147.       }
  148.     else if ((nxt_line > line || fname != new_fname) && line != 0) {
  149.       /*
  150.        * Line directives are disabled, but we are in a situation where
  151.        *  one or two new-lines are desirable.
  152.        */
  153.       if (nxt_line > line + 1 || fname != new_fname)
  154.          fprintf(out_file, "\n");
  155.       nl = 1;
  156.       --nxt_line;
  157.       }
  158.    line = nxt_line;
  159.    fname = new_fname;
  160.    }
  161.  
  162. /*
  163.  * prt_str - print a string to the output file, possibly preceded by
  164.  *   a new-line and indenting.
  165.  */
  166. novalue prt_str(s, indent)
  167. char *s;
  168. int indent;
  169.    {
  170.    chk_nl(indent);
  171.    fprintf(out_file, "%s", s);
  172.    }
  173.  
  174. /*
  175.  * tok_line - determine if a line directive is needed to synchronize the
  176.  *  output file name and line number with an input token.
  177.  */
  178. static novalue tok_line(t, indent)
  179. struct token *t;
  180. int indent;
  181.    {
  182.    int nxt_line;
  183.  
  184.    /*
  185.     * Line directives may be suppressed at certain points during code
  186.     *  output. This is done either by rtt itself using the no_nl flag, or
  187.     *  for macros, by the preprocessor using a flag in the token.
  188.     */
  189.    if (no_nl)
  190.       return;
  191.    if (t->flag & LineChk) {
  192.       /*
  193.        * If blank lines can be used in place of a line directive and no
  194.        *  more than 3 are needed, use them. If the line number and file
  195.        *  name are correct, but we need a new-line, we must output a
  196.        *  line directive so the line number is reset after the "new-line".
  197.        */
  198.       nxt_line = t->line;
  199.       if (fname != t->fname  || line > nxt_line || line + 2 < nxt_line)
  200.          line_dir(nxt_line, t->fname);
  201.       else if (nl && line == nxt_line)
  202.          line_dir(nxt_line, t->fname);
  203.       else if (line != nxt_line) {
  204.          nl = 1;
  205.          --nxt_line;
  206.          while (line < nxt_line) { /* above condition limits # interactions */
  207.             putc('\n', out_file);
  208.             ++line;
  209.             }
  210.          }
  211.       }
  212.    chk_nl(indent);
  213.    }
  214.  
  215. /*
  216.  * prt_tok - print a token.
  217.  */
  218. static novalue prt_tok(t, indent)
  219. struct token *t;
  220. int indent;
  221.    {
  222.    char *s;
  223.  
  224.    tok_line(t, indent); /* synchronize file name and line number */
  225.  
  226.    /*
  227.     * Most tokens contain a string of their exact image. However, string
  228.     *  and character literals lack the surrounding quotes.
  229.     */
  230.    s = t->image;
  231.    switch (t->tok_id) {
  232.       case StrLit:
  233.          fprintf(out_file, "\"%s\"", s);
  234.          break;
  235.       case LStrLit:
  236.          fprintf(out_file, "L\"%s\"", s);
  237.          break;
  238.       case CharConst:
  239.          fprintf(out_file, "'%s'", s);
  240.          break;
  241.       case LCharConst:
  242.          fprintf(out_file, "L'%s'", s);
  243.          break;
  244.       default:
  245.          fprintf(out_file, "%s", s);
  246.       }
  247.    }
  248.  
  249. /*
  250.  * untend - output code to removed the tended descriptors in this
  251.  *  function from the global tended list.
  252.  */
  253. static novalue untend(indent)
  254. int indent;
  255.    {
  256.    ForceNl();
  257.    prt_str("tend = ", indent);
  258.    fprintf(out_file, "%s.previous;", tendstrct);
  259.    ForceNl();
  260.    /*
  261.     * For varargs operations, the tended structure might have been
  262.     *  malloced. If so, it must be freed.
  263.     */
  264.    if (varargs) {
  265.       prt_str("if (r_tendp != (struct tend_desc *)&r_tend)", indent);
  266.       ForceNl();
  267.       prt_str("free((pointer)r_tendp);", 2 * indent);
  268.       }
  269.    }
  270.  
  271. /*
  272.  * tnd_var - output an expression to accessed a tended variable.
  273.  */
  274. static novalue tnd_var(sym, strct_ptr, access, indent)
  275. struct sym_entry *sym;
  276. char *strct_ptr;
  277. char *access;
  278. int indent;
  279.    {
  280.    /*
  281.     * A variable that is a specific block pointer type must be cast
  282.     *  to that pointer type in such a way that it can be used as either
  283.     *  an lvalue or an rvalue:  *(struct b_??? **)&???.vword.bptr
  284.     */
  285.    if (strct_ptr != NULL) {
  286.       prt_str("(*(struct ", indent);
  287.       prt_str(strct_ptr, indent);
  288.       prt_str("**)&", indent);
  289.       }
  290.  
  291.    if (sym->id_type & ByRef) {
  292.       /*
  293.        * The tended variable is being accessed indirectly through
  294.        *  a pointer (that is, it is accessed as the argument to a body
  295.        *  function); dereference its identifier.
  296.        */
  297.       prt_str("(*", indent);
  298.       prt_str(sym->image, indent);
  299.       prt_str(")", indent);
  300.       }
  301.    else {
  302.       if (sym->t_indx >= 0) {
  303.          /*
  304.           * The variable is accessed directly as part of the tended structure.
  305.           */
  306.          prt_str(tendstrct, indent);
  307.          fprintf(out_file, ".d[%d]", sym->t_indx);
  308.          }
  309.       else {
  310.          /*
  311.           * This is a direct access to an operation parameter.
  312.           */
  313.          prt_str("r_args[", indent);
  314.          fprintf(out_file, "%d]", sym->u.param_info.param_num + 1);
  315.          }
  316.       }
  317.    prt_str(access, indent);  /* access the vword for tended pointers */
  318.    if (strct_ptr != NULL)
  319.       prt_str(")", indent);
  320.    }
  321.  
  322. /*
  323.  * prt_var - print a variable.
  324.  */
  325. static novalue prt_var(n, indent)
  326. struct node *n;
  327. int indent;
  328.    {
  329.    struct token *t;
  330.    struct sym_entry *sym;
  331.  
  332.    t = n->tok;
  333.    tok_line(t, indent); /* synchronize file name and line nuber */
  334.    sym = n->u[0].sym;
  335.    switch (sym->id_type & ~ByRef) {
  336.       case TndDesc:
  337.          /*
  338.           * Simple tended descriptor.
  339.           */
  340.          tnd_var(sym, NULL, "", indent);
  341.          break;
  342.       case TndStr:
  343.          /*
  344.           * Tended character pointer.
  345.           */
  346.          tnd_var(sym, NULL, ".vword.sptr", indent);
  347.          break;
  348.       case TndBlk:
  349.          /*
  350.           * Tended block pointer.
  351.           */
  352.          tnd_var(sym, sym->u.tnd_var.blk_name, ".vword.bptr",
  353.             indent);
  354.          break;
  355.       case RtParm:
  356.       case DrfPrm:
  357.          switch (sym->u.param_info.cur_loc) {
  358.             case PrmTend:
  359.                /*
  360.                 * Simple tended parameter.
  361.                 */
  362.                tnd_var(sym, NULL, "", indent);
  363.                break;
  364.             case PrmCStr:
  365.                /*
  366.                 * Parameter converted to a (tended) string.
  367.                 */
  368.                tnd_var(sym, NULL, ".vword.sptr", indent);
  369.                break;
  370.             case PrmInt:
  371.                /*
  372.                 * Parameter converted to a C integer.
  373.                 */
  374.                chk_nl(indent);
  375.                fprintf(out_file, "r_i%d", sym->u.param_info.param_num);
  376.                break;
  377.             case PrmDbl:
  378.                /*
  379.                 * Parameter converted to a C double.
  380.                 */
  381.                chk_nl(indent);
  382.                fprintf(out_file, "r_d%d", sym->u.param_info.param_num);
  383.                break;
  384.             default:
  385.                errt2(t, "Conflicting conversions for: ", t->image);
  386.             }
  387.          break;
  388.       case RtParm | VarPrm:
  389.       case DrfPrm | VarPrm:
  390.          /*
  391.           * Parameter representing variable part of argument list.
  392.           */
  393.          prt_str("(&", indent);
  394.          if (sym->t_indx >= 0)
  395.             fprintf(out_file, "%s.d[%d])", tendstrct, sym->t_indx);
  396.          else
  397.             fprintf(out_file, "r_args[%d])", sym->u.param_info.param_num + 1);
  398.          break;
  399.       case VArgLen:
  400.          /*
  401.           * Length of variable part of argument list.
  402.           */
  403.          prt_str("(r_nargs - ", indent);
  404.          fprintf(out_file, "%d)", params->u.param_info.param_num);
  405.          break;
  406.       case RsltLoc:
  407.          /*
  408.           * "result" the result location of the operation.
  409.           */
  410.          prt_str(rslt_loc, indent);
  411.          break;
  412.       case Label:
  413.          /*
  414.           * Statement label.
  415.           */
  416.          prt_str(sym->image, indent);
  417.          break;
  418.       case OtherDcl:
  419.          /*
  420.           * Some other type of variable: accessed by identifier. If this
  421.           *  is a body function, it may be passed by reference and need
  422.           *  a level of pointer dereferencing.
  423.           */
  424.          if (sym->id_type & ByRef)
  425.             prt_str("(*",indent);
  426.          prt_str(sym->image, indent);
  427.          if (sym->id_type & ByRef)
  428.             prt_str(")",indent);
  429.          break;
  430.       }
  431.    }
  432.  
  433. /*
  434.  * does_call - determine if an expression contains a function call by
  435.  *  walking its syntax tree.
  436.  */
  437. static int does_call(expr)
  438. struct node *expr;
  439.    {
  440.    int n_subs;
  441.    int i;
  442.  
  443.    if (expr == NULL)
  444.       return 0;
  445.    if (expr->nd_id == BinryNd && expr->tok->tok_id == ')')
  446.       return 1;      /* found a function call */
  447.  
  448.    switch (expr->nd_id) {
  449.       case ExactCnv: case PrimryNd: case SymNd:
  450.          n_subs = 0;
  451.          break;
  452.       case CompNd:
  453.          /*
  454.           * Check field 0 below, field 1 is not a subtree, check field 2 here.
  455.           */
  456.          n_subs = 1;
  457.          if (does_call(expr->u[2].child))
  458.              return 1;
  459.          break;
  460.       case IcnTypNd: case PstfxNd: case PreSpcNd: case PrefxNd:
  461.          n_subs = 1;
  462.          break;
  463.       case AbstrNd: case BinryNd: case CommaNd: case ConCatNd: case LstNd:
  464.       case StrDclNd:
  465.          n_subs = 2;
  466.          break;
  467.       case TrnryNd:
  468.          n_subs = 3;
  469.          break;
  470.       case QuadNd:
  471.          n_subs = 4;
  472.          break;
  473.       default:
  474.          fprintf(stdout, "rtt internal error: unknown node type\n");
  475.          exit(ErrorExit);
  476.          }
  477.  
  478.    for (i = 0; i < n_subs; ++i)
  479.       if (does_call(expr->u[i].child))
  480.           return 1;
  481.  
  482.    return 0;
  483.    }
  484.  
  485. /*
  486.  * prt_runerr - print code to implement runerr().
  487.  */
  488. static novalue prt_runerr(t, num, val, indent)
  489. struct token *t;
  490. struct node *num;
  491. struct node *val;
  492. int indent;
  493.    {
  494.    if (op_type == OrdFunc)
  495.       errt1(t, "'runerr' may not be used in an ordinary C function");
  496.  
  497.    tok_line(t, indent);  /* synchronize file name and line number */
  498.    prt_str("{", indent);
  499.    ForceNl();
  500.    prt_str("err_msg(", indent);
  501.    c_walk(num, indent, 0);                /* error number */
  502.    if (val == NULL)
  503.       prt_str(", NULL);", indent);        /* no offending value */
  504.    else {
  505.       prt_str(", &(", indent);
  506.       c_walk(val, indent, 0);             /* offending value */
  507.       prt_str("));", indent);
  508.       }
  509.    /*
  510.     * Handle error conversion. Indicate that operation may fail because
  511.     *  of error conversion and produce the necessary code.
  512.     */
  513.    cur_impl->ret_flag |= DoesEFail;
  514.    failure(indent, 1);
  515.    prt_str("}", indent);
  516.    ForceNl();
  517.    }
  518.  
  519. /*
  520.  * typ_name - convert a type code to a string that can be used to
  521.  *  output "T_" or "D_" type codes.
  522.  */
  523. char *typ_name(typcd, tok)
  524. int typcd;
  525. struct token *tok;
  526.    {
  527.    if (typcd == Empty_type)
  528.       errt1(tok, "it is meaningless to assert a type of empty_type");
  529.    else if (typcd == Any_value)
  530.       errt1(tok, "it is useless to assert a type of any_value");
  531.    else if (typcd < 0 || typcd == str_typ)
  532.       return NULL;
  533.    else
  534.       return icontypes[typcd].cap_id;
  535.    }
  536.  
  537. /*
  538.  * Produce a C conditional expression to check a descriptor for a
  539.  *  particular type.
  540.  */
  541. static novalue typ_asrt(typcd, desc, tok, indent)
  542. int typcd;
  543. struct node *desc;
  544. struct token *tok;
  545. int indent;
  546.    {
  547.    tok_line(tok, indent);
  548.  
  549.    if (typcd == str_typ) {
  550.       /*
  551.        * Check dword for the absense of a "not qualifier" flag.
  552.        */
  553.       prt_str("(!((", indent);
  554.       c_walk(desc, indent, 0);
  555.       prt_str(").dword & F_Nqual))", indent);
  556.       }
  557.    else if (typcd == TypVar) {
  558.       /*
  559.        * Check dword for the presense of a "variable" flag.
  560.        */
  561.       prt_str("(((", indent);
  562.       c_walk(desc, indent, 0);
  563.       prt_str(").dword & D_Var) == D_Var)", indent);
  564.       }
  565.    else if (typcd == int_typ) {
  566.       /*
  567.        * If large integers are supported, an integer can be either
  568.        *  an ordinary integer or a large integer.
  569.        */
  570.       ForceNl();
  571.       prt_str("#ifdef LargeInts", 0);
  572.       ForceNl();
  573.       prt_str("(((", indent);
  574.       c_walk(desc, indent, 0);
  575.       prt_str(").dword == D_Integer) || ((", indent);
  576.       c_walk(desc, indent, 0);
  577.       prt_str(").dword == D_Lrgint))", indent);
  578.       ForceNl();
  579.       prt_str("#else\t\t\t\t\t/* LargeInts */", 0);
  580.       ForceNl();
  581.       prt_str("((", indent);
  582.       c_walk(desc, indent, 0);
  583.       prt_str(").dword == D_Integer)", indent);
  584.       ForceNl();
  585.       prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
  586.       ForceNl();
  587.       }
  588.    else {
  589.       /*
  590.        * Check dword for a specific type code.
  591.        */
  592.       prt_str("((", indent);
  593.       c_walk(desc, indent, 0);
  594.       prt_str(").dword == D_", indent);
  595.       prt_str(typ_name(typcd, tok), indent);
  596.       prt_str(")", indent);
  597.       }
  598.    }
  599.  
  600. /*
  601.  * retval_dcltor - convert the "declarator" part of function declaration
  602.  *  into a declarator for the variable "r_retval" of the same type
  603.  *  as the function result type, outputing the new declarator. This
  604.  *  variable is a temporary location to store the result of the argument
  605.  *  to a C return statement.
  606.  */
  607. static int retval_dcltor(dcltor, indent)
  608. struct node *dcltor;
  609. int indent;
  610.    {
  611.    int flag;
  612.  
  613.    switch (dcltor->nd_id) {
  614.       case ConCatNd:
  615.          c_walk(dcltor->u[0].child, indent, 0);
  616.          retval_dcltor(dcltor->u[1].child, indent);
  617.          return NotId;
  618.       case PrimryNd:
  619.          /*
  620.           * We have reached the function name. Replace it with "r_retval"
  621.           *  and tell caller we have found it.
  622.           */
  623.          prt_str("r_retval", indent);
  624.          return IsId;
  625.       case PrefxNd:
  626.          /*
  627.           * (...)
  628.           */
  629.          prt_str("(", indent);
  630.          flag = retval_dcltor(dcltor->u[0].child, indent);
  631.          prt_str(")", indent);
  632.          return flag;
  633.       case BinryNd:
  634.          if (dcltor->tok->tok_id == ')') {
  635.             /*
  636.              * Function declaration. If this is the declarator that actually
  637.              *  defines the function being processed, discard the paramater
  638.              *  list including parentheses.
  639.              */
  640.             if (retval_dcltor(dcltor->u[0].child, indent) == NotId) {
  641.                prt_str("(", indent);
  642.                c_walk(dcltor->u[1].child, indent, 0);
  643.                prt_str(")", indent);
  644.                }
  645.             }
  646.          else {
  647.             /*
  648.              * Array.
  649.              */
  650.             retval_dcltor(dcltor->u[0].child, indent);
  651.             prt_str("[", indent);
  652.             c_walk(dcltor->u[1].child, indent, 0);
  653.             prt_str("]", indent);
  654.             }
  655.          return NotId;
  656.       }
  657.    err1("rtt internal error detected in function retval_dcltor()");
  658.    /* NOTREACHED */
  659.    }
  660.  
  661. /*
  662.  * cnv_fnc - produce code to handle RTT cnv: and def: constructs.
  663.  */
  664. static novalue cnv_fnc(t, typcd, src, dflt, dest, indent)
  665. struct token *t;
  666. int typcd;
  667. struct node *src;
  668. struct node *dflt;
  669. struct node *dest;
  670. int indent;
  671.    {
  672.    int dflt_to_ptr;
  673.    int loc;
  674.    int is_cstr;
  675.  
  676.    if (src->nd_id == SymNd && src->u[0].sym->id_type & VarPrm)
  677.       errt1(t, "converting entire variable part of param list not supported");
  678.  
  679.    tok_line(t, indent); /* synchronize file name and line number */
  680.  
  681.    /*
  682.     * Initial assumptions: result of conversion is a tended location
  683.     *   and is not tended C string.
  684.     */
  685.    loc = PrmTend;
  686.    is_cstr = 0;
  687.  
  688.   /*
  689.    * Print the name of the conversion function. If it is a conversion
  690.    *  with a default value, determine (through dflt_to_prt) if the
  691.    *  default value is passed by-reference instead of by-value.
  692.    */
  693.    prt_str(cnv_name(typcd, dflt, &dflt_to_ptr), indent);
  694.    prt_str("(", indent);
  695.  
  696.    /*
  697.     * Determine what parameter scope, if any, is established by this
  698.     *  conversion. If the conversion needs a buffer, allocate it and
  699.     *  put it in the argument list.
  700.     */
  701.    switch (typcd) {
  702.       case TypCInt:
  703.       case TypECInt:
  704.          loc = PrmInt;
  705.          break;
  706.       case TypCDbl:
  707.          loc = PrmDbl;
  708.          break;
  709.       case TypCStr:
  710.          is_cstr = 1;
  711.          break;
  712.       case TypTStr:
  713.          fprintf(out_file, "r_sbuf[%d], ", nxt_sbuf++);
  714.          break;
  715.       case TypTCset:
  716.          fprintf(out_file, "&r_cbuf[%d], ", nxt_cbuf++);
  717.          break;
  718.       }
  719.  
  720.    /*
  721.     * Output source of conversion.
  722.     */
  723.    prt_str("&(", indent);
  724.    c_walk(src, indent, 0);
  725.    prt_str("), ", indent);
  726.  
  727.    /*
  728.     * If there is a default value, output it, taking its address if necessary.
  729.     */
  730.    if (dflt != NULL) {
  731.       if (dflt_to_ptr)
  732.          prt_str("&(", indent);
  733.       c_walk(dflt, indent, 0);
  734.       if (dflt_to_ptr)
  735.          prt_str("), ", indent);
  736.       else
  737.          prt_str(", ", indent);
  738.       }
  739.  
  740.    /*
  741.     * Output the destination of the conversion. This may or may not be
  742.     *  the same as the source.
  743.     */
  744.    prt_str("&(", indent);
  745.    if (dest == NULL) {
  746.       /*
  747.        * Convert "in place", changing the location of a paramater if needed.
  748.        */
  749.       if (src->nd_id == SymNd && src->u[0].sym->id_type & (RtParm | DrfPrm)) {
  750.          if (src->u[0].sym->id_type & DrfPrm)
  751.             src->u[0].sym->u.param_info.cur_loc = loc;
  752.          else
  753.             errt1(t, "only dereferenced parameter can be converted in-place");
  754.          }
  755.       else if ((loc != PrmTend) | is_cstr)
  756.          errt1(t,
  757.             "only ordinary parameters can be converted in-place to C values");
  758.       c_walk(src, indent, 0);
  759.       if (is_cstr) {
  760.          /*
  761.           * The parameter must be accessed as a tended C string, but only
  762.           *  now, after the "destination" code has been produced as a full
  763.           *  descriptor.
  764.           */
  765.          src->u[0].sym->u.param_info.cur_loc = PrmCStr;
  766.          }
  767.       }
  768.    else {
  769.       /*
  770.        * Convert to an explicit destination.
  771.        */
  772.       if (is_cstr) {
  773.          /*
  774.           * Access the destination as a full descriptor even though it
  775.           *  must be declared as a tended C string.
  776.           */
  777.          if (dest->nd_id != SymNd || (dest->u[0].sym->id_type != TndStr &&
  778.                dest->u[0].sym->id_type != TndDesc))
  779.             errt1(t,
  780.              "dest. of C_string conv. must be tended descriptor or char *");
  781.          tnd_var(dest->u[0].sym, NULL, "", indent);
  782.          }
  783.       else
  784.          c_walk(dest, indent, 0);
  785.       }
  786.    prt_str("))", indent);
  787.    }
  788.  
  789. /*
  790.  * cnv_name - produce name of conversion routine. Warning, name is
  791.  *   constructed in a static buffer. Also determine if a default
  792.  *   must be passed "by reference".
  793.  */
  794. char *cnv_name(typcd, dflt, dflt_to_ptr)
  795. int typcd;
  796. struct node *dflt;
  797. int *dflt_to_ptr;
  798.    {
  799.    static char buf[15];
  800.    int by_ref;
  801.  
  802.    /*
  803.     * The names of simple conversion and defaulting conversions have
  804.     *  the same suffixes, but different prefixes.
  805.     */
  806.    if (dflt == NULL)
  807.       strcpy(buf , "cnv_");
  808.    else
  809.        strcpy(buf, "def_");
  810.  
  811.    by_ref = 0;
  812.    switch (typcd) {
  813.       case TypCInt:
  814.          strcat(buf, "c_int");
  815.          break;
  816.       case TypCDbl:
  817.          strcat(buf, "c_dbl");
  818.          break;
  819.       case TypCStr:
  820.          strcat(buf, "c_str");
  821.          break;
  822.       case TypTStr:
  823.          strcat(buf, "tstr");
  824.          by_ref = 1;
  825.          break;
  826.       case TypTCset:
  827.          strcat(buf, "tcset");
  828.          by_ref = 1;
  829.          break;
  830.       case TypEInt:
  831.          strcat(buf, "eint");
  832.          break;
  833.       case TypECInt:
  834.          strcat(buf, "ec_int");
  835.          break;
  836.       default:
  837.          if (typcd == cset_typ) {
  838.             strcat(buf, "cset");
  839.             by_ref = 1;
  840.             }
  841.          else if (typcd == int_typ)
  842.             strcat(buf, "int");
  843.          else if (typcd == real_typ)
  844.             strcat(buf, "real");
  845.          else if (typcd == str_typ) {
  846.             strcat(buf, "str");
  847.             by_ref = 1;
  848.             }
  849.       }
  850.    if (dflt_to_ptr != NULL)
  851.       *dflt_to_ptr = by_ref;
  852.    return buf;
  853.    }
  854.  
  855. /*
  856.  * ret_value - produce code to set the result location of an operation
  857.  *  using the expression on a return or suspend.
  858.  */
  859. static novalue ret_value(t, n, indent)
  860. struct token *t;
  861. struct node *n;
  862. int indent;
  863.    {
  864.    struct node *caller;
  865.    struct node *args;
  866.    int typcd;
  867.  
  868.    if (n == NULL)
  869.       errt1(t, "there is no default return value for run-time operations");
  870.  
  871.    if (n->nd_id == SymNd && n->u[0].sym->id_type == RsltLoc) {
  872.       /*
  873.        * return/suspend result;
  874.        *
  875.        *   result already where it needs to be.
  876.        */
  877.       return;
  878.       }
  879.  
  880.    if (n->nd_id == PrefxNd && n->tok != NULL) {
  881.       switch (n->tok->tok_id) {
  882.          case C_Integer:
  883.             /*
  884.              * return/suspend C_integer <expr>;
  885.              */
  886.             prt_str(rslt_loc, indent);
  887.             prt_str(".vword.integr = ", indent);
  888.             c_walk(n->u[0].child, indent + IndentInc, 0);
  889.             prt_str(";", indent);
  890.             ForceNl();
  891.             prt_str(rslt_loc, indent);
  892.             prt_str(".dword = D_Integer;", indent);
  893.             chkabsret(t, int_typ);  /* compare return with abstract return */
  894.             return;
  895.          case C_Double:
  896.             /*
  897.              * return/suspend C_double <expr>;
  898.              */
  899.             prt_str(rslt_loc, indent);
  900.             prt_str(".vword.bptr = (union block *)alcreal(", indent);
  901.             c_walk(n->u[0].child, indent + IndentInc, 0);
  902.             prt_str(");", indent + IndentInc);
  903.             ForceNl();
  904.             prt_str(rslt_loc, indent);
  905.             prt_str(".dword = D_Real;", indent);
  906.             /*
  907.              * The allocation of the real block may fail.
  908.              */
  909.             chk_rsltblk(indent);
  910.             chkabsret(t, real_typ); /* compare return with abstract return */
  911.             return;
  912.          case C_String:
  913.             /*
  914.              * return/suspend C_string <expr>;
  915.              */
  916.             prt_str(rslt_loc, indent);
  917.             prt_str(".vword.sptr = ", indent);
  918.             c_walk(n->u[0].child, indent + IndentInc, 0);
  919.             prt_str(";", indent);
  920.             ForceNl();
  921.             prt_str(rslt_loc, indent);
  922.             prt_str(".dword = strlen(", indent);
  923.             prt_str(rslt_loc, indent);
  924.             prt_str(".vword.sptr);", indent);
  925.             chkabsret(t, str_typ); /* compare return with abstract return */
  926.             return;
  927.          }
  928.       }
  929.    else if (n->nd_id == BinryNd && n->tok->tok_id == ')') {
  930.       /*
  931.        * Return value is in form of function call, see if it is really
  932.        *  a descriptor constructor.
  933.        */
  934.       caller = n->u[0].child;
  935.       args = n->u[1].child;
  936.       if (caller->nd_id == SymNd) {
  937.          switch (caller->tok->tok_id) {
  938.             case IconType:
  939.                typcd = caller->u[0].sym->u.typ_indx;
  940.                switch (icontypes[typcd].rtl_ret) {
  941.                   case TRetBlkP:
  942.                      /*
  943.                       * return/suspend <type>(<block-pntr>);
  944.                       */
  945.                      ret_1_arg(t, args, typcd, ".vword.bptr = (union block *)",
  946.                         "(bp)", indent);
  947.                      break;
  948.                   case TRetDescP:
  949.                      /*
  950.                       * return/suspend <type>(<desc-pntr>);
  951.                       */
  952.                      ret_1_arg(t, args, typcd, ".vword.descptr = (dptr)",
  953.                         "(dp)", indent);
  954.                      break;
  955.                   case TRetCharP:
  956.                      /*
  957.                       * return/suspend <type>(<char-pntr>);
  958.                       */
  959.                      ret_1_arg(t, args, typcd, ".vword.sptr = (char *)",
  960.                         "(s)", indent);
  961.                      break;
  962.                   case TRetCInt:
  963.                      /*
  964.                       * return/suspend <type>(<integer>);
  965.                       */
  966.                      ret_1_arg(t, args, typcd, ".vword.integr = (word)",
  967.                         "(i)", indent);
  968.                      break;
  969.                   case TRetSpcl:
  970.                      if (typcd == str_typ) {
  971.                         /*
  972.                          * return/suspend string(<len>, <char-pntr>);
  973.                          */
  974.                         if (args == NULL || args->nd_id != CommaNd ||
  975.                            args->u[0].child->nd_id == CommaNd)
  976.                            errt1(t, "wrong no. of args for string(n, s)");
  977.                         prt_str(rslt_loc, indent);
  978.                         prt_str(".vword.sptr = ", indent);
  979.                         c_walk(args->u[1].child, indent + IndentInc, 0);
  980.                         prt_str(";", indent);
  981.                         ForceNl();
  982.                         prt_str(rslt_loc, indent);
  983.                         prt_str(".dword = ", indent);
  984.                         c_walk(args->u[0].child, indent + IndentInc, 0);
  985.                         prt_str(";", indent);
  986.                         }
  987.                      else if (typcd == stv_typ) {
  988.                         /*
  989.                          * return/suspend tvsubs(<desc-pntr>, <start>, <len>);
  990.                          */
  991.                         if (args == NULL || args->nd_id != CommaNd ||
  992.                            args->u[0].child->nd_id != CommaNd ||
  993.                            args->u[0].child->u[0].child->nd_id == CommaNd)
  994.                            errt1(t, "wrong no. of args for tvsubs(dp, i, j)");
  995.                         no_nl = 1;
  996.                         prt_str("SubStr(&", indent);
  997.                         prt_str(rslt_loc, indent);
  998.                         prt_str(", ", indent);
  999.                         c_walk(args->u[0].child->u[0].child, indent + IndentInc,
  1000.                            0);
  1001.                         prt_str(", ", indent + IndentInc);
  1002.                         c_walk(args->u[1].child, indent + IndentInc, 0);
  1003.                         prt_str(", ", indent + IndentInc);
  1004.                         c_walk(args->u[0].child->u[1].child, indent + IndentInc,
  1005.                           0);
  1006.                         prt_str(");", indent + IndentInc);
  1007.                         no_nl = 0;
  1008.                         /*
  1009.                          * The allocation of the substring trapped variable
  1010.                          *   block may fail.
  1011.                          */
  1012.                         chk_rsltblk(indent);
  1013.                         chkabsret(t, stv_typ); /* compare to abstract return */
  1014.                         }
  1015.                      break;
  1016.                   }
  1017.                chkabsret(t, typcd); /* compare return with abstract return */
  1018.                return;
  1019.             case Named_var:
  1020.                /*
  1021.                 * return/suspend named_var(<desc-pntr>);
  1022.                 */
  1023.                if (args == NULL || args->nd_id == CommaNd)
  1024.                   errt1(t, "wrong no. of args for named_var(dp)");
  1025.                prt_str(rslt_loc, indent);
  1026.                prt_str(".vword.descptr = ", indent);
  1027.                c_walk(args, indent + IndentInc, 0);
  1028.                prt_str(";", indent);
  1029.                ForceNl();
  1030.                prt_str(rslt_loc, indent);
  1031.                prt_str(".dword = D_Var;", indent);
  1032.                chkabsret(t, TypVar); /* compare return with abstract return */
  1033.                return;
  1034.             case Struct_var:
  1035.                /*
  1036.                 * return/suspend struct_var(<desc-pntr>, <block_pntr>);
  1037.                 */
  1038.                if (args == NULL || args->nd_id != CommaNd ||
  1039.                   args->u[0].child->nd_id == CommaNd)
  1040.                   errt1(t, "wrong no. of args for struct_var(dp, bp)");
  1041.                prt_str(rslt_loc, indent);
  1042.                prt_str(".vword.descptr = (dptr)", indent);
  1043.                c_walk(args->u[1].child, indent + IndentInc, 0);
  1044.                prt_str(";", indent);
  1045.                ForceNl();
  1046.                prt_str(rslt_loc, indent);
  1047.                prt_str(".dword = D_Var + ((word *)", indent);
  1048.                c_walk(args->u[0].child, indent + IndentInc, 0);
  1049.                prt_str(" - (word *)", indent+IndentInc);
  1050.                prt_str(rslt_loc, indent);
  1051.                prt_str(".vword.descptr);", indent+IndentInc);
  1052.                ForceNl();
  1053.                chkabsret(t, TypVar); /* compare return with abstract return */
  1054.                return;
  1055.             }
  1056.          }
  1057.       }
  1058.  
  1059.    /*
  1060.     * If it is not one of the special returns, it is just a return of
  1061.     *  a descriptor.
  1062.     */
  1063.    prt_str(rslt_loc, indent);
  1064.    prt_str(" = ", indent);
  1065.    c_walk(n, indent + IndentInc, 0);
  1066.    prt_str(";", indent);
  1067.    chkabsret(t, SomeType); /* check for preceding abstract return */
  1068.    }
  1069.  
  1070. /*
  1071.  * ret_1_arg - produce code for a special return/suspend with one argument.
  1072.  */
  1073. static novalue ret_1_arg(t, args, typcd, vwrd_asgn, arg_rep, indent)
  1074. struct token *t;
  1075. struct node *args;
  1076. int typcd;
  1077. char *vwrd_asgn;
  1078. char *arg_rep;
  1079. int indent;
  1080.    {
  1081.    if (args == NULL || args->nd_id == CommaNd)
  1082.       errt3(t, "wrong no. of args for", icontypes[typcd].id, arg_rep);
  1083.  
  1084.    /*
  1085.     * Assignment to vword of result descriptor.
  1086.     */
  1087.    prt_str(rslt_loc, indent);
  1088.    prt_str(vwrd_asgn, indent);
  1089.    c_walk(args, indent + IndentInc, 0);
  1090.    prt_str(";", indent);
  1091.    ForceNl();
  1092.  
  1093.    /*
  1094.     * Assignment to dword of result descriptor.
  1095.     */
  1096.    prt_str(rslt_loc, indent);
  1097.    prt_str(".dword = D_", indent);
  1098.    prt_str(icontypes[typcd].cap_id, indent);
  1099.    prt_str(";", indent);
  1100.    }
  1101.  
  1102. /*
  1103.  * chk_rsltblk - the result value contains an allocated block, make sure
  1104.  *    the allocation succeeded.
  1105.  */
  1106. static novalue chk_rsltblk(indent)
  1107. int indent;
  1108.    {
  1109.    ForceNl();
  1110.    prt_str("if (", indent);
  1111.    prt_str(rslt_loc, indent);
  1112.    prt_str(".vword.bptr == NULL) {", indent);
  1113.    ForceNl();
  1114.    prt_str("err_msg(307, NULL);", indent + IndentInc);
  1115.    ForceNl();
  1116.    /*
  1117.     * Handle error conversion. Indicate that operation may fail because
  1118.     *  of error conversion and produce the necessary code.
  1119.     */
  1120.    cur_impl->ret_flag |= DoesEFail;
  1121.    failure(indent + IndentInc, 1);
  1122.    prt_str("}", indent + IndentInc);
  1123.    ForceNl();
  1124.    }
  1125.  
  1126. /*
  1127.  * failure - produce code for fail or efail.
  1128.  */
  1129. static novalue failure(indent, brace)
  1130. int indent;
  1131. int brace;
  1132.    {
  1133.    /*
  1134.     * If there are tended variables, they must be removed from the tended
  1135.     *  list. The C function may or may not return an explicit signal.
  1136.     */
  1137.    ForceNl();
  1138.    if (ntend != 0) {
  1139.       if (!brace)
  1140.          prt_str("{", indent);
  1141.       untend(indent);
  1142.       ForceNl();
  1143.       if (fnc_ret == RetSig)
  1144.          prt_str("return A_Resume;", indent);
  1145.       else
  1146.          prt_str("return;", indent);
  1147.       if (!brace) {
  1148.          ForceNl();
  1149.          prt_str("}", indent);
  1150.          }
  1151.       }
  1152.    else
  1153.       if (fnc_ret == RetSig)
  1154.          prt_str("return A_Resume;", indent);
  1155.       else
  1156.          prt_str("return;", indent);
  1157.    ForceNl();
  1158.    }
  1159.  
  1160. /*
  1161.  * c_walk - walk the syntax tree for extended C code and output the
  1162.  *  corresponding ordinary C. Return and indication of whether execution
  1163.  *  falls through the code.
  1164.  */
  1165. int c_walk(n, indent, brace)
  1166. struct node *n;
  1167. int indent;
  1168. int brace;
  1169.    {
  1170.    struct token *t;
  1171.    struct node *n1;
  1172.    struct sym_entry *sym;
  1173.    int fall_thru;
  1174.    int save_break;
  1175.    static int does_break = 0;
  1176.    static int may_brnchto;  /* may reach end of code by branching into middle */
  1177.  
  1178.    if (n == NULL)
  1179.       return 1;
  1180.  
  1181.    t =  n->tok;
  1182.  
  1183.    switch (n->nd_id) {
  1184.       case PrimryNd:
  1185.          switch (t->tok_id) {
  1186.             case Fail:
  1187.                if (op_type == OrdFunc)
  1188.                   errt1(t, "'fail' may not be used in an ordinary C function");
  1189.                cur_impl->ret_flag |= DoesFail;
  1190.                failure(indent, brace);
  1191.            chkabsret(t, SomeType);  /* check preceding abstract return */
  1192.            return 0;
  1193.         case Errorfail:
  1194.            if (op_type == OrdFunc)
  1195.           errt1(t,
  1196.               "'errorfail' may not be used in an ordinary C function");
  1197.            cur_impl->ret_flag |= DoesEFail;
  1198.            failure(indent, brace);
  1199.            return 0;
  1200.             case Break:
  1201.            prt_tok(t, indent);
  1202.            prt_str(";", indent);
  1203.                does_break = 1;
  1204.                return 0;
  1205.         default:
  1206.                /*
  1207.                 * Other "primary" expressions are just their token image,
  1208.                 *  possibly followed by a semicolon.
  1209.                 */
  1210.            prt_tok(t, indent);
  1211.            if (t->tok_id == Continue)
  1212.           prt_str(";", indent);
  1213.                return 1;
  1214.         }
  1215.       case PrefxNd:
  1216.      switch (t->tok_id) {
  1217.         case Sizeof:
  1218.            prt_tok(t, indent);                /* sizeof */
  1219.            prt_str("(", indent);
  1220.            c_walk(n->u[0].child, indent, 0);
  1221.            prt_str(")", indent);
  1222.            return 1;
  1223.         case '{':
  1224.                /*
  1225.                 * Initializer list.
  1226.                 */
  1227.            prt_tok(t, indent + IndentInc);     /* { */
  1228.            c_walk(n->u[0].child, indent + IndentInc, 0);
  1229.            prt_str("}", indent + IndentInc);
  1230.            return 1;
  1231.         case Default:
  1232.            prt_tok(t, indent - IndentInc);     /* default (un-indented) */
  1233.            prt_str(": ", indent - IndentInc);
  1234.            fall_thru = c_walk(n->u[0].child, indent, 0);
  1235.                may_brnchto = 1;
  1236.                return fall_thru;
  1237.         case Goto:
  1238.            prt_tok(t, indent);                 /* goto */
  1239.            prt_str(" ", indent);
  1240.            c_walk(n->u[0].child, indent, 0);
  1241.            prt_str(";", indent);
  1242.            return 0;
  1243.         case Return:
  1244.            if (n->u[0].child != NULL)
  1245.           no_ret_val = 0;  /* note that return statement has no value */
  1246.  
  1247.            if (op_type == OrdFunc || fnc_ret == RetInt ||
  1248.           fnc_ret == RetDbl) {
  1249.           /*
  1250.            * ordinary C return: ignore C_integer, C_double, and
  1251.            *  C_string qualifiers on return expression (the first
  1252.            *  two may legally occur when fnc_ret is RetInt or RetDbl).
  1253.            */
  1254.           n1 = n->u[0].child;
  1255.           if (n1 != NULL && n1->nd_id == PrefxNd && n1->tok != NULL) {
  1256.              switch (n1->tok->tok_id) {
  1257.             case C_Integer:
  1258.             case C_Double:
  1259.             case C_String:
  1260.                n1 = n1->u[0].child;
  1261.             }
  1262.              }
  1263.           if (ntend != 0) {
  1264.                      /*
  1265.                       * There are tended variables that must be removed from
  1266.                       *  the tended list.
  1267.                       */
  1268.              if (!brace)
  1269.             prt_str("{", indent);
  1270.              if (does_call(n1)) {
  1271.             /*
  1272.              * The return expression contains a function call;
  1273.                          *  the variables must remain tended while it is
  1274.                          *  computed, so compute it into a temporary variable
  1275.                          *  named r_retval.Output a declaration for r_retval;
  1276.                          *  its type must match the return type of the C
  1277.                          *  function.
  1278.                          */
  1279.             ForceNl();
  1280.             prt_str("register ", indent);
  1281.             if (op_type == OrdFunc) {
  1282.                no_nl = 1;
  1283.                just_type(fnc_head->u[0].child, indent, 0);
  1284.                prt_str(" ", indent);
  1285.                retval_dcltor(fnc_head->u[1].child, indent);
  1286.                prt_str(";", indent);
  1287.                no_nl = 0;
  1288.                }
  1289.             else if (fnc_ret == RetInt)
  1290.                prt_str("C_integer r_retval;", indent);
  1291.             else    /* fnc_ret == RetDbl */
  1292.                prt_str("double r_retval;", indent);
  1293.             ForceNl();
  1294.  
  1295.                         /*
  1296.                          * Output code to compute the return value, untend
  1297.                          *  the variable, then return the value.
  1298.                          */
  1299.             prt_str("r_retval = ", indent);
  1300.             c_walk(n1, indent + IndentInc, 0);
  1301.             prt_str(";", indent);
  1302.             untend(indent);
  1303.             ForceNl();
  1304.             prt_str("return r_retval;", indent);
  1305.             }
  1306.              else {
  1307.                         /*
  1308.                          * It is safe to untend the variables and return
  1309.                          *  the result value directly with a return
  1310.                          *  statement.
  1311.                          */
  1312.             untend(indent);
  1313.             ForceNl();
  1314.             prt_tok(t, indent);    /* return */
  1315.             prt_str(" ", indent);
  1316.             c_walk(n1, indent, 0);
  1317.             prt_str(";", indent);
  1318.             }
  1319.              if (!brace) {
  1320.             ForceNl();
  1321.             prt_str("}", indent);
  1322.             }
  1323.              ForceNl();
  1324.              }
  1325.           else {
  1326.                      /*
  1327.                       * There are no tended variable, just output the
  1328.                       *  return expression.
  1329.                       */
  1330.              prt_tok(t, indent);     /* return */
  1331.              prt_str(" ", indent);
  1332.              c_walk(n1, indent, 0);
  1333.              prt_str(";", indent);
  1334.              }
  1335.  
  1336.                   /*
  1337.                    * If this is a body function, check the return against
  1338.                    *  preceding abstract returns.
  1339.                    */
  1340.           if (fnc_ret == RetInt)
  1341.              chkabsret(n->tok, int_typ);
  1342.                   else if (fnc_ret == RetDbl)
  1343.                      chkabsret(n->tok, real_typ);
  1344.                   }
  1345.                else {
  1346.                   /*
  1347.                    * Return from Icon operation. Indicate that the operation
  1348.                    *  returns, compute the value into the result location,
  1349.                    *  untend variables if necessary, and return a signal
  1350.                    *  if the function requires one.
  1351.                    */
  1352.                   cur_impl->ret_flag |= DoesRet;
  1353.                   ForceNl();
  1354.                   if (!brace) {
  1355.                      prt_str("{", indent);
  1356.                      ForceNl();
  1357.                      }
  1358.                   ret_value(t, n->u[0].child, indent);
  1359.                   if (ntend != 0)
  1360.                      untend(indent);
  1361.                   ForceNl();
  1362.                   if (fnc_ret == RetSig)
  1363.                      prt_str("return A_Continue;", indent);
  1364.                   else if (fnc_ret == RetNoVal)
  1365.                      prt_str("return;", indent);
  1366.                   ForceNl();
  1367.                   if (!brace) {
  1368.                      prt_str("}", indent);
  1369.                      ForceNl();
  1370.                      }
  1371.                   }
  1372.                return 0;
  1373.             case Suspend:
  1374.                if (op_type == OrdFunc)
  1375.                   errt1(t, "'suspend' may not be used in an ordinary C function"
  1376.                      );
  1377.                cur_impl->ret_flag |= DoesSusp; /* note suspension */
  1378.                ForceNl();
  1379.                if (!brace) {
  1380.                   prt_str("{", indent);
  1381.                   ForceNl();
  1382.                   }
  1383.                prt_str("register int signal;", indent + IndentInc);
  1384.                ForceNl();
  1385.                ret_value(t, n->u[0].child, indent);
  1386.                ForceNl();
  1387.                /*
  1388.                 * The operator suspends by calling the success continuation
  1389.                 *  if there is one or just returns if there is none. For
  1390.                 *  the interpreter, interp() is the success continuation.
  1391.                 *  A non-A_Resume signal from the success continuation must
  1392.                 *  returned to the caller. If there are tended variables
  1393.                 *  they must be removed from the tended list before a signal
  1394.                 *  is returned.
  1395.                 */
  1396.                if (iconx_flg) {
  1397. #ifdef EventMon
  1398.           switch (op_type) {
  1399.           case Function:
  1400.              prt_str(
  1401.                "if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {",
  1402.                  indent);
  1403.              break;
  1404.           case Operator:
  1405.           case Keyword:
  1406.              prt_str(
  1407.                "if ((signal = interp(G_Osusp, r_args)) != A_Resume) {",
  1408.                  indent);
  1409.              break;
  1410.           default:
  1411.              prt_str(
  1412.                "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
  1413.                  indent);
  1414.           }
  1415. #else                    /* EventMon */
  1416.           prt_str(
  1417.             "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
  1418.               indent);
  1419. #endif                    /* EventMon */
  1420.           }
  1421.                else {
  1422.                   prt_str("if (r_s_cont == (continuation)NULL) {", indent);
  1423.                   if (ntend != 0)
  1424.                      untend(indent + IndentInc);
  1425.                   ForceNl();
  1426.                   prt_str("return A_Continue;", indent + IndentInc);
  1427.                   ForceNl();
  1428.                   prt_str("}", indent + IndentInc);
  1429.                   ForceNl();
  1430.                   prt_str("else if ((signal = (*r_s_cont)()) != A_Resume) {",
  1431.                      indent);
  1432.                   }
  1433.                ForceNl();
  1434.                if (ntend != 0)
  1435.                   untend(indent + IndentInc);
  1436.                ForceNl();
  1437.                prt_str("return signal;", indent + IndentInc);
  1438.                ForceNl();
  1439.                prt_str("}", indent + IndentInc);
  1440.                if (!brace) {
  1441.                   prt_str("}", indent);
  1442.                   ForceNl();
  1443.                   }
  1444.                return 1;
  1445.             case '(':
  1446.                /*
  1447.                 * Parenthesized expression.
  1448.                 */
  1449.                prt_tok(t, indent);     /* ( */
  1450.                fall_thru = c_walk(n->u[0].child, indent, 0);
  1451.                prt_str(")", indent);
  1452.                return fall_thru;
  1453.             default:
  1454.                /*
  1455.                 * All other prefix expressions are printed as the token
  1456.                 *  image of the operation followed by the operand.
  1457.                 */
  1458.                prt_tok(t, indent);
  1459.                c_walk(n->u[0].child, indent, 0);
  1460.                return 1;
  1461.             }
  1462.       case PstfxNd:
  1463.          /*
  1464.           * All postfix expressions are printed as the operand followed
  1465.           *  by the token image of the operation.
  1466.           */
  1467.          fall_thru = c_walk(n->u[0].child, indent, 0);
  1468.          prt_tok(t, indent);
  1469.          return fall_thru;
  1470.       case PreSpcNd:
  1471.          /*
  1472.           * This prefix expression (pointer indication in a declaration) needs
  1473.           *  a space after it.
  1474.           */
  1475.          prt_tok(t, indent);
  1476.          c_walk(n->u[0].child, indent, 0);
  1477.          prt_str(" ", indent);
  1478.          return 1;
  1479.       case SymNd:
  1480.          /*
  1481.           * Identifier.
  1482.           */
  1483.          prt_var(n, indent);
  1484.          return 1;
  1485.       case BinryNd:
  1486.          switch (t->tok_id) {
  1487.             case '[':
  1488.                /*
  1489.                 * subscripting expression or declaration: <expr> [ <expr> ]
  1490.                 */
  1491.                n1 = n->u[0].child;
  1492.                c_walk(n->u[0].child, indent, 0);
  1493.                prt_str("[", indent);
  1494.                c_walk(n->u[1].child, indent, 0);
  1495.                prt_str("]", indent);
  1496.                return 1;
  1497.             case '(':
  1498.                /*
  1499.                 * cast: ( <type> ) <expr>
  1500.                 */
  1501.                prt_tok(t, indent);  /* ) */
  1502.                c_walk(n->u[0].child, indent, 0);
  1503.                prt_str(")", indent);
  1504.                c_walk(n->u[1].child, indent, 0);
  1505.                return 1;
  1506.             case ')':
  1507.                /*
  1508.                 * function call or declaration: <expr> ( <expr-list> )
  1509.                 */
  1510.                c_walk(n->u[0].child, indent, 0);
  1511.                prt_str("(", indent);
  1512.                c_walk(n->u[1].child, indent, 0);
  1513.                prt_tok(t, indent);   /* ) */
  1514.                return call_ret(n->u[0].child);
  1515.             case Struct:
  1516.             case Union:
  1517.                /*
  1518.                 * struct/union <ident>
  1519.                 * struct/union <opt-ident> { <field-list> }
  1520.                 */
  1521.                prt_tok(t, indent);   /* struct or union */
  1522.                prt_str(" ", indent);
  1523.                c_walk(n->u[0].child, indent, 0);
  1524.                if (n->u[1].child != NULL) {
  1525.                   /*
  1526.                    * Field declaration list.
  1527.                    */
  1528.                   prt_str(" {", indent);
  1529.                   c_walk(n->u[1].child, indent + IndentInc, 0);
  1530.                   ForceNl();
  1531.                   prt_str("}", indent);
  1532.                   }
  1533.                return 1;
  1534.             case Enum:
  1535.                /*
  1536.                 * enum <ident>
  1537.                 * enum <opt-ident> { <enum-list> }
  1538.                 */
  1539.                prt_tok(t, indent);   /* enum */
  1540.                prt_str(" ", indent);
  1541.                c_walk(n->u[0].child, indent, 0);
  1542.                if (n->u[1].child != NULL) {
  1543.                   /*
  1544.                    * enumerator list.
  1545.                    */
  1546.                   prt_str(" {", indent);
  1547.                   c_walk(n->u[1].child, indent + IndentInc, 0);
  1548.                   prt_str("}", indent);
  1549.                   }
  1550.                return 1;
  1551.             case ';':
  1552.                /*
  1553.                 * <type-specs> <declarator> ;
  1554.                 */
  1555.                c_walk(n->u[0].child, indent, 0);
  1556.                prt_str(" ", indent);
  1557.                c_walk(n->u[1].child, indent, 0);
  1558.                prt_tok(t, indent);  /* ; */
  1559.                return 1;
  1560.             case ':':
  1561.                /*
  1562.                 * <label> : <statement>
  1563.                 */
  1564.                c_walk(n->u[0].child, indent, 0);
  1565.                prt_tok(t, indent);   /* : */
  1566.                prt_str(" ", indent);
  1567.                fall_thru = c_walk(n->u[1].child, indent, 0);
  1568.                may_brnchto = 1;
  1569.                return fall_thru;
  1570.             case Case:
  1571.                /*
  1572.                 * case <expr> : <statement>
  1573.                 */
  1574.                prt_tok(t, indent - IndentInc);  /* case (un-indented) */
  1575.                prt_str(" ", indent);
  1576.                c_walk(n->u[0].child, indent - IndentInc, 0);
  1577.                prt_str(": ", indent - IndentInc);
  1578.                fall_thru = c_walk(n->u[1].child, indent, 0);
  1579.                may_brnchto = 1;
  1580.                return fall_thru;
  1581.             case Switch:
  1582.                /*
  1583.                 * switch ( <expr> ) <statement>
  1584.                 *
  1585.                 * <statement> is double indented so that case and default
  1586.                 * statements can be un-indented and come out indented 1
  1587.                 * with respect to the switch. Statements that are not
  1588.                 * "labeled" with case or default are indented one more
  1589.                 * than those that are labeled.
  1590.                 */
  1591.                prt_tok(t, indent);  /* switch */
  1592.                prt_str(" (", indent);
  1593.                c_walk(n->u[0].child, indent, 0);
  1594.                prt_str(")", indent);
  1595.                prt_str(" ", indent);
  1596.                save_break = does_break;
  1597.                fall_thru = c_walk(n->u[1].child, indent + 2 * IndentInc, 0);
  1598.                fall_thru |= does_break;
  1599.                does_break = save_break;
  1600.                return fall_thru;
  1601.             case While: {
  1602.                struct node *n0;
  1603.                /*
  1604.                 * While ( <expr> ) <statement>
  1605.                 */
  1606.                n0 = n->u[0].child;
  1607.                prt_tok(t, indent);  /* while */
  1608.                prt_str(" (", indent);
  1609.                c_walk(n0, indent, 0);
  1610.                prt_str(")", indent);
  1611.                prt_str(" ", indent);
  1612.                save_break = does_break;
  1613.                c_walk(n->u[1].child, indent + IndentInc, 0);
  1614.                /*
  1615.                 * check for an infinite loop, while (1) ... :
  1616.                 *  a condition consisting of an IntConst with image=="1"
  1617.                 *  and no breaks in the body.
  1618.                 */
  1619.                if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
  1620.                    !strcmp(n0->tok->image,"1") && !does_break)
  1621.                   fall_thru = 0;
  1622.                else
  1623.                   fall_thru = 1;
  1624.                does_break = save_break;
  1625.                return fall_thru;
  1626.                }
  1627.             case Do:
  1628.                /*
  1629.                 * do <statement> <while> ( <expr> )
  1630.                 */
  1631.                prt_tok(t, indent);  /* do */
  1632.                prt_str(" ", indent);
  1633.                c_walk(n->u[0].child, indent + IndentInc, 0);
  1634.                ForceNl();
  1635.                prt_str("while (", indent);
  1636.                save_break = does_break;
  1637.                c_walk(n->u[1].child, indent, 0);
  1638.                does_break = save_break;
  1639.                prt_str(");", indent);
  1640.                return 1;
  1641.             case '.':
  1642.             case Arrow:
  1643.                /*
  1644.                 * Field access: <expr> . <expr>  and  <expr> -> <expr>
  1645.                 */
  1646.                c_walk(n->u[0].child, indent, 0);
  1647.                prt_tok(t, indent);   /* . or -> */
  1648.                c_walk(n->u[1].child, indent, 0);
  1649.                return 1;
  1650.             case Runerr:
  1651.                /*
  1652.                 * runerr ( <error-number> )
  1653.                 * runerr ( <error-number> , <offending-value> )
  1654.                 */
  1655.                prt_runerr(t, n->u[0].child, n->u[1].child, indent);
  1656.                return 0;
  1657.             case Is:
  1658.                /*
  1659.                 * is : <type> ( <expr> )
  1660.                 */
  1661.                typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
  1662.                   n->u[0].child->tok, indent);
  1663.                return 1;
  1664.             default:
  1665.                /*
  1666.                 * All other binary expressions are infix notation and
  1667.                 *  are printed with spaces around the operator.
  1668.                 */
  1669.                c_walk(n->u[0].child, indent, 0);
  1670.                prt_str(" ", indent);
  1671.                prt_tok(t, indent);
  1672.                prt_str(" ", indent);
  1673.                c_walk(n->u[1].child, indent, 0);
  1674.                return 1;
  1675.             }
  1676.       case LstNd:
  1677.          /*
  1678.           * <declaration-part> <declaration-part>
  1679.           *
  1680.           * Need space between parts
  1681.           */
  1682.          c_walk(n->u[0].child, indent, 0);
  1683.          prt_str(" ", indent);
  1684.          c_walk(n->u[1].child, indent, 0);
  1685.          return 1;
  1686.       case ConCatNd:
  1687.          /*
  1688.           * <some-code> <some-code>
  1689.           *
  1690.           * Various lists of code parts that do not need space between them.
  1691.           */
  1692.          if (c_walk(n->u[0].child, indent, 0))
  1693.             return c_walk(n->u[1].child, indent, 0);
  1694.          else {
  1695.             /*
  1696.              * Cannot directly reach the second piece of code, see if
  1697.              *  it is possible to branch into it.
  1698.              */
  1699.             may_brnchto = 0;
  1700.             fall_thru = c_walk(n->u[1].child, indent, 0);
  1701.             return may_brnchto & fall_thru;
  1702.             }
  1703.       case CommaNd:
  1704.          /*
  1705.           * <expr> , <expr>
  1706.           */
  1707.          c_walk(n->u[0].child, indent, 0);
  1708.          prt_tok(t, indent);
  1709.          prt_str(" ", indent);
  1710.          return c_walk(n->u[1].child, indent, 0);
  1711.       case StrDclNd:
  1712.          /*
  1713.           * Structure field declaration. Bit field declarations have
  1714.           *  a semicolon and a field width.
  1715.           */
  1716.          c_walk(n->u[0].child, indent, 0);
  1717.          if (n->u[1].child != NULL) {
  1718.             prt_str(": ", indent);
  1719.             c_walk(n->u[1].child, indent, 0);
  1720.             }
  1721.          return 1;
  1722.       case CompNd:
  1723.          /*
  1724.           * Compound statement.
  1725.           */
  1726.          if (brace)
  1727.             tok_line(t, indent); /* just synch. file name and line number */
  1728.          else
  1729.             prt_tok(t, indent);  /* { */
  1730.          c_walk(n->u[0].child, indent, 0);
  1731.          /*
  1732.           * we are in an inner block. tended locations may need to
  1733.           *  be set to values from declaration initializations.
  1734.           */
  1735.          for (sym = n->u[1].sym; sym!= NULL; sym = sym->u.tnd_var.next) {
  1736.             if (sym->u.tnd_var.init != NULL) {
  1737.                prt_str(tendstrct, IndentInc);
  1738.                fprintf(out_file, ".d[%d]", sym->t_indx);
  1739.                switch (sym->id_type) {
  1740.                   case TndDesc:
  1741.                      prt_str(" = ", IndentInc);
  1742.                      break;
  1743.                   case TndStr:
  1744.                      prt_str(".vword.sptr = ", IndentInc);
  1745.                      break;
  1746.                   case TndBlk:
  1747.                      prt_str(".vword.bptr = (union block *)",
  1748.                         IndentInc);
  1749.                      break;
  1750.                   }
  1751.                c_walk(sym->u.tnd_var.init, 2 * IndentInc, 0);
  1752.                prt_str(";", 2 * IndentInc);
  1753.                ForceNl();
  1754.                }
  1755.             }
  1756.          /*
  1757.           * If there are no declarations, suppress braces that
  1758.           *  may be required for a one-statement body; we already
  1759.           *  have a set.
  1760.           */
  1761.          if (n->u[0].child == NULL && n->u[1].sym == NULL)
  1762.             fall_thru = c_walk(n->u[2].child, indent, 1);
  1763.          else
  1764.             fall_thru = c_walk(n->u[2].child, indent, 0);
  1765.          if (!brace) {
  1766.             ForceNl();
  1767.             prt_str("}", indent);
  1768.             }
  1769.          return fall_thru;
  1770.       case TrnryNd:
  1771.          switch (t->tok_id) {
  1772.             case '?':
  1773.                /*
  1774.                 * <expr> ? <expr> : <expr>
  1775.                 */
  1776.                c_walk(n->u[0].child, indent, 0);
  1777.                prt_str(" ", indent);
  1778.                prt_tok(t, indent);  /* ? */
  1779.                prt_str(" ", indent);
  1780.                c_walk(n->u[1].child, indent, 0);
  1781.                prt_str(" : ", indent);
  1782.                c_walk(n->u[2].child, indent, 0);
  1783.                return 1;
  1784.             case If:
  1785.                /*
  1786.                 * if ( <expr> ) <statement>
  1787.                 * if ( <expr> ) <statement> else <statement>
  1788.                 */
  1789.                prt_tok(t, indent);  /* if */
  1790.                prt_str(" (", indent);
  1791.                c_walk(n->u[0].child, indent + IndentInc, 0);
  1792.                prt_str(") ", indent);
  1793.                fall_thru = c_walk(n->u[1].child, indent + IndentInc, 0);
  1794.                n1 = n->u[2].child;
  1795.                if (n1 == NULL)
  1796.                   fall_thru = 1;
  1797.                else {
  1798.                   /*
  1799.                    * There is an else statement. Don't indent an
  1800.                    *  "else if"
  1801.                    */
  1802.                   ForceNl();
  1803.                   prt_str("else ", indent);
  1804.                   if (n1->nd_id == TrnryNd && n1->tok->tok_id == If)
  1805.                      fall_thru |= c_walk(n1, indent, 0);
  1806.                   else
  1807.                      fall_thru |= c_walk(n1, indent + IndentInc, 0);
  1808.                   }
  1809.                return fall_thru;
  1810.             case Type_case:
  1811.                /*
  1812.                 * type_case <expr> of { <section-list> }
  1813.                 * type_case <expr> of { <section-list> <default-clause> }
  1814.                 */
  1815.                return typ_case(n->u[0].child, n->u[1].child, n->u[2].child,
  1816.                   c_walk, 1, indent);
  1817.             case Cnv:
  1818.                /*
  1819.                 * cnv : <type> ( <source> , <destination> )
  1820.                 */
  1821.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
  1822.                   n->u[2].child,
  1823.                   indent);
  1824.                return 1;
  1825.             }
  1826.       case QuadNd:
  1827.          switch (t->tok_id) {
  1828.             case For:
  1829.                /*
  1830.                 * for ( <expr> ; <expr> ; <expr> ) <statement>
  1831.                 */
  1832.                prt_tok(t, indent);  /* for */
  1833.                prt_str(" (", indent);
  1834.                c_walk(n->u[0].child, indent, 0);
  1835.                prt_str("; ", indent);
  1836.                c_walk(n->u[1].child, indent, 0);
  1837.                prt_str("; ", indent);
  1838.                c_walk(n->u[2].child, indent, 0);
  1839.                prt_str(") ", indent);
  1840.                save_break = does_break;
  1841.                c_walk(n->u[3].child, indent + IndentInc, 0);
  1842.                if (n->u[1].child == NULL && !does_break)
  1843.                   fall_thru = 0;
  1844.                else
  1845.                   fall_thru = 1;
  1846.                does_break = save_break;
  1847.                return fall_thru;
  1848.             case Def:
  1849.                /*
  1850.                 * def : <type> ( <source> , <default> , <destination> )
  1851.                 */
  1852.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
  1853.                   n->u[3].child, indent);
  1854.                return 1;
  1855.             }
  1856.       }
  1857.    }
  1858.  
  1859. /*
  1860.  * call_ret - decide whether a function being called might return.
  1861.  */
  1862. int call_ret(n)
  1863. struct node *n;
  1864.    {
  1865.    /*
  1866.     * Assume functions return except for c_exit(), fatalerr(), and syserr().
  1867.     */
  1868.    if (n->tok != NULL &&
  1869.       (strcmp("c_exit",   n->tok->image) == 0 ||
  1870.        strcmp("fatalerr", n->tok->image) == 0 ||
  1871.        strcmp("syserr",   n->tok->image) == 0))
  1872.       return 0;
  1873.    else
  1874.       return 1;
  1875.    }
  1876.  
  1877. /*
  1878.  * new_prmloc - allocate an array large enough to hold a flag for every
  1879.  *  parameter of the current operation. This flag indicates where
  1880.  *  the parameter is in terms of scopes created by conversions.
  1881.  */
  1882. struct parminfo *new_prmloc()
  1883.    {
  1884.    struct parminfo *parminfo;
  1885.    int nparams;
  1886.    int i;
  1887.  
  1888.    if (params == NULL)
  1889.       return NULL;
  1890.    nparams = params->u.param_info.param_num + 1;
  1891.    parminfo = (struct parminfo *)alloc((unsigned)nparams *
  1892.      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. novalue 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. novalue 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. novalue 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. novalue 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)Params((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 novalue 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.    struct sym_entry *sym;
  2346.    int fall_thru;
  2347.  
  2348.    if (n == NULL)
  2349.       return 1;
  2350.  
  2351.    t =  n->tok;
  2352.  
  2353.    switch (n->nd_id) {
  2354.       case PrefxNd:
  2355.          switch (t->tok_id) {
  2356.             case '{':
  2357.                /*
  2358.                 * RTL code: { <actions> }
  2359.                 */
  2360.                if (brace) 
  2361.                   tok_line(t, indent); /* just synch file name and line num */
  2362.                else
  2363.                   prt_tok(t, indent);  /* { */
  2364.                fall_thru = rt_walk(n->u[0].child, indent, 1);
  2365.                if (!brace)
  2366.                   prt_str("}", indent);
  2367.                return fall_thru;
  2368.             case '!':
  2369.                /*
  2370.                 * RTL type-checking and conversions: ! <simple-type-check>
  2371.                 */
  2372.                prt_tok(t, indent);
  2373.                rt_walk(n->u[0].child, indent, 0);
  2374.                return 1;
  2375.             case Body:
  2376.             case Inline:
  2377.                /*
  2378.                 * RTL code: body { <c-code> }
  2379.                 *           inline { <c-code> }
  2380.                 */
  2381.                fall_thru = c_walk(n->u[0].child, indent, brace);
  2382.                if (!fall_thru)
  2383.                   clr_prmloc();
  2384.                return fall_thru;
  2385.             }
  2386.          break;
  2387.       case BinryNd:
  2388.          switch (t->tok_id) {
  2389.             case Runerr:
  2390.                /*
  2391.                 * RTL code: runerr( <message-number> )
  2392.                 *           runerr( <message-number>, <descriptor> )
  2393.                 */
  2394.                prt_runerr(t, n->u[0].child, n->u[1].child, indent);
  2395.  
  2396.                /*
  2397.                 * Execution cannot continue on this execution path.
  2398.                 */
  2399.                clr_prmloc();
  2400.                return 0;
  2401.             case And:
  2402.                /*
  2403.                 * RTL type-checking and conversions:
  2404.                 *   <type-check> && <type_check>
  2405.                 */
  2406.                chk_conj(n->u[0].child);  /* is a warning needed? */
  2407.                rt_walk(n->u[0].child, indent, 0);
  2408.                prt_str(" ", indent);
  2409.                prt_tok(t, indent);       /* && */
  2410.                prt_str(" ", indent);
  2411.                rt_walk(n->u[1].child, indent, 0);
  2412.                return 1;
  2413.             case Is:
  2414.                /*
  2415.                 * RTL type-checking and conversions:
  2416.                 *   is: <icon-type> ( <variable> )
  2417.                 */
  2418.                typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
  2419.                   n->u[0].child->tok, indent);
  2420.                return 1;
  2421.             }
  2422.          break;
  2423.       case ConCatNd:
  2424.          /*
  2425.           * "Glue" for two constructs.
  2426.           */
  2427.          fall_thru = rt_walk(n->u[0].child, indent, 0);
  2428.          return fall_thru & rt_walk(n->u[1].child, indent, 0);
  2429.       case AbstrNd:
  2430.          /*
  2431.           * Ignore abstract type computations while producing C code
  2432.           *  for library routines.
  2433.           */
  2434.          return 1;
  2435.       case TrnryNd:
  2436.          switch (t->tok_id) {
  2437.             case If: {
  2438.                /*
  2439.                 * RTL code for "if" statements:
  2440.                 *  if <type-check> then <action>
  2441.                 *  if <type-check> then <action> else <action>
  2442.                 *
  2443.                 *  <type-check> may include parameter conversions that create
  2444.                 *  new scoping. It is necessary to keep track of paramter
  2445.                 *  types and locations along success and failure paths of
  2446.                 *  these conversions. The "then" and "else" actions may
  2447.                 *  also establish new scopes.
  2448.                 */
  2449.                struct parminfo *then_prms = NULL;
  2450.                struct parminfo *else_prms;
  2451.  
  2452.                /*
  2453.                 * Save the current parameter locations. These are in
  2454.                 *  effect on the failure path of any type conversions
  2455.                 *  in the condition of the "if".
  2456.                 */
  2457.                else_prms = new_prmloc();
  2458.                sv_prmloc(else_prms);
  2459.  
  2460.                prt_tok(t, indent);       /* if */
  2461.                prt_str(" (", indent);
  2462.                n1 = n->u[0].child;
  2463.                rt_walk(n1, indent + IndentInc, 0);   /* type check */
  2464.                prt_str(") {", indent);
  2465.  
  2466.                /*
  2467.                 * If the condition is negated, the failure path is to the "then"
  2468.                 *  and the success path is to the "else".
  2469.                 */
  2470.                if (n1->nd_id == PrefxNd && n1->tok->tok_id == '!') {
  2471.                   then_prms = else_prms;
  2472.                   else_prms = new_prmloc();
  2473.                   sv_prmloc(else_prms);
  2474.                   ld_prmloc(then_prms);
  2475.                   }
  2476.  
  2477.                /*
  2478.                 * Then Clause.
  2479.                 */
  2480.                fall_thru = rt_walk(n->u[1].child, indent + IndentInc, 1);
  2481.                ForceNl();
  2482.                prt_str("}", indent + IndentInc);
  2483.  
  2484.                /*
  2485.                 * Determine if there is an else clause and merge parameter
  2486.                 *  location information from the alternate paths through
  2487.                 *  the statement.
  2488.                 */
  2489.                n1 = n->u[2].child;
  2490.                if (n1 == NULL) {
  2491.                   if (fall_thru)
  2492.                      mrg_prmloc(else_prms);
  2493.                   ld_prmloc(else_prms);
  2494.                   fall_thru = 1;
  2495.                   }
  2496.                else {
  2497.                   if (then_prms == NULL)
  2498.                      then_prms = new_prmloc();
  2499.                   if (fall_thru)
  2500.                      sv_prmloc(then_prms);
  2501.                   ld_prmloc(else_prms);
  2502.                   ForceNl();
  2503.                   prt_str("else {", indent);
  2504.                   if (rt_walk(n1, indent + IndentInc, 1)) {  /* else clause */
  2505.                      fall_thru = 1;
  2506.                      mrg_prmloc(then_prms);
  2507.                      }
  2508.                   ForceNl();
  2509.                   prt_str("}", indent + IndentInc);
  2510.                   ld_prmloc(then_prms);
  2511.                   }
  2512.                ForceNl();
  2513.                if (then_prms != NULL)
  2514.                   free(then_prms);
  2515.                if (else_prms != NULL)
  2516.                   free(else_prms);
  2517.                }
  2518.                return fall_thru;
  2519.             case Len_case: {
  2520.                /*
  2521.                 * RTL code:
  2522.                 *   len_case <variable> of {
  2523.                 *      <integer>: <action>
  2524.                 *        ...
  2525.                 *      default: <action>
  2526.                 *      }
  2527.                 */
  2528.                struct parminfo *strt_prms;
  2529.                struct parminfo *end_prms;
  2530.  
  2531.                /*
  2532.                 * A case may contain parameter conversions that create new
  2533.                 *  scopes. Remember the parameter locations at the start
  2534.                 *  of the len_case statement.
  2535.                 */
  2536.                strt_prms = new_prmloc();
  2537.                sv_prmloc(strt_prms);
  2538.                end_prms = new_prmloc();
  2539.  
  2540.                n1 = n->u[0].child;
  2541.                if (!(n1->u[0].sym->id_type & VArgLen))
  2542.                   errt1(t, "len_case must select on length of vararg");
  2543.  
  2544.                /*
  2545.                 * The len_case statement is implemented as a C switch
  2546.                 *  statement.
  2547.                 */
  2548.                prt_str("switch (", indent);
  2549.                prt_var(n1, indent);
  2550.                prt_str(") {", indent);
  2551.                ForceNl();
  2552.                fall_thru = 0;
  2553.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  2554.                   n1 = n1->u[0].child)
  2555.                      fall_thru |= len_sel(n1->u[1].child, strt_prms, end_prms,
  2556.                         indent + IndentInc);
  2557.                fall_thru |= len_sel(n1, strt_prms, end_prms,
  2558.                   indent + IndentInc);
  2559.  
  2560.                /*
  2561.                 * Handle default clause.
  2562.                 */
  2563.                prt_str("default:", indent + IndentInc);
  2564.                ForceNl();
  2565.                fall_thru |= rt_walk(n->u[2].child, indent + 2 * IndentInc, 0);
  2566.                ForceNl();
  2567.                prt_str("}", indent + IndentInc);
  2568.                ForceNl();
  2569.  
  2570.                /*
  2571.                 * Put into effect the location of parameters at the end
  2572.                 *  of the len_case statement.
  2573.                 */
  2574.                mrg_prmloc(end_prms);
  2575.                ld_prmloc(end_prms);
  2576.                if (strt_prms != NULL)
  2577.                   free(strt_prms);
  2578.                if (end_prms != NULL)
  2579.                   free(end_prms);
  2580.                }
  2581.                return fall_thru;
  2582.             case Type_case: {
  2583.                /*
  2584.                 * RTL code:
  2585.                 *   type_case <variable> of {
  2586.                 *       <icon_type> : ... <icon_type> : <action>
  2587.                 *          ...
  2588.                 *       }
  2589.                 *
  2590.                 *   last clause may be: default: <action>
  2591.                 */
  2592.                int maybe_var;
  2593.                struct node *var;
  2594.                struct sym_entry *sym;
  2595.  
  2596.                /*
  2597.                 * If we can determine that the value being checked is
  2598.                 *  not a variable reference, we don't have to produce code
  2599.                 *  to check for that possibility.
  2600.                 */
  2601.                maybe_var = 1;
  2602.                var = n->u[0].child;
  2603.                if (var->nd_id == SymNd) {
  2604.                   sym = var->u[0].sym;
  2605.                   switch(sym->id_type) {
  2606.                      case DrfPrm:
  2607.                      case OtherDcl:
  2608.                      case TndDesc:
  2609.                      case TndStr:
  2610.                      case RsltLoc:
  2611.                         if (sym->nest_lvl > 1) {
  2612.                            /*
  2613.                             * The thing being tested is either a
  2614.                             *  dereferenced parameter or a local
  2615.                             *  descriptor which could only have been
  2616.                             *  set by a conversion which does not
  2617.                             *  produce a variable reference.
  2618.                             */
  2619.                            maybe_var = 0;
  2620.                            }
  2621.                       }
  2622.                   }
  2623.                return typ_case(var, n->u[1].child, n->u[2].child, rt_walk,
  2624.                   maybe_var, indent);
  2625.                }
  2626.             case Cnv:
  2627.                /*
  2628.                 * RTL code: cnv: <type> ( <source> )
  2629.                 *           cnv: <type> ( <source> , <destination> )
  2630.                 */
  2631.                cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
  2632.                   n->u[2].child, indent);
  2633.                return 1;
  2634.             case Arith_case: {
  2635.                /*
  2636.                 * arith_case (<variable>, <variable>) of {
  2637.                 *   C_integer: <statement>
  2638.                 *   integer: <statement>
  2639.                 *   C_double: <statement>
  2640.                 *   }
  2641.                 *
  2642.                 * This construct does type conversions and provides
  2643.                 *  alternate execution paths. It is necessary to keep
  2644.                 *  track of parameter locations.
  2645.                 */
  2646.                struct parminfo *strt_prms;
  2647.                struct parminfo *end_prms;
  2648.                struct parminfo *tmp_prms;
  2649.  
  2650.                strt_prms = new_prmloc();
  2651.                sv_prmloc(strt_prms);
  2652.                end_prms = new_prmloc();
  2653.                tmp_prms = new_prmloc();
  2654.  
  2655.                fall_thru = 0;
  2656.  
  2657.                n1 = n->u[2].child;   /* contains actions for the 3 cases */
  2658.  
  2659.                /*
  2660.                 * Set up an error number node for use in runerr().
  2661.                 */
  2662.                t1 = copy_t(t);
  2663.                t1->tok_id = IntConst;
  2664.                t1->image = "102";
  2665.                errnum = node0(PrimryNd, t1);
  2666.  
  2667.                /*
  2668.                 * Try converting both arguments to a C_integer.
  2669.                 */
  2670.                tok_line(t, indent);
  2671.                prt_str("if (", indent);
  2672.                cnv_fnc(t, TypECInt, n->u[0].child, NULL, NULL, indent);
  2673.                prt_str(" && ", indent);
  2674.                cnv_fnc(t, TypECInt, n->u[1].child, NULL, NULL, indent);
  2675.                prt_str(") ", indent);
  2676.                ForceNl();
  2677.                if (rt_walk(n1->u[0].child, indent + IndentInc, 0)) {
  2678.                   fall_thru |= 1;
  2679.                   mrg_prmloc(end_prms);
  2680.                   }
  2681.                ForceNl();
  2682.  
  2683.                /*
  2684.                 * Try converting both arguments to an integer.
  2685.                 */
  2686.                prt_str("#ifdef LargeInts", 0);
  2687.                ForceNl();
  2688.                ld_prmloc(strt_prms);
  2689.                tok_line(t, indent);
  2690.                prt_str("else if (", indent);
  2691.                cnv_fnc(t, TypEInt, n->u[0].child, NULL, NULL, indent);
  2692.                prt_str(" && ", indent);
  2693.                cnv_fnc(t, TypEInt, n->u[1].child, NULL, NULL, indent);
  2694.                prt_str(") ", indent);
  2695.                ForceNl();
  2696.                if (rt_walk(n1->u[1].child, indent + IndentInc, 0)) {
  2697.                   fall_thru |= 1;
  2698.                   mrg_prmloc(end_prms);
  2699.                   }
  2700.                ForceNl();
  2701.                prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
  2702.                ForceNl();
  2703.  
  2704.                /*
  2705.                 * Try converting both arguments to a C_double
  2706.                 */
  2707.                ld_prmloc(strt_prms);
  2708.                prt_str("else {", indent);
  2709.                ForceNl();
  2710.                tok_line(t, indent + IndentInc);
  2711.                prt_str("if (!", indent + IndentInc);
  2712.                cnv_fnc(t, TypCDbl, n->u[0].child, NULL, NULL,
  2713.                   indent + IndentInc);
  2714.                prt_str(")", indent + IndentInc);
  2715.                ForceNl();
  2716.                sv_prmloc(tmp_prms);   /* use original parm locs for error */
  2717.                ld_prmloc(strt_prms);
  2718.                prt_runerr(t, errnum, n->u[0].child, indent + 2 * IndentInc);
  2719.                ld_prmloc(tmp_prms);
  2720.                tok_line(t, indent + IndentInc);
  2721.                prt_str("if (!", indent + IndentInc);
  2722.                cnv_fnc(t, TypCDbl, n->u[1].child, NULL, NULL,
  2723.                   indent + IndentInc);
  2724.                prt_str(") ", indent + IndentInc);
  2725.                ForceNl();
  2726.                sv_prmloc(tmp_prms);   /* use original parm locs for error */
  2727.                ld_prmloc(strt_prms);
  2728.                prt_runerr(t, errnum, n->u[1].child, indent + 2 * IndentInc);
  2729.                ld_prmloc(tmp_prms);
  2730.                if (rt_walk(n1->u[2].child, indent + IndentInc, 0)) {
  2731.                   fall_thru |= 1;
  2732.                   mrg_prmloc(end_prms);
  2733.                   }
  2734.                ForceNl();
  2735.                prt_str("}", indent + IndentInc);
  2736.                ForceNl();
  2737.  
  2738.                ld_prmloc(end_prms);
  2739.                free(strt_prms);
  2740.                free(end_prms);
  2741.                free(tmp_prms);
  2742.                free_tree(errnum);
  2743.                return fall_thru;
  2744.                }
  2745.             }
  2746.       case QuadNd:
  2747.          /*
  2748.           * RTL code: def: <type> ( <source> , <default>)
  2749.           *           def: <type> ( <source> , <default> , <destination> )
  2750.           */
  2751.          cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
  2752.             n->u[3].child, indent);
  2753.          return 1;
  2754.       }
  2755.    }
  2756.  
  2757. /*
  2758.  * spcl_dcls - print special declarations for tended variables, parameter
  2759.  *  conversions, and buffers.
  2760.  */
  2761. novalue 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((msize)(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 novalue 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 novalue 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 novalue 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 novalue 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 novalue 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.    }
  3165.  
  3166. /*
  3167.  * tdef_or_extr - see if this is a typedef or extern.
  3168.  */
  3169. static int tdef_or_extr(n)
  3170. struct node *n;
  3171.    {
  3172.    switch (n->nd_id) {
  3173.       case LstNd:
  3174.          return tdef_or_extr(n->u[0].child) | tdef_or_extr(n->u[1].child);
  3175.       case BinryNd:
  3176.          /*
  3177.           * struct, union, or enum.
  3178.           */
  3179.          return 0;
  3180.       case PrimryNd:
  3181.          if (n->tok->tok_id == Extern || n->tok->tok_id == Typedef)
  3182.             return 1;
  3183.          else
  3184.             return 0;
  3185.       }
  3186.    err1("rtt internal error detected in function tdef_or_extr()");
  3187.    /* NOTREACHED */
  3188.    }
  3189.  
  3190. /*
  3191.  * dclout - output an ordinary global C declaration.
  3192.  */
  3193. novalue dclout(n)
  3194. struct node *n;
  3195.    {
  3196.    if (!enable_out)
  3197.       return;        /* output disabled */
  3198.    if (real_def(n))
  3199.       def_fnd = 1;   /* this declaration defines a run-time object */
  3200.    c_walk(n, 0, 0);
  3201.    free_tree(n);
  3202.    }
  3203.  
  3204. /*
  3205.  * fncout - output code for a C function.
  3206.  */
  3207. novalue fncout(head, prm_dcl, block)
  3208. struct node *head;
  3209. struct node *prm_dcl;
  3210. struct node *block;
  3211.    {
  3212.    if (!enable_out)
  3213.       return;       /* output disabled */
  3214.  
  3215.    def_fnd = 1;     /* this declaration defines a run-time object */
  3216.  
  3217.    nxt_sbuf = 0;    /* clear number of string buffers */
  3218.    nxt_cbuf = 0;    /* clear number of cset buffers */
  3219.  
  3220.    /*
  3221.     * Output the function header and the parameter declarations.
  3222.     */
  3223.    fnc_head = head;
  3224.    c_walk(head, 0, 0);
  3225.    prt_str(" ",  0);
  3226.    c_walk(prm_dcl, 0, 0);
  3227.    prt_str(" ", 0);
  3228.  
  3229.    /* 
  3230.     * Handle outer block.
  3231.     */
  3232.    prt_tok(block->tok, IndentInc);          /* { */
  3233.    c_walk(block->u[0].child, IndentInc, 0); /* non-tended declarations */
  3234.    spcl_dcls(NULL);                         /* tended declarations */
  3235.    no_ret_val = 1;
  3236.    c_walk(block->u[2].child, IndentInc, 0); /* statement list */
  3237.    if (ntend != 0 && no_ret_val) {
  3238.       /*
  3239.        * This function contains no return statements with values, assume
  3240.        *  that the programmer is using the implicit return at the end
  3241.        *  of the function and update the tending of descriptors.
  3242.        */
  3243.       untend(IndentInc);
  3244.       }
  3245.    ForceNl();
  3246.    prt_str("}", IndentInc);
  3247.    ForceNl();
  3248.  
  3249.    /*
  3250.     * free storage.
  3251.     */
  3252.    free_tree(head);
  3253.    free_tree(prm_dcl);
  3254.    free_tree(block);
  3255.    pop_cntxt();
  3256.    clr_def();
  3257.    }
  3258.  
  3259. /*
  3260.  * defout - output operation definitions (except for constant keywords)
  3261.  */
  3262. novalue defout(n)
  3263. struct node *n;
  3264.    {
  3265.    struct sym_entry *sym, *sym1;
  3266.  
  3267.    if (!enable_out)
  3268.       return;       /* output disabled */
  3269.  
  3270.    nxt_sbuf = 0;
  3271.    nxt_cbuf = 0;
  3272.  
  3273.    /*
  3274.     * Somewhat different code is produced for the interpreter and compiler.
  3275.     */
  3276.    if (iconx_flg)
  3277.       interp_def(n);
  3278.    else
  3279.       comp_def(n);
  3280.  
  3281.    free_tree(n);
  3282.    /*
  3283.     * The declarations for the declare statement are not associated with
  3284.     *  any compound statement and must be freed here.
  3285.     */
  3286.    sym = dcl_stk->tended;
  3287.    while (sym != NULL) {
  3288.       sym1 = sym;
  3289.       sym = sym->u.tnd_var.next;
  3290.       free_sym(sym1);
  3291.       }
  3292.    while (decl_lst != NULL) {
  3293.       sym1 = decl_lst;
  3294.       decl_lst = decl_lst->u.declare_var.next;
  3295.       free_sym(sym1);
  3296.       }
  3297.    op_type = OrdFunc;
  3298.    pop_cntxt();
  3299.    clr_def();
  3300.    }
  3301.  
  3302. /*
  3303.  * comp_def - output code for the compiler for operation definitions.
  3304.  */
  3305. static novalue comp_def(n)
  3306. struct node *n;
  3307.    {
  3308. #ifdef Rttx
  3309.    fprintf(stdout, "rtt was compiled to only support the interpreter, use -x\n");
  3310.    exit(ErrorExit);
  3311. #else                    /* Rttx */
  3312.    struct sym_entry *sym;
  3313.    struct node *n1;
  3314.    FILE *f_save;
  3315.  
  3316. #if MVS
  3317.    char buf1[MaxFileName];
  3318. #else                                   /* MVS */
  3319.    char buf1[5];
  3320. #endif                                  /* MVS */
  3321.  
  3322.    char buf[MaxFileName];
  3323.    char *cname;
  3324.    long min_result;
  3325.    long max_result;
  3326.    int ret_flag;
  3327.    int resume;
  3328.    char *name;
  3329.    char *s;
  3330.  
  3331.    f_save = out_file;
  3332.  
  3333.    /*
  3334.     * Note if the result location is explicitly referenced and note
  3335.     *  how it is accessed in the generated code.
  3336.     */
  3337.    cur_impl->use_rslt = sym_lkup(str_rslt)->u.referenced;
  3338.    rslt_loc = "(*r_rslt)";
  3339.  
  3340.    /*
  3341.     * In several contexts, letters are used to distinguish kinds of operations.
  3342.     */
  3343.    switch (op_type) {
  3344.       case Function:
  3345.          lc_letter = 'f';
  3346.          uc_letter = 'F';
  3347.          break;
  3348.       case Keyword:
  3349.          lc_letter = 'k';
  3350.          uc_letter = 'K';
  3351.          break;
  3352.       case Operator:
  3353.          lc_letter = 'o';
  3354.          uc_letter = 'O';
  3355.       }
  3356.    prfx1 = cur_impl->prefix[0];
  3357.    prfx2 = cur_impl->prefix[1];
  3358.  
  3359.    if (op_type != Keyword) {
  3360.       /*
  3361.        * First pass through the operation: produce most general routine.
  3362.        */
  3363.       fnc_ret = RetSig;  /* most general routine always returns a signal */
  3364.  
  3365.       /*
  3366.        * Compute the file name in which to output the function.
  3367.        */
  3368. #if MVS
  3369.    {
  3370.       struct fileparts *fp;
  3371.       fp = fparse(src_file_nm);
  3372.       if (*fp->member == '\0')
  3373.          sprintf(buf1, "%c#%c%c", lc_letter, prfx1, prfx2);
  3374.       else
  3375.          sprintf(buf1, "%s%s.ro.c(%c#%c%c)", fp->dir, fp->name,
  3376.                  lc_letter, prfx1, prfx2);
  3377.       }
  3378. #else                                   /* MVS */
  3379.       sprintf(buf1, "%c_%c%c", lc_letter, prfx1, prfx2);
  3380. #endif                                  /* MVS */
  3381.  
  3382.       cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
  3383.       if ((out_file = fopen(cname, "w")) == NULL)
  3384.          err2("cannot open output file", cname);
  3385.       else
  3386.          addrmlst(cname);
  3387.          
  3388.       prologue(); /* output standard comments and preprocessor directives */
  3389.  
  3390.       /*
  3391.        * Output function header that corresponds to standard calling
  3392.        *  convensions. The function name is constructed from the letter
  3393.        *  for the operation type, the prefix that makes the function
  3394.        *  name unique, and the name of the operation.
  3395.        */
  3396.       fprintf(out_file, "int %c%c%c_%s(r_nargs, r_args, r_rslt, r_s_cont)\n",
  3397.          uc_letter, prfx1, prfx2, cur_impl->name);
  3398.       fprintf(out_file, "int r_nargs;\n");
  3399.       fprintf(out_file, "dptr r_args;\n");
  3400.       fprintf(out_file, "dptr r_rslt;\n");
  3401.       fprintf(out_file, "continuation r_s_cont;");
  3402.       fname = cname;
  3403.       line = 12;
  3404.       ForceNl();
  3405.       prt_str("{", IndentInc);
  3406.       ForceNl();
  3407.  
  3408.       /*
  3409.        * Output ordinary declarations from declare clause.
  3410.        */
  3411.       for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  3412.          c_walk(sym->u.declare_var.tqual, IndentInc, 0);
  3413.          prt_str(" ", IndentInc);
  3414.          c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
  3415.          if ((n1 = sym->u.declare_var.init) != NULL) {
  3416.             prt_str(" = ", IndentInc);
  3417.             c_walk(n1, IndentInc, 0);
  3418.             }
  3419.          prt_str(";", IndentInc);
  3420.          }
  3421.  
  3422.       /*
  3423.        * Output code for special declarations along with code to initial
  3424.        *  them. This includes buffers and tended locations for parameters
  3425.        *  and tended variables.
  3426.        */
  3427.       spcl_dcls(params);
  3428.  
  3429.       if (rt_walk(n, IndentInc, 0)) {  /* body of operation */
  3430.          if (n->nd_id == ConCatNd)
  3431.             s = n->u[1].child->tok->fname;
  3432.          else
  3433.             s = n->tok->fname;
  3434.          fprintf(stderr, "%s: file %s, warning: ", progname, s);
  3435.          fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
  3436.              cur_impl->name);
  3437.          }
  3438.  
  3439.       ForceNl();
  3440.       prt_str("}\n", IndentInc);
  3441.       if (fclose(out_file) != 0)
  3442.          err2("cannot close ", cname);
  3443.       put_c_fl(cname, 1);  /* note name of output file for operation */
  3444.       }
  3445.  
  3446.    /*
  3447.     * Second pass through operation: produce in-line code and special purpose
  3448.     *  routines.
  3449.     */
  3450.    for (sym = params; sym != NULL; sym = sym->u.param_info.next)
  3451.       if (sym->id_type & DrfPrm)
  3452.          sym->u.param_info.cur_loc = PrmTend;  /* reset location of parameter */
  3453.    in_line(n);
  3454.  
  3455.    /*
  3456.     * Insure that the fail/return/suspend statements are consistent
  3457.     *  with the result sequence indicated.
  3458.     */
  3459.    min_result = cur_impl->min_result;
  3460.    max_result = cur_impl->max_result;
  3461.    ret_flag = cur_impl->ret_flag;
  3462.    resume = cur_impl->resume;
  3463.    name = cur_impl->name;
  3464.    if (min_result == NoRsltSeq && ret_flag & (DoesFail|DoesRet|DoesSusp))
  3465.       err2(name,
  3466.          ": result sequence of {}, but fail, return, or suspend present");
  3467.    if (min_result != NoRsltSeq && ret_flag == 0)
  3468.       err2(name,
  3469.          ": result sequence indicated, no fail, return, or suspend present");
  3470.    if (max_result != NoRsltSeq) {
  3471.       if (max_result == 0 && ret_flag & (DoesRet|DoesSusp))
  3472.          err2(name,
  3473.             ": result sequence of 0 length, but return or suspend present");
  3474.       if (max_result != 0 && !(ret_flag & (DoesRet | DoesSusp)))
  3475.          err2(name,
  3476.             ": result sequence length > 0, but no return or suspend present");
  3477.       if ((max_result == UnbndSeq || max_result > 1 || resume) &&
  3478.          !(ret_flag & DoesSusp))
  3479.          err2(name,
  3480.             ": result sequence indicates suspension, but no suspend present");
  3481.       if ((max_result != UnbndSeq && max_result <= 1 && !resume) &&
  3482.          ret_flag & DoesSusp)
  3483.          err2(name,
  3484.             ": result sequence indicates no suspension, but suspend present");
  3485.       }
  3486.    if (min_result != NoRsltSeq && max_result != UnbndSeq &&
  3487.       min_result > max_result)
  3488.       err2(name, ": minimum result sequence length greater than maximum");
  3489.  
  3490.    out_file = f_save;
  3491. #endif                    /* Rttx */
  3492.    }
  3493.  
  3494. /*
  3495.  * interp_def - output code for the interpreter for operation definitions.
  3496.  */
  3497. static novalue interp_def(n)
  3498. struct node *n;
  3499.    {
  3500.    struct sym_entry *sym;
  3501.    struct node *n1;
  3502.    int nparms;
  3503.    int has_underef;
  3504.    char letter;
  3505.    char *name;
  3506.    char *s;
  3507.  
  3508.    /*
  3509.     * Note how result location is accessed in generated code.
  3510.     */
  3511.    rslt_loc = "r_args[0]";
  3512.  
  3513.    /*
  3514.     * Determine if the operation has any undereferenced parameters.
  3515.     */
  3516.    has_underef = 0;
  3517.    for (sym = params; sym != NULL; sym = sym->u.param_info.next)
  3518.       if (sym->id_type  & RtParm) {
  3519.          has_underef = 1;
  3520.          break;
  3521.          }
  3522.  
  3523.    /*
  3524.     * Determine the nuber of parameters. A negative value is used
  3525.     *  to indicate an operation that takes a variable number of
  3526.     *  arguments.
  3527.     */
  3528.    if (params == NULL)
  3529.       nparms = 0;
  3530.    else {
  3531.       nparms = params->u.param_info.param_num + 1;
  3532.       if (params->id_type & VarPrm)
  3533.          nparms = -nparms;
  3534.       }
  3535.  
  3536.    fnc_ret = RetSig;  /* interpreter routine always returns a signal */
  3537.    name = cur_impl->name;
  3538.  
  3539.    /*
  3540.     * Determine what letter is used to prefix the operation name.
  3541.     */
  3542.    switch (op_type) {
  3543.       case Function:
  3544.  
  3545. #if VMS
  3546.          letter = 'Y';
  3547. #else                    /* VMS */
  3548.          letter = 'Z';
  3549. #endif                    /* VMS */
  3550.  
  3551.          break;
  3552.       case Keyword:
  3553.          letter = 'K';
  3554.          break;
  3555.       case Operator:
  3556.          letter = 'O';
  3557.          }
  3558.  
  3559.    fprintf(out_file, "\n");
  3560.    if (op_type != Keyword) {
  3561.       /*
  3562.        * Output prototype. Operations taking a variable number of arguments
  3563.        *   have an extra parameter: the number of arguments.
  3564.        */
  3565.       fprintf(out_file, "int %c%s Params((", letter, name);
  3566.       if (params != NULL && (params->id_type & VarPrm))
  3567.          fprintf(out_file, "int r_nargs, ");
  3568.       fprintf(out_file, "dptr r_args));\n");
  3569.       ++line;
  3570.  
  3571.       /*
  3572.        * Output procedure block.
  3573.        */
  3574.       switch (op_type) {
  3575.          case Function:
  3576.             fprintf(out_file, "FncBlock(%s, %d, %d)\n\n", name, nparms, 
  3577.                (has_underef ? -1 : 0));
  3578.             ++line;
  3579.             break;
  3580.          case Operator:
  3581.             if (strcmp(cur_impl->op,"\\") == 0)
  3582.                fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
  3583.                   "\\\\");
  3584.             else
  3585.                fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
  3586.                   cur_impl->op);
  3587.             ++line;
  3588.          }
  3589.       }
  3590.  
  3591.    /*
  3592.     * Output function header. Operations taking a variable number of arguments
  3593.     *   have an extra parameter: the number of arguments.
  3594.     */
  3595.    fprintf(out_file, "int %c%s(", letter, name);
  3596.    if (params != NULL && (params->id_type & VarPrm))
  3597.       fprintf(out_file, "r_nargs, ");
  3598.    fprintf(out_file, "r_args)\n");
  3599.    ++line;
  3600.    if (params != NULL && (params->id_type & VarPrm)) {
  3601.       fprintf(out_file, "int r_nargs;\n");
  3602.       ++line;
  3603.       }
  3604.    fprintf(out_file, "dptr r_args;");
  3605.    ++line;
  3606.    ForceNl();
  3607.    prt_str("{", IndentInc);
  3608.       
  3609.    /*
  3610.     * Output ordinary declarations from the declare clause.
  3611.     */
  3612.    ForceNl();
  3613.    for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  3614.       c_walk(sym->u.declare_var.tqual, IndentInc, 0);
  3615.       prt_str(" ", IndentInc);
  3616.       c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
  3617.       if ((n1 = sym->u.declare_var.init) != NULL) {
  3618.          prt_str(" = ", IndentInc);
  3619.          c_walk(n1, IndentInc, 0);
  3620.          }
  3621.       prt_str(";", IndentInc);
  3622.       }
  3623.  
  3624.    /*
  3625.     * Output special declarations and initial processing.
  3626.     */
  3627.    tendstrct = "r_tend";
  3628.    spcl_start(params);
  3629.    tend_ary(ntend);
  3630.    if (has_underef && params != NULL && params->id_type == (VarPrm | DrfPrm))
  3631.       prt_str("int r_n;\n", IndentInc);
  3632.    tend_init();
  3633.  
  3634.    /*
  3635.     * See which parameters need to be dereferenced. If all are dereferenced,
  3636.     *  it is done by before the routine is called.
  3637.     */
  3638.    if (has_underef) {
  3639.       sym = params;
  3640.       if (sym != NULL && sym->id_type & VarPrm) {
  3641.          if (sym->id_type & DrfPrm) {
  3642.             /*
  3643.              * There is a variable part of the parameter list and it
  3644.              *  must be dereferenced.
  3645.              */
  3646.             prt_str("for (r_n = ", IndentInc);
  3647.             fprintf(out_file, "%d; r_n <= r_nargs; ++r_n)",
  3648.                 sym->u.param_info.param_num + 1);
  3649.             ForceNl();
  3650.             prt_str("Deref(r_args[r_n]);", IndentInc * 2);
  3651.             ForceNl();
  3652.             }
  3653.          sym = sym->u.param_info.next;
  3654.          }
  3655.  
  3656.       /*
  3657.        * Produce code to dereference any fixed parameters that need to be.
  3658.        */
  3659.       while (sym != NULL) {
  3660.          if (sym->id_type & DrfPrm) {
  3661.             /*
  3662.              * Tended index of -1 indicates that the parameter can be
  3663.              *  dereferened in-place (this is the usual case).
  3664.              */
  3665.             if (sym->t_indx == -1) {
  3666.                prt_str("Deref(r_args[", IndentInc * 2);
  3667.                fprintf(out_file, "%d]);", sym->u.param_info.param_num + 1);
  3668.                }
  3669.             else {
  3670.                prt_str("deref(&r_args[", IndentInc * 2);
  3671.                fprintf(out_file, "%d], &r_tend.d[%d]);",
  3672.                   sym->u.param_info.param_num + 1, sym->t_indx);
  3673.                }
  3674.             }
  3675.          ForceNl();
  3676.          sym = sym->u.param_info.next;
  3677.          }
  3678.       }
  3679.  
  3680.    /*
  3681.     * Finish setting up the tended array structure and link it into the tended
  3682.     *  list.
  3683.     */
  3684.    if (ntend != 0) {
  3685.       prt_str("r_tend.num = ", IndentInc);
  3686.       fprintf(out_file, "%d;", ntend);
  3687.       ForceNl();
  3688.       prt_str("r_tend.previous = tend;", IndentInc);
  3689.       ForceNl();
  3690.       prt_str("tend = (struct tend_desc *)&r_tend;", IndentInc);
  3691.       ForceNl();
  3692.       }
  3693.  
  3694.    if (rt_walk(n, IndentInc, 0)) { /* body of operation */
  3695.       if (n->nd_id == ConCatNd)
  3696.          s = n->u[1].child->tok->fname;
  3697.       else
  3698.          s = n->tok->fname;
  3699.       fprintf(stderr, "%s: file %s, warning: ", progname, s);
  3700.       fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
  3701.           cur_impl->name);
  3702.       }
  3703.    ForceNl();
  3704.    prt_str("}\n", IndentInc);
  3705.    }
  3706.  
  3707. /*
  3708.  * keyconst - produce code for a constant keyword.
  3709.  */
  3710. novalue keyconst(t)
  3711. struct token *t;
  3712.    {
  3713.    struct il_code *il;
  3714.    int n;
  3715.  
  3716.    if (iconx_flg) {
  3717.       /*
  3718.        * For the interpreter, output a C function implementing the keyword.
  3719.        */
  3720.       rslt_loc = "r_args[0]";  /* result location */
  3721.  
  3722.       fprintf(out_file, "\n");
  3723.       fprintf(out_file, "int K%s(r_args)\n", cur_impl->name);
  3724.       fprintf(out_file, "dptr r_args;");
  3725.       line += 2;
  3726.       ForceNl();
  3727.       prt_str("{", IndentInc);
  3728.       ForceNl();
  3729.       switch (t->tok_id) {
  3730.          case StrLit:
  3731.             prt_str(rslt_loc, IndentInc);
  3732.             prt_str(".vword.sptr = \"", IndentInc);
  3733.             n = prt_i_str(out_file, t->image, (int)strlen(t->image));
  3734.             prt_str("\";", IndentInc);
  3735.             ForceNl();
  3736.             prt_str(rslt_loc, IndentInc);
  3737.             fprintf(out_file, ".dword = %d;", n);
  3738.             break;
  3739.          case CharConst:
  3740.             prt_str("static struct b_cset cset_blk = ", IndentInc);
  3741.             cset_init(out_file, bitvect(t->image, (int)strlen(t->image)));
  3742.             ForceNl();
  3743.             prt_str(rslt_loc, IndentInc);
  3744.             prt_str(".dword = D_Cset;", IndentInc);
  3745.             ForceNl();
  3746.             prt_str(rslt_loc, IndentInc);
  3747.             prt_str(".vword.bptr = (union block *)&cset_blk;", IndentInc);
  3748.             break;
  3749.          case DblConst:
  3750.             prt_str("static struct b_real real_blk = {T_Real, ", IndentInc);
  3751.             fprintf(out_file, "%s};", t->image);
  3752.             ForceNl();
  3753.             prt_str(rslt_loc, IndentInc);
  3754.             prt_str(".dword = D_Real;", IndentInc);
  3755.             ForceNl();
  3756.             prt_str(rslt_loc, IndentInc);
  3757.             prt_str(".vword.bptr = (union block *)&real_blk;", IndentInc);
  3758.             break;
  3759.          case IntConst:
  3760.             prt_str(rslt_loc, IndentInc);
  3761.             prt_str(".dword = D_Integer;", IndentInc);
  3762.             ForceNl();
  3763.             prt_str(rslt_loc, IndentInc);
  3764.             prt_str(".vword.integr = ", IndentInc);
  3765.             prt_str(t->image, IndentInc);
  3766.             prt_str(";", IndentInc);
  3767.             break;
  3768.          }
  3769.       ForceNl();
  3770.       prt_str("return A_Continue;", IndentInc);
  3771.       ForceNl();
  3772.       prt_str("}\n", IndentInc);
  3773.       ++line;
  3774.       ForceNl();
  3775.       }
  3776.    else {
  3777.       /*
  3778.        * For the compiler, make an entry in the data base for the keyword.
  3779.        */
  3780.       cur_impl->use_rslt = 0;
  3781.    
  3782.       il = new_il(IL_Const, 2);
  3783.       switch (t->tok_id) {
  3784.          case StrLit:
  3785.             il->u[0].n = str_typ;
  3786.             il->u[1].s = (char *)alloc((unsigned int)(strlen(t->image) + 3));
  3787.             sprintf(il->u[1].s, "\"%s\"", t->image);
  3788.             break;
  3789.          case CharConst:
  3790.             il->u[0].n = cset_typ;
  3791.             il->u[1].s = (char *)alloc((unsigned int)(strlen(t->image) + 3));
  3792.             sprintf(il->u[1].s, "'%s'", t->image);
  3793.             break;
  3794.          case DblConst:
  3795.             il->u[0].n = real_typ;
  3796.             il->u[1].s = t->image;
  3797.             break;
  3798.          case IntConst:
  3799.             il->u[0].n = int_typ;
  3800.             il->u[1].s = t->image;
  3801.             break;
  3802.          }
  3803.       cur_impl->in_line = il;
  3804.       }
  3805.  
  3806.    /*
  3807.     * Reset the translator and free storage.
  3808.     */
  3809.    op_type = OrdFunc;
  3810.    free_t(t);
  3811.    pop_cntxt();
  3812.    clr_def();
  3813.    }
  3814.  
  3815. /*
  3816.  * keepdir - A preprocessor directive to be kept has been encountered.
  3817.  *   If it is #passthru, print just the body of the directive, otherwise
  3818.  *   print the whole thing.
  3819.  */
  3820. novalue keepdir(t)
  3821. struct token *t;
  3822.    {
  3823.    char *s;
  3824.  
  3825.    tok_line(t, 0);
  3826.    s = t->image;
  3827.    if (strncmp(s, "#passthru", 9) == 0)
  3828.       s = s + 10;
  3829.    fprintf(out_file, "%s\n", s);
  3830.    line += 1;
  3831.    }
  3832.  
  3833. /*
  3834.  * prologue - print standard comments and preprocessor directives at the
  3835.  *   start of an output file.
  3836.  */
  3837. novalue prologue()
  3838.    {
  3839.    id_comment(out_file);
  3840.    fprintf(out_file, "%s", compiler_def);
  3841.    fprintf(out_file, "#include \"%s\"\n\n", inclname);
  3842.    }
  3843.