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 / iconc / inline.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  58KB  |  2,009 lines
  1. /*
  2.  * inline.c - routines to put run-time routines in-line.
  3.  */
  4. #include "::h:gsupport.h"
  5. #include "ctrans.h"
  6. #include "ccode.h"
  7. #include "csym.h"
  8. #include "ctree.h"
  9. #include "cproto.h"
  10. #include "cglobals.h"
  11.  
  12. /*
  13.  * Prototypes for static functions.
  14.  */
  15. hidden novalue          arth_arg  Params(( struct il_code *var,
  16.                                     struct val_loc *v_orig, int chk,
  17.                                     struct code *cnv));
  18. hidden int              body_fnc  Params((struct il_code *il));
  19. hidden novalue          chkforblk Params((noargs));
  20. hidden novalue          cnv_dest  Params((int loc, int is_cstr,
  21.                                     struct il_code *src, int sym_indx,
  22.                                     struct il_c *dest, struct code *cd, int i));
  23. hidden novalue          dwrd_asgn Params((struct val_loc *vloc, char *typ));
  24. hidden struct il_c     *line_ilc  Params((struct il_c *ilc));
  25. hidden int              gen_if    Params((struct code *cond_cd,
  26.                                     struct il_code *il_then,
  27.                                     struct il_code *il_else,
  28.                                     struct val_loc **locs));
  29. hidden int              gen_il    Params((struct il_code *il));
  30. hidden novalue          gen_ilc   Params((struct il_c *il));
  31. hidden novalue          gen_ilret Params((struct il_c *ilc));
  32. hidden int              gen_tcase Params((struct il_code *il, int has_dflt));
  33. hidden novalue          il_var    Params((struct il_code *il, struct code *cd,
  34.                                     int indx));
  35. hidden novalue          mrg_locs  Params((struct val_loc **locs));
  36. hidden struct code     *oper_lbl  Params((char *s));
  37. hidden novalue          part_asgn Params((struct val_loc *vloc, char *asgn,
  38.                                     struct il_c *value));
  39. hidden novalue          rstr_locs Params((struct val_loc **locs));
  40. hidden struct val_loc **sav_locs  Params((noargs));
  41. hidden novalue         sub_ilc    Params((struct il_c *ilc, struct code *cd,
  42.                                     int indx));
  43.  
  44. /*
  45.  * There are many parameters that are shared by multiple routines. There
  46.  *  are copied into statics.
  47.  */
  48. static struct val_loc *rslt;     /* result location */
  49. static struct code **scont_strt; /* label following operation code */
  50. static struct code **scont_fail; /* resumption label for in-line suspend */
  51. static struct c_fnc *cont;       /* success continuation */
  52. static struct implement *impl;   /* data base entry for operation */
  53. static int nsyms;                /* number symbols in operation symbol table */
  54. static int n_vararg;             /* size of variable part of arg list */
  55. static nodeptr intrnl_lftm;      /* lifetime of internal variables */
  56. static struct val_loc **tended;  /* array of tended locals */
  57.  
  58. /*
  59.  * gen_inlin - generate in-line code for an operation.
  60.  */
  61. novalue gen_inlin(il, r, strt, fail, c, ip, ns, st, n, dcl_var, n_va)
  62. struct il_code *il;
  63. struct val_loc *r;
  64. struct code **strt;
  65. struct code **fail;
  66. struct c_fnc *c;
  67. struct implement *ip;
  68. int ns;
  69. struct op_symentry *st;
  70. nodeptr n;
  71. int dcl_var;
  72. int n_va;
  73.    {
  74.    struct code *cd;
  75.    struct val_loc *tnd;
  76.    int i;
  77.  
  78.    /*
  79.     * Copy arguments in to globals.
  80.     */
  81.    rslt = r;
  82.    scont_strt = strt;
  83.    scont_fail = fail;
  84.    cont = c;
  85.    impl = ip;
  86.    nsyms = ns;
  87.    cur_symtab = st;
  88.    intrnl_lftm = n->intrnl_lftm;
  89.    cur_symtyps = n->symtyps;
  90.    n_vararg = n_va;
  91.  
  92.    /*
  93.     * Generate code to initialize local tended descriptors and determine
  94.     *  how to access the descriptors.
  95.     */
  96.    for (i = 0; i < impl->ntnds; ++i) {
  97.       if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
  98.          tnd = chk_alc(NULL, n->intrnl_lftm);
  99.           switch (impl->tnds[i].var_type) {
  100.              case TndDesc:
  101.                 cur_symtab[dcl_var].loc = tnd; 
  102.                 break;
  103.              case TndStr:
  104.                 cd = alc_ary(2);
  105.                 cd->ElemTyp(0) = A_ValLoc;
  106.                 cd->ValLoc(0) =                tnd;
  107.                 cd->ElemTyp(1) = A_Str;
  108.                 cd->Str(1) =                   " = emptystr;";
  109.                 cd_add(cd);
  110.                 cur_symtab[dcl_var].loc = loc_cpy(tnd, M_CharPtr);
  111.                 break;
  112.              case TndBlk:
  113.                 cd = alc_ary(2);
  114.                 cd->ElemTyp(0) = A_ValLoc;
  115.                 cd->ValLoc(0) =                tnd;
  116.                 cd->ElemTyp(1) = A_Str;
  117.                 cd->Str(1) =                   " = nullptr;"; 
  118.                 cd_add(cd);
  119.                 cur_symtab[dcl_var].loc = loc_cpy(tnd, M_BlkPtr);
  120.                 cur_symtab[dcl_var].loc->blk_name = impl->tnds[i].blk_name;
  121.                 break;
  122.              }
  123.          if (impl->tnds[i].init != NULL) {
  124.              cd = alc_ary(4);
  125.              cd->ElemTyp(0) = A_ValLoc;
  126.              cd->ValLoc(0) =                cur_symtab[dcl_var].loc;
  127.              cd->ElemTyp(1) = A_Str;
  128.              cd->Str(1) =                   " = "; 
  129.              sub_ilc(impl->tnds[i].init, cd, 2);
  130.              cd->ElemTyp(3) = A_Str;
  131.              cd->Str(3) =                   ";"; 
  132.              cd_add(cd);
  133.              }
  134.          }
  135.       ++dcl_var;
  136.       }
  137.  
  138.    /*
  139.     * If there are local non-tended variables, generate code for the
  140.     *  declarations, placing everything in braces.
  141.      */
  142.    if (impl->nvars > 0) {
  143.       cd = NewCode(0);
  144.       cd->cd_id = C_LBrack;    /* { */
  145.       cd_add(cd);
  146.       for (i = 0;  i < impl->nvars; ++i) {
  147.          if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
  148.             gen_ilc(impl->vars[i].dcl);
  149.             cur_symtab[dcl_var].loc = cvar_loc(impl->vars[i].name);
  150.             }
  151.          ++dcl_var;
  152.          }
  153.       }
  154.  
  155.    gen_il(il);  /* generate executable code */
  156.  
  157.    if (impl->nvars > 0) {
  158.       cd = NewCode(0);
  159.       cd->cd_id = C_RBrack;    /* } */
  160.       cd_add(cd);
  161.       }
  162.    }
  163.  
  164. /*
  165.  * gen_il - generate code from a sub-tree of in-line code from the data
  166.  *  base. Determine if execution can continue past this code.
  167.  *
  168.  */
  169. hidden int gen_il(il)
  170. struct il_code *il;
  171.    {
  172.    struct code *cd;
  173.    struct code *cd1;
  174.    struct il_code *il_cond;
  175.    struct il_code *il_then;
  176.    struct il_code *il_else;
  177.    struct il_code *il_t;
  178.    struct val_loc **locs;
  179.    struct val_loc **locs1;
  180.    struct val_loc *tnd;
  181.    int fall_thru;
  182.    int cond;
  183.    int ncases;
  184.    int indx;
  185.    int ntended;
  186.    int i;
  187.  
  188.    if (il == NULL)
  189.       return 1;
  190.  
  191.    switch (il->il_type) {
  192.       case IL_Const: /* should have been replaced by literal node */
  193.          return 1;
  194.  
  195.       case IL_If1:
  196.       case IL_If2:
  197.          /*
  198.           * if-then or if-then-else statement.
  199.           */
  200.          il_then = il->u[1].fld;
  201.          if (il->il_type == IL_If2)
  202.             il_else = il->u[2].fld;
  203.          else
  204.             il_else = NULL;
  205.          il_cond = il->u[0].fld;
  206.          if (il->u[0].fld->il_type == IL_Bang) {
  207.             il_cond = il_cond->u[0].fld;
  208.             il_t = il_then;
  209.             il_then = il_else;
  210.             il_else = il_t;
  211.             }
  212.          locs = sav_locs();
  213.          cond = cond_anlz(il_cond, &cd1);
  214.          if (cond == (MaybeTrue | MaybeFalse))
  215.             fall_thru = gen_if(cd1, il_then, il_else, locs);
  216.          else {
  217.             if (cd1 != NULL) {
  218.                cd_add(cd1);  /* condition contains needed conversions */
  219.                cd = alc_ary(1);
  220.                cd->ElemTyp(0) = A_Str;
  221.                cd->Str(0) =              ";";
  222.                cd_add(cd);
  223.                }
  224.             if (cond == MaybeTrue)
  225.                fall_thru = gen_il(il_then);
  226.             else if (cond == MaybeFalse) {
  227.                locs1 = sav_locs();
  228.                rstr_locs(locs);
  229.                locs = locs1;
  230.                fall_thru = gen_il(il_else);
  231.                }
  232.             mrg_locs(locs);
  233.             }
  234.          return fall_thru;
  235.  
  236.       case IL_Tcase1:
  237.          /*
  238.           * type_case statement with no default clause.
  239.           */
  240.          return gen_tcase(il, 0);
  241.  
  242.       case IL_Tcase2:
  243.          /*
  244.           * type_case statement with a default clause.
  245.           */
  246.          return gen_tcase(il, 1);
  247.  
  248.       case IL_Lcase:
  249.          /*
  250.           * len_case statement. Determine which case matches the number
  251.           *  of arguments.
  252.           */
  253.          ncases = il->u[0].n;
  254.          indx = 1;
  255.          for (i = 0; i < ncases; ++i) {
  256.             if (il->u[indx++].n == n_vararg)    /* selection number */
  257.                return gen_il(il->u[indx].fld);  /* action */
  258.             ++indx;
  259.             }
  260.          return gen_il(il->u[indx].fld);        /* default */
  261.  
  262.       case IL_Acase: {
  263.          /*
  264.           * arith_case statement.
  265.           */
  266.          struct il_code *var1;
  267.          struct il_code *var2;
  268.          struct val_loc *v_orig1;
  269.          struct val_loc *v_orig2;
  270.          struct code *cnv1;
  271.          struct code *cnv2;
  272.          int maybe_int;
  273.          int maybe_dbl;
  274.          int chk1;
  275.          int chk2;
  276.  
  277.          var1 = il->u[0].fld;
  278.          var2 = il->u[1].fld;
  279.          v_orig1 = cur_symtab[var1->u[0].n].loc;  /* remember for error msgs */
  280.          v_orig2 = cur_symtab[var2->u[0].n].loc;  /* remember for error msgs */
  281.          arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, &cnv1,
  282.            &chk2, &cnv2);
  283.  
  284.          /*
  285.           * This statement is in-lined if there is only C integer
  286.           *  arithmetic, only C double arithmetic, or only a run-time
  287.           *  error.
  288.           */
  289.          arth_arg(var1, v_orig1, chk1, cnv1);
  290.          arth_arg(var2, v_orig2, chk2, cnv2);
  291.          if (maybe_int)
  292.             return gen_il(il->u[2].fld);     /* C_integer action */
  293.          else if (maybe_dbl)
  294.             return gen_il(il->u[4].fld);     /* C_double action */
  295.          else
  296.             return 0;
  297.          }
  298.  
  299.       case IL_Err1:
  300.          /*
  301.           * runerr() with no offending value.
  302.           */
  303.          cd = alc_ary(3);
  304.          cd->ElemTyp(0) = A_Str;
  305.          cd->Str(0) =              "err_msg(";
  306.          cd->ElemTyp(1) = A_Intgr;
  307.          cd->Intgr(1) =            il->u[0].n;
  308.          cd->ElemTyp(2) = A_Str;
  309.          cd->Str(2) =              ", NULL);";
  310.          cd_add(cd);
  311.          if (err_conv)
  312.             cd_add(sig_cd(on_failure, cur_fnc));
  313.          for (i = 0; i < nsyms; ++i)
  314.             cur_symtab[i].loc = NULL;
  315.          return 0;
  316.  
  317.       case IL_Err2:
  318.          /*
  319.           * runerr() with an offending value. Note the reference to
  320.           *  the offending value descriptor.
  321.           */
  322.          cd = alc_ary(5);
  323.          cd->ElemTyp(0) = A_Str;
  324.          cd->Str(0) =              "err_msg(";
  325.          cd->ElemTyp(1) = A_Intgr;
  326.          cd->Intgr(1) =            il->u[0].n;
  327.          cd->ElemTyp(2) = A_Str;
  328.          cd->Str(2) =              ", &(";
  329.          il_var(il->u[1].fld, cd, 3);
  330.          cd->ElemTyp(4) = A_Str;
  331.          cd->Str(4) =              "));";
  332.          cd_add(cd);
  333.          if (err_conv)
  334.             cd_add(sig_cd(on_failure, cur_fnc));
  335.          for (i = 0; i < nsyms; ++i)
  336.             cur_symtab[i].loc = NULL;
  337.          return 0;
  338.  
  339.       case IL_Lst:
  340.          /*
  341.           * Two consecutive pieces of RTL code.
  342.           */
  343.          fall_thru = gen_il(il->u[0].fld);
  344.          if (fall_thru)
  345.             fall_thru = gen_il(il->u[1].fld);
  346.          return fall_thru;
  347.  
  348.       case IL_Block:
  349.          /*
  350.           * inline {...} statement.
  351.           *
  352.           *  Allocate and initialize any tended locals.
  353.           */
  354.          ntended = il->u[1].n;
  355.          if (ntended > 0)
  356.             tended = (struct val_loc **)alloc((unsigned int)
  357.                sizeof(struct val_loc *) * ntended);
  358.          for (i = 2; i - 2 < ntended; ++i) {
  359.              tnd = chk_alc(NULL, intrnl_lftm);
  360.              tended[i - 2] = tnd;
  361.              switch (il->u[i].n) {
  362.                 case TndDesc:
  363.                    break;
  364.                 case TndStr:
  365.                    cd = alc_ary(2);
  366.                    cd->ElemTyp(0) = A_ValLoc;
  367.                    cd->ValLoc(0) =                tnd;
  368.                    cd->ElemTyp(1) = A_Str;
  369.                    cd->Str(1) =                   " = emptystr;";
  370.                    cd_add(cd);
  371.                    break;
  372.                 case TndBlk:
  373.                    cd = alc_ary(2);
  374.                    cd->ElemTyp(0) = A_ValLoc;
  375.                    cd->ValLoc(0) =                tnd;
  376.                    cd->ElemTyp(1) = A_Str;
  377.                    cd->Str(1) =                   " = nullptr;"; 
  378.                    cd_add(cd);
  379.                    break;
  380.                 }
  381.             }
  382.          gen_ilc(il->u[i].c_cd);    /* body of block */
  383.          /*
  384.           * See if execution can fall through this code.
  385.           */
  386.          if (il->u[0].n)
  387.             return 1;
  388.          else {
  389.             for (i = 0; i < nsyms; ++i)
  390.                cur_symtab[i].loc = NULL;
  391.             return 0;
  392.             }
  393.  
  394.       case IL_Call:
  395.          /*
  396.           * call to body function.
  397.           */
  398.          return body_fnc(il);
  399.  
  400.       case IL_Abstr:
  401.          /*
  402.           * abstract type computation. Only used by type inference.
  403.           */
  404.          return 1;
  405.  
  406.       default:
  407.          fprintf(stderr, "compiler error: unknown info in data base\n");
  408.          exit(1);
  409.          /* NOTREACHED */
  410.       }
  411.    }
  412.  
  413. /*
  414.  * arth_arg - in-line code to check a conversion for an arith_case statement.
  415.  */
  416. static novalue arth_arg(var, v_orig, chk, cnv)
  417. struct il_code *var;
  418. struct val_loc *v_orig;
  419. int chk;
  420. struct code *cnv;
  421.    {
  422.    struct code *lbl;
  423.    struct code *cd;
  424.  
  425.    if (chk) {
  426.       /*
  427.        * Must check the conversion.
  428.        */
  429.       lbl = oper_lbl("converted");
  430.       cd_add(lbl);
  431.       cur_fnc->cursor = lbl->prev;        /* code goes before label */
  432.       if (cnv != NULL) {
  433.          cd = NewCode(2);
  434.          cd->cd_id = C_If;
  435.          cd->Cond = cnv;
  436.          cd->ThenStmt = mk_goto(lbl);
  437.          cd_add(cd);
  438.          }
  439.       cd = alc_ary(3);
  440.       cd->ElemTyp(0) = A_Str;
  441.       cd->Str(0) =              "err_msg(102, &(";
  442.       cd->ElemTyp(1) = A_ValLoc;
  443.       cd->ValLoc(1) =           v_orig;    /* var location before conversion */
  444.       cd->ElemTyp(2) = A_Str;
  445.       cd->Str(2) =              "));";
  446.       cd_add(cd);
  447.       if (err_conv)
  448.          cd_add(sig_cd(on_failure, cur_fnc));
  449.       cur_fnc->cursor = lbl;
  450.       }
  451.    else if (cnv != NULL) {
  452.       cd_add(cnv);          /* conversion cannot fail  */
  453.       cd = alc_ary(1);
  454.       cd->ElemTyp(0) = A_Str;
  455.       cd->Str(0) =              ";";
  456.       cd_add(cd);
  457.       }
  458.    }
  459.  
  460. /*
  461.  * body_fnc - generate code to call a body function.
  462.  */
  463. static int body_fnc(il)
  464. struct il_code *il;
  465.    {
  466.    struct code *arg_lst;
  467.    struct code *cd;
  468.    struct c_fnc *cont1;
  469.    char *oper_nm;
  470.    int ret_val;
  471.    int ret_flag;
  472.    int need_rslt;
  473.    int num_sbuf;
  474.    int num_cbuf;
  475.    int expl_args;
  476.    int arglst_sz;  /* size of arg list in number of code pieces */
  477.    int il_indx;
  478.    int cd_indx;
  479.    int proto_prt;
  480.    int i;
  481.  
  482.    /*
  483.     * Determine if a function prototype has been printed yet for this
  484.     *  body function.
  485.     */
  486.    proto_prt = il->u[0].n;
  487.    il->u[0].n = 1;
  488.  
  489.    /*
  490.     * Construct the name of the body function.
  491.     */
  492.    oper_nm = (char *)alloc((unsigned int)(strlen(impl->name) + 6));
  493.    sprintf(oper_nm, "%c%c%c%c_%s", impl->oper_typ, impl->prefix[0],
  494.       impl->prefix[1], (char)il->u[1].n, impl->name);
  495.  
  496.    /*
  497.     * Extract from the call the flags and other information describing
  498.     *  the function, then use this information to deduce the arguments
  499.     *  needed by the function.
  500.     */
  501.    ret_val = il->u[2].n;
  502.    ret_flag = il->u[3].n;
  503.    need_rslt = il->u[4].n;
  504.    num_sbuf = il->u[5].n;
  505.    num_cbuf = il->u[6].n;
  506.    expl_args = il->u[7].n;
  507.  
  508.    /*
  509.     * determine how large the argument list is.
  510.     */
  511.    arglst_sz = 2 * expl_args - 1;
  512.    if (num_sbuf > 0)
  513.       arglst_sz += 3;
  514.    if (num_cbuf > 0)
  515.       arglst_sz += 2;
  516.    if (need_rslt)
  517.       arglst_sz += 3;
  518.    if (arglst_sz > 0)
  519.       arg_lst = alc_ary(arglst_sz);
  520.    else
  521.       arg_lst = alc_ary(0);
  522.  
  523.    if (!proto_prt) {
  524.       /*
  525.        * Determine whether the body function returns a C integer, double,
  526.        *  no value, or a signal.
  527.        */
  528.       switch (ret_val) {
  529.          case RetInt:
  530.             fprintf(inclfile, "C_integer %s Params((", oper_nm);
  531.             break;
  532.          case RetDbl:
  533.             fprintf(inclfile, "double %s Params((", oper_nm);
  534.             break;
  535.          case RetNoVal:
  536.             fprintf(inclfile, "novalue %s Params((", oper_nm);
  537.             break;
  538.          case RetSig:
  539.             fprintf(inclfile, "int %s Params((", oper_nm);
  540.             break;
  541.          }
  542.      }
  543.  
  544.    /*
  545.     * Produce prototype and code for the explicit arguments in the
  546.     *  function call. Note that the call entry contains C code for both.
  547.     */
  548.    il_indx = 8;
  549.    cd_indx = 0;
  550.    while (expl_args--) {
  551.       if (cd_indx > 0) {
  552.          /*
  553.           * Not first entry, precede by ','.
  554.           */
  555.          arg_lst->ElemTyp(cd_indx) = A_Str;                /* , */
  556.          arg_lst->Str(cd_indx) = ", ";
  557.          if (!proto_prt)
  558.             fprintf(inclfile, ", ");
  559.          ++cd_indx;
  560.          }
  561.       if (!proto_prt)
  562.         fprintf(inclfile, "%s", il->u[il_indx].c_cd->s);   /* parameter dcl */
  563.       ++il_indx;
  564.       sub_ilc(il->u[il_indx++].c_cd, arg_lst, cd_indx++);
  565.       }
  566.  
  567.    /*
  568.     * If string buffers are needed, allocate them and pass pointer to
  569.     *   function.
  570.     */
  571.    if (num_sbuf > 0) {
  572.       if (cd_indx > 0) {
  573.          /*
  574.           * Not first entry, precede by ','.
  575.           */
  576.          arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
  577.          arg_lst->Str(cd_indx) = ", ";
  578.          if (!proto_prt)
  579.             fprintf(inclfile, ", ");
  580.          ++cd_indx;
  581.          }
  582.       arg_lst->ElemTyp(cd_indx) = A_Str;
  583.       arg_lst->Str(cd_indx) = "(char (*)[MaxCvtLen])";
  584.       ++cd_indx;
  585.       arg_lst->ElemTyp(cd_indx) = A_SBuf;
  586.       arg_lst->Intgr(cd_indx) = alc_sbufs(num_sbuf, intrnl_lftm);
  587.       if (!proto_prt)
  588.          fprintf(inclfile, "char (*r_sbuf)[MaxCvtLen]");
  589.       ++cd_indx;
  590.       }
  591.  
  592.    /*
  593.     * If cset buffers are needed, allocate them and pass pointer to
  594.     *   function.
  595.     */
  596.    if (num_cbuf > 0) {
  597.       if (cd_indx > 0) {
  598.          /*
  599.           * Not first entry, precede by ','.
  600.           */
  601.          arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
  602.          arg_lst->Str(cd_indx) = ", ";
  603.          if (!proto_prt)
  604.             fprintf(inclfile, ", ");
  605.          ++cd_indx;
  606.          }
  607.       arg_lst->ElemTyp(cd_indx) = A_CBuf;
  608.       arg_lst->Intgr(cd_indx) = alc_cbufs(num_cbuf, intrnl_lftm);
  609.       if (!proto_prt)
  610.          fprintf(inclfile, "struct b_cset *r_cbuf");
  611.       ++cd_indx;
  612.       }
  613.  
  614.    /*
  615.     * See if the function needs a pointer to the result location
  616.     *  of the operation.
  617.     */
  618.    if (need_rslt) {
  619.       if (cd_indx > 0) {
  620.          /*
  621.           * Not first entry, precede by ','.
  622.           */
  623.          arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
  624.          arg_lst->Str(cd_indx) = ", ";
  625.          if (!proto_prt)
  626.             fprintf(inclfile, ", ");
  627.          ++cd_indx;
  628.          }
  629.       arg_lst->ElemTyp(cd_indx) = A_Str;        /* location of result */
  630.       arg_lst->Str(cd_indx) = "&";
  631.       ++cd_indx;
  632.       arg_lst->ElemTyp(cd_indx) = A_ValLoc;
  633.       arg_lst->ValLoc(cd_indx) = rslt;
  634.       if (!proto_prt)
  635.          fprintf(inclfile, "dptr rslt");
  636.       ++cd_indx;
  637.       }
  638.  
  639.    if (!proto_prt) {
  640.       /*
  641.        * The last possible argument is the success continuation.
  642.        *  If there are no arguments, indicate this in the prototype.
  643.        */
  644.       if (ret_flag & DoesSusp) {
  645.          if (cd_indx > 0)
  646.             fprintf(inclfile, ", ");
  647.          fprintf(inclfile, "continuation succ_cont");
  648.          }
  649.       else if (cd_indx == 0)
  650.          fprintf(inclfile, "noargs");
  651.       fprintf(inclfile, "));\n");
  652.       }
  653.  
  654.    /*
  655.     * Does this call need the success continuation for the operation.
  656.     */
  657.    if (ret_flag & DoesSusp)
  658.        cont1 = cont;
  659.    else
  660.        cont1 = NULL;
  661.  
  662.    switch (ret_val) {
  663.       case RetInt:
  664.          /*
  665.           * The body function returns a C integer.
  666.           */
  667.          cd = alc_ary(6);
  668.          cd->ElemTyp(0) = A_ValLoc;
  669.          cd->ValLoc(0) =               rslt;
  670.          cd->ElemTyp(1) = A_Str;
  671.          cd->Str(1) =                  ".vword.integr = ";
  672.          cd->ElemTyp(2) = A_Str;
  673.          cd->Str(2) =                  oper_nm;
  674.          cd->ElemTyp(3) = A_Str;
  675.          cd->Str(3) =                  "(";
  676.          cd->ElemTyp(4) = A_Ary;
  677.          cd->Array(4) =                  arg_lst;
  678.          cd->ElemTyp(5) = A_Str;
  679.          cd->Str(5) =                  ");";
  680.          cd_add(cd);
  681.          dwrd_asgn(rslt, "Integer");
  682.          cd_add(mk_goto(*scont_strt));
  683.          break;
  684.       case RetDbl:
  685.          /*
  686.           * The body function returns a C double.
  687.           */
  688.          cd = alc_ary(6);
  689.          cd->ElemTyp(0) = A_ValLoc;
  690.          cd->ValLoc(0) =               rslt;
  691.          cd->ElemTyp(1) = A_Str;
  692.          cd->Str(1) =                  ".vword.bptr = (union block *)alcreal(";
  693.          cd->ElemTyp(2) = A_Str;
  694.          cd->Str(2) =                  oper_nm;
  695.          cd->ElemTyp(3) = A_Str;
  696.          cd->Str(3) =                  "(";
  697.          cd->ElemTyp(4) = A_Ary;
  698.          cd->Array(4) =                  arg_lst;
  699.          cd->ElemTyp(5) = A_Str;
  700.          cd->Str(5) =                  "));";
  701.          cd_add(cd);
  702.          dwrd_asgn(rslt, "Real");
  703.          chkforblk();    /* make sure the block allocation succeeded */
  704.          cd_add(mk_goto(*scont_strt));
  705.          break;
  706.       case RetNoVal:
  707.          /*
  708.           * The body function does not directly return a value.
  709.           */
  710.          cd = alc_ary(4);
  711.          cd->ElemTyp(0) = A_Str;
  712.          cd->Str(0) =                  oper_nm;
  713.          cd->ElemTyp(1) = A_Str;
  714.          cd->Str(1) =                  "(";
  715.          cd->ElemTyp(2) = A_Ary;
  716.          cd->Array(2) =                  arg_lst;
  717.          cd->ElemTyp(3) = A_Str;
  718.          cd->Str(3) =                  ");";
  719.          cd_add(cd);
  720.          if (ret_flag & DoesFail | (err_conv && (ret_flag & DoesEFail)))
  721.             cd_add(sig_cd(on_failure, cur_fnc));
  722.          else if (ret_flag & DoesRet)
  723.             cd_add(mk_goto(*scont_strt));
  724.          break;
  725.       case RetSig:
  726.          /*
  727.           * The body function returns a signal.
  728.           */
  729.          callo_add(oper_nm, ret_flag, cont1, 0, arg_lst, mk_goto(*scont_strt));
  730.          break;
  731.       }
  732.    /*
  733.     * See if execution can fall through this call.
  734.     */
  735.    if (ret_flag & DoesFThru)
  736.       return 1;
  737.    else {
  738.       for (i = 0; i < nsyms; ++i)
  739.          cur_symtab[i].loc = NULL;
  740.       return 0;
  741.       }
  742.    }
  743.  
  744.  
  745. /*
  746.  * il_var - generate code for a possibly subscripted variable into
  747.  *   an element of a code array.
  748.  */
  749. static novalue il_var(il, cd, indx)
  750. struct il_code *il;
  751. struct code *cd;
  752. int indx;
  753.    {
  754.    struct code *cd1;
  755.  
  756.    if (il->il_type == IL_Subscr) {
  757.       /*
  758.        * Subscripted variable.
  759.        */
  760.       cd1 = cd;
  761.       cd = alc_ary(4);
  762.       cd1->ElemTyp(indx) = A_Ary;
  763.       cd1->Array(indx) = cd;
  764.       indx = 0;
  765.       cd->ElemTyp(1) = A_Str;
  766.       cd->Str(1) =                  "[";
  767.       cd->ElemTyp(2) = A_Intgr;
  768.       cd->Intgr(2) =                il->u[1].n;
  769.       cd->ElemTyp(3) = A_Str;
  770.       cd->Str(3) =                  "]";
  771.       }
  772.  
  773.    /*
  774.     * See if this is the result location of the operation or an ordinary
  775.     *  variable.
  776.     */
  777.    cd->ElemTyp(indx) = A_ValLoc;
  778.    if (il->u[0].n == RsltIndx)
  779.       cd->ValLoc(indx) = rslt;
  780.    else
  781.       cd->ValLoc(indx) = cur_symtab[il->u[0].n].loc;
  782.    }
  783.  
  784. /*
  785.  * part_asgn - generate code for an assignment to (part of) a descriptor.
  786.  */
  787. static novalue part_asgn(vloc, asgn, value)
  788. struct val_loc *vloc;
  789. char *asgn;
  790. struct il_c *value;
  791.    {
  792.    struct code *cd;
  793.  
  794.    cd = alc_ary(4);
  795.    cd->ElemTyp(0) = A_ValLoc;
  796.    cd->ValLoc(0) =                          vloc;
  797.    cd->ElemTyp(1) = A_Str;
  798.    cd->Str(1) =                             asgn;
  799.    sub_ilc(value, cd, 2);                /* value */
  800.    cd->ElemTyp(3) = A_Str;
  801.    cd->Str(3) =                             ";";
  802.    cd_add(cd);
  803.    }
  804.  
  805. /*
  806.  * dwrd_asgn - generate code to assign a type code to the dword of a descriptor.
  807.  */
  808. static novalue dwrd_asgn(vloc, typ)
  809. struct val_loc *vloc;
  810. char *typ;
  811.    {
  812.    struct code *cd;
  813.  
  814.    cd = alc_ary(4);
  815.    cd->ElemTyp(0) = A_ValLoc;
  816.    cd->ValLoc(0) =               vloc;
  817.    cd->ElemTyp(1) = A_Str;
  818.    cd->Str(1) =                  ".dword = D_";
  819.    cd->ElemTyp(2) = A_Str;
  820.    cd->Str(2) =                  typ;
  821.    cd->ElemTyp(3) = A_Str;
  822.    cd->Str(3) =                  ";";
  823.    cd_add(cd);
  824.    }
  825.  
  826. /*
  827.  * sub_ilc - generate code from a sequence of C code and place it
  828.  *  in a slot in a code array.
  829.  */
  830. static novalue sub_ilc(ilc, cd, indx)
  831. struct il_c *ilc;
  832. struct code *cd;
  833. int indx;
  834.    {
  835.    struct il_c *ilc1;
  836.    struct code *cd1;
  837.    int n;
  838.  
  839.    /*
  840.     * Count the number of pieces of C code to process.
  841.     */
  842.    n = 0;
  843.    for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next)
  844.       ++n;
  845.  
  846.    /*
  847.     * If there is only one piece of code, place it directly in the 
  848.     *  slot of the array. Otherwise allocate a sub-array and place it
  849.     *  in the slot.
  850.     */
  851.    if (n > 1) {
  852.       cd1 = cd;
  853.       cd = alc_ary(n);
  854.       cd1->ElemTyp(indx) = A_Ary;
  855.       cd1->Array(indx) = cd;
  856.       indx = 0;
  857.       }
  858.  
  859.    while (ilc != NULL) {
  860.       switch (ilc->il_c_type) {
  861.          case ILC_Ref:
  862.          case ILC_Mod:
  863.             /*
  864.              * Reference to variable in symbol table.
  865.              */
  866.             cd->ElemTyp(indx) = A_ValLoc;
  867.             if (ilc->n == RsltIndx)
  868.                cd->ValLoc(indx) = rslt;
  869.             else {
  870.                if (ilc->s == NULL)
  871.                   cd->ValLoc(indx) = cur_symtab[ilc->n].loc;
  872.                else {
  873.                   /*
  874.                    * Access the entire descriptor.
  875.                    */
  876.                   cd->ValLoc(indx) = loc_cpy(cur_symtab[ilc->n].loc, M_None);
  877.                   }
  878.                }
  879.             break;
  880.  
  881.          case ILC_Tend:
  882.             /*
  883.              * Reference to a tended variable.
  884.              */
  885.             cd->ElemTyp(indx) = A_ValLoc;
  886.             cd->ValLoc(indx) = tended[ilc->n];
  887.             break;
  888.  
  889.          case ILC_Str:
  890.             /*
  891.              * String representing C code.
  892.              */
  893.             cd->ElemTyp(indx) = A_Str;
  894.             cd->Str(indx) = ilc->s;
  895.             break;
  896.  
  897.          case ILC_SBuf:
  898.             /*
  899.              * String buffer for a conversion.
  900.              */
  901.             cd->ElemTyp(indx) = A_SBuf;
  902.             cd->Intgr(indx) = alc_sbufs(1, intrnl_lftm);
  903.             break;
  904.  
  905.          case ILC_CBuf:
  906.             /*
  907.              * Cset buffer for a conversion.
  908.              */
  909.             cd->ElemTyp(indx) = A_CBuf;
  910.             cd->Intgr(indx) = alc_cbufs(1, intrnl_lftm);
  911.             break;
  912.  
  913.  
  914.          default:
  915.             fprintf(stderr, "compiler error: unknown info in data base\n");
  916.             exit(1);
  917.          }
  918.       ilc = ilc->next;
  919.       ++indx;
  920.       }
  921.  
  922.    }
  923.  
  924. /*
  925.  * gen_ilret - generate code to set the result value from a suspend or
  926.  *   return.
  927.  */
  928. static novalue gen_ilret(ilc)
  929. struct il_c *ilc;
  930.    {
  931.    struct il_c *ilc0;
  932.    struct code *cd;
  933.    char *cap_id;
  934.    int typcd;
  935.  
  936.    if (rslt == &ignore)
  937.       return;    /* Don't bother computing the result; it's never used */
  938.  
  939.    ilc0 = ilc->code[0];
  940.    typcd = ilc->n;
  941.  
  942.    if (typcd < 0) {
  943.       /*
  944.        * RTL returns that do not look like function calls to standard Icon
  945.        *  type name.
  946.        */
  947.       switch (typcd) {
  948.          case TypCInt:
  949.             /*
  950.              * return/suspend C_integer <expr>;
  951.              */
  952.             part_asgn(rslt, ".vword.integr = ", ilc0);
  953.             dwrd_asgn(rslt, "Integer");
  954.             break;
  955.          case TypCDbl:
  956.             /*
  957.              * return/suspend C_double <expr>;
  958.              */
  959.             cd = alc_ary(4);
  960.             cd->ElemTyp(0) = A_ValLoc;
  961.             cd->ValLoc(0) =             rslt;
  962.             cd->ElemTyp(1) = A_Str;
  963.             cd->Str(1) =                ".vword.bptr = (union block *)alcreal(";
  964.             sub_ilc(ilc0, cd, 2);       /* value */
  965.             cd->ElemTyp(3) = A_Str;
  966.             cd->Str(3) =                ");";
  967.             cd_add(cd);
  968.             dwrd_asgn(rslt, "Real");
  969.             chkforblk();    /* make sure the block allocation succeeded */
  970.             break;
  971.          case TypCStr:
  972.             /*
  973.              * return/suspend C_string <expr>;
  974.              */
  975.             cd = alc_ary(5);
  976.             cd->ElemTyp(0) = A_Str;
  977.             cd->Str(0) =                  "AsgnCStr(";
  978.             cd->ElemTyp(1) = A_ValLoc;
  979.             cd->ValLoc(1) =               rslt;
  980.             cd->ElemTyp(2) = A_Str;
  981.             cd->Str(2) =                  ", ";
  982.             sub_ilc(ilc0, cd, 3);         /* <expr> */
  983.             cd->ElemTyp(4) = A_Str;
  984.             cd->Str(4) =                  ");";
  985.             cd_add(cd);
  986.             break;
  987.          case RetDesc:
  988.             /*
  989.              * return/suspend <expr>;
  990.              */
  991.             part_asgn(rslt, " = ", ilc0);
  992.             break;
  993.          case RetNVar:
  994.             /*
  995.              * return/suspend named_var(<desc-pntr>);
  996.              */
  997.             part_asgn(rslt, ".vword.descptr = ", ilc0);
  998.             dwrd_asgn(rslt, "Var");
  999.             break;
  1000.          case RetSVar:
  1001.             /*
  1002.              * return/suspend struct_var(<desc-pntr>, <block_pntr>);
  1003.              */
  1004.             part_asgn(rslt, ".vword.descptr = (dptr)", ilc->code[1]);
  1005.             cd = alc_ary(6);
  1006.             cd->ElemTyp(0) = A_ValLoc;
  1007.             cd->ValLoc(0) =               rslt;
  1008.             cd->ElemTyp(1) = A_Str;
  1009.             cd->Str(1) =                  ".dword = D_Var + ((word *)";
  1010.             sub_ilc(ilc0, cd, 2);       /* value */
  1011.             cd->ElemTyp(3) = A_Str;
  1012.             cd->Str(3) =                  " - (word *)";
  1013.             cd->ElemTyp(4) = A_ValLoc;
  1014.             cd->ValLoc(4) =               rslt;
  1015.             cd->ElemTyp(5) = A_Str;
  1016.             cd->Str(5) =                  ".vword.descptr);";
  1017.             cd_add(cd);
  1018.             break;
  1019.          case RetNone:
  1020.             /*
  1021.              * return/suspend result;
  1022.              *
  1023.              *  Result already set, do nothing.
  1024.              */
  1025.             break;
  1026.          default:
  1027.             fprintf(stderr,
  1028.                "compiler error: unknown RLT return in data base\n");
  1029.             exit(1);
  1030.             /* NOTREACHED */
  1031.          }
  1032.       }
  1033.    else {
  1034.       /*
  1035.        * RTL returns that look like function calls to standard Icon type
  1036.        *  names.
  1037.        */
  1038.       cap_id = icontypes[typcd].cap_id;
  1039.       switch (icontypes[typcd].rtl_ret) {
  1040.          case TRetBlkP:
  1041.             /*
  1042.              * return/suspend <type>(<block-pntr>);
  1043.              */
  1044.             part_asgn(rslt, ".vword.bptr = (union block *)", ilc0);
  1045.             dwrd_asgn(rslt, cap_id);
  1046.             break;
  1047.          case TRetDescP:
  1048.             /*
  1049.              * return/suspend <type>(<descriptor-pntr>);
  1050.              */
  1051.             part_asgn(rslt, ".vword.descptr = (dptr)", ilc0);
  1052.             dwrd_asgn(rslt, cap_id);
  1053.             break;
  1054.          case TRetCharP:
  1055.             /*
  1056.              * return/suspend <type>(<char-pntr>);
  1057.              */
  1058.             part_asgn(rslt, ".vword.sptr = (char *)", ilc0);
  1059.             dwrd_asgn(rslt, cap_id);
  1060.             break;
  1061.          case TRetCInt:
  1062.             /*
  1063.              * return/suspend <type>(<integer>);
  1064.              */
  1065.             part_asgn(rslt, ".vword.integr = (word)", ilc0);
  1066.             dwrd_asgn(rslt, cap_id);
  1067.             break;
  1068.          case TRetSpcl:
  1069.             /*
  1070.              * RTL returns that look like function calls to standard type
  1071.              *  names but take more than one argument.
  1072.              */
  1073.             if (typcd == str_typ) {
  1074.                 /*
  1075.                 * return/suspend string(<len>, <char-pntr>);
  1076.                 */
  1077.                part_asgn(rslt, ".vword.sptr = ", ilc->code[1]);
  1078.                part_asgn(rslt, ".dword = ", ilc0);
  1079.                }
  1080.             else if (typcd == stv_typ) {
  1081.                /*
  1082.                 * return/suspend substr(<desc-pntr>, <start>, <len>);
  1083.                 */
  1084.                cd = alc_ary(9);
  1085.                cd->ElemTyp(0) = A_Str;
  1086.                cd->Str(0) =                  "SubStr(&";
  1087.                cd->ElemTyp(1) = A_ValLoc;
  1088.                cd->ValLoc(1) =               rslt;
  1089.                cd->ElemTyp(2) = A_Str;
  1090.                cd->Str(2) =                  ", ";
  1091.                sub_ilc(ilc0, cd, 3);
  1092.                cd->ElemTyp(4) = A_Str;
  1093.                cd->Str(4) =                  ", ";
  1094.                sub_ilc(ilc->code[2], cd, 5);
  1095.                cd->ElemTyp(6) = A_Str;
  1096.                cd->Str(6) =                  ", ";
  1097.                sub_ilc(ilc->code[1], cd, 7);
  1098.                cd->ElemTyp(8) = A_Str;
  1099.                cd->Str(8) =                  ");";
  1100.                cd_add(cd);
  1101.                chkforblk();    /* make sure the block allocation succeeded */
  1102.                }
  1103.             else {
  1104.                fprintf(stderr,
  1105.                   "compiler error: unknown RLT return in data base\n");
  1106.                exit(1);
  1107.                /* NOTREACHED */
  1108.                }
  1109.             break;
  1110.          default:
  1111.             fprintf(stderr,
  1112.                "compiler error: unknown RLT return in data base\n");
  1113.             exit(1);
  1114.             /* NOTREACHED */
  1115.          }
  1116.       }
  1117.    }
  1118.  
  1119. /*
  1120.  * chkforblk - generate code to make sure the allocation of a block
  1121.  *   for the result descriptor was successful.
  1122.  */
  1123. static novalue chkforblk()
  1124.    {
  1125.    struct code *cd;
  1126.    struct code *cd1;
  1127.    struct code *lbl;
  1128.  
  1129.    lbl = alc_lbl("got allocation", 0);
  1130.    cd_add(lbl);
  1131.    cur_fnc->cursor = lbl->prev;        /* code goes before label */
  1132.    cd = NewCode(2);
  1133.    cd->cd_id = C_If;
  1134.    cd1 = alc_ary(3);
  1135.    cd1->ElemTyp(0) = A_Str;
  1136.    cd1->Str(0) =                  "(";
  1137.    cd1->ElemTyp(1) = A_ValLoc;
  1138.    cd1->ValLoc(1) =               rslt;
  1139.    cd1->ElemTyp(2) = A_Str;
  1140.    cd1->Str(2) =                  ").vword.bptr != NULL";
  1141.    cd->Cond = cd1;
  1142.    cd->ThenStmt = mk_goto(lbl);
  1143.    cd_add(cd);
  1144.    cd = alc_ary(1);
  1145.    cd->ElemTyp(0) = A_Str;
  1146.    cd->Str(0) =                   "err_msg(307, NULL);";
  1147.    cd_add(cd);
  1148.    if (err_conv)
  1149.       cd_add(sig_cd(on_failure, cur_fnc));
  1150.    cur_fnc->cursor = lbl;
  1151.    }
  1152.  
  1153. /*
  1154.  * gen_ilc - generate code for an sequence of in-line C code.
  1155.  */
  1156. static novalue gen_ilc(ilc)
  1157. struct il_c *ilc;
  1158.    {
  1159.    struct il_c *ilc1;
  1160.    struct code *cd;
  1161.    struct code *cd1;
  1162.    struct code *lbl1;
  1163.    struct code *fail_sav;
  1164.    struct code **lbls;
  1165.    int max_lbl;
  1166.    int i;
  1167.  
  1168.    /*
  1169.     * Determine how many labels there are in the code and allocate an
  1170.     *  array to map from label numbers to labels in the code.
  1171.     */
  1172.    max_lbl = -1;
  1173.    for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next) {
  1174.       switch(ilc1->il_c_type) {
  1175.          case ILC_CGto:
  1176.          case ILC_Goto:
  1177.          case ILC_Lbl:
  1178.             if (ilc1->n > max_lbl)
  1179.                max_lbl = ilc1->n;
  1180.          }
  1181.       }
  1182.    ++max_lbl;    /* adjust for 0 indexing */
  1183.    if (max_lbl > 0) {
  1184.       lbls = (struct code **)alloc((unsigned int) sizeof(struct code *) *
  1185.          max_lbl);
  1186.       for (i = 0; i < max_lbl; ++i)
  1187.          lbls[i] = NULL;
  1188.       }
  1189.  
  1190.    while (ilc != NULL) {
  1191.       switch(ilc->il_c_type) {
  1192.          case ILC_Ref:
  1193.          case ILC_Mod:
  1194.          case ILC_Tend:
  1195.          case ILC_SBuf:
  1196.          case ILC_CBuf:
  1197.          case ILC_Str:
  1198.             /*
  1199.              * The beginning of a sequence of code fragments that can be
  1200.              *  place on one line.
  1201.              */
  1202.             ilc = line_ilc(ilc);
  1203.             break;
  1204.  
  1205.          case ILC_Fail:
  1206.             /*
  1207.              * fail - perform failure action.
  1208.              */
  1209.             cd_add(sig_cd(on_failure, cur_fnc));
  1210.             break;
  1211.  
  1212.          case ILC_EFail:
  1213.             /*
  1214.              * errorfail - same as fail if error conversion is supported.
  1215.              */
  1216.             if (err_conv)
  1217.                cd_add(sig_cd(on_failure, cur_fnc));
  1218.             break;
  1219.  
  1220.          case ILC_Ret:
  1221.             /*
  1222.              * return - set result location and jump out of operation.
  1223.              */
  1224.             gen_ilret(ilc);
  1225.             cd_add(mk_goto(*scont_strt));
  1226.             break;
  1227.  
  1228.          case ILC_Susp:
  1229.             /*
  1230.              * suspend - set result location. If there is a success
  1231.              *  continuation, call it. Otherwise the "continuation"
  1232.              *  will be generated in-line, so set up a resumption label.
  1233.              */
  1234.             gen_ilret(ilc);
  1235.             if (cont == NULL)
  1236.                *scont_strt = cur_fnc->cursor;
  1237.             lbl1 = oper_lbl("end suspend");
  1238.             cd_add(lbl1);
  1239.             if (cont == NULL)
  1240.                *scont_fail = lbl1;
  1241.             else {
  1242.                cur_fnc->cursor = lbl1->prev; 
  1243.                fail_sav = on_failure;
  1244.                on_failure = lbl1;
  1245.                callc_add(cont);
  1246.                on_failure = fail_sav;
  1247.                cur_fnc->cursor = lbl1;
  1248.                }
  1249.             break;
  1250.  
  1251.          case ILC_LBrc:
  1252.             /*
  1253.              * non-deletable '{'
  1254.              */
  1255.             cd = NewCode(0);
  1256.             cd->cd_id = C_LBrack;
  1257.             cd_add(cd);
  1258.             break;
  1259.  
  1260.          case ILC_RBrc:
  1261.             /*
  1262.              * non-deletable '}'
  1263.              */
  1264.             cd = NewCode(0);
  1265.             cd->cd_id = C_RBrack;
  1266.             cd_add(cd);
  1267.             break;
  1268.  
  1269.          case ILC_CGto:
  1270.             /*
  1271.              * Conditional goto.
  1272.              */
  1273.             i = ilc->n;
  1274.             if (lbls[i] == NULL)
  1275.                lbls[i] = oper_lbl("within");
  1276.             cd = NewCode(2);
  1277.             cd->cd_id = C_If;
  1278.             cd1 = alc_ary(1);
  1279.             sub_ilc(ilc->code[0], cd1, 0);
  1280.             cd->Cond = cd1;
  1281.             cd->ThenStmt = mk_goto(lbls[i]);
  1282.             cd_add(cd);
  1283.             break;
  1284.  
  1285.          case ILC_Goto:
  1286.             /*
  1287.              * Goto.
  1288.              */
  1289.             i = ilc->n;
  1290.             if (lbls[i] == NULL)
  1291.                lbls[i] = oper_lbl("within");
  1292.             cd_add(mk_goto(lbls[i]));
  1293.             break;
  1294.  
  1295.          case ILC_Lbl:
  1296.             /*
  1297.              * Label.
  1298.              */
  1299.             i = ilc->n;
  1300.             if (lbls[i] == NULL)
  1301.                lbls[i] = oper_lbl("within");
  1302.             cd_add(lbls[i]);
  1303.             break;
  1304.  
  1305.          default:
  1306.             fprintf(stderr, "compiler error: unknown info in data base\n");
  1307.             exit(1);
  1308.          }
  1309.       ilc = ilc->next;
  1310.       }
  1311.  
  1312.    if (max_lbl > 0)
  1313.       free((char *)lbls);
  1314.    }
  1315.  
  1316. /*
  1317.  * line_ilc - gather a line of in-line code.
  1318.  */
  1319. static struct il_c *line_ilc(ilc)
  1320. struct il_c *ilc;
  1321.    {
  1322.    struct il_c *ilc1;
  1323.    struct il_c *last;
  1324.    struct code *cd;
  1325.    int n;
  1326.    int i;
  1327.  
  1328.    /*
  1329.     * Count the number of pieces in the line. Determine the last
  1330.     *  piece in the sequence; this is returned to the caller.
  1331.     */
  1332.    n = 0;
  1333.    ilc1 = ilc;
  1334.    while (ilc1 != NULL) {
  1335.       switch(ilc1->il_c_type) {
  1336.          case ILC_Ref:
  1337.          case ILC_Mod:
  1338.          case ILC_Tend:
  1339.          case ILC_SBuf:
  1340.          case ILC_CBuf:
  1341.          case ILC_Str:
  1342.             ++n;
  1343.             last = ilc1;
  1344.             ilc1 = ilc1->next;
  1345.             break;
  1346.          default: 
  1347.             ilc1 = NULL;
  1348.          }
  1349.       }
  1350.  
  1351.    /*
  1352.     * Construct the line.
  1353.     */
  1354.    cd = alc_ary(n);
  1355.    for (i = 0; i < n; ++i) {
  1356.       switch(ilc->il_c_type) {
  1357.          case ILC_Ref:
  1358.          case ILC_Mod:
  1359.             /*
  1360.              * Reference to variable in symbol table.
  1361.              */
  1362.             cd->ElemTyp(i) = A_ValLoc;
  1363.             if (ilc->n == RsltIndx)
  1364.                cd->ValLoc(i) = rslt;
  1365.             else
  1366.                cd->ValLoc(i) = cur_symtab[ilc->n].loc;
  1367.             break;
  1368.  
  1369.          case ILC_Tend:
  1370.             /*
  1371.              * Reference to a tended variable.
  1372.              */
  1373.             cd->ElemTyp(i) = A_ValLoc;
  1374.             cd->ValLoc(i) = tended[ilc->n];
  1375.             break;
  1376.  
  1377.          case ILC_SBuf:
  1378.             /*
  1379.              * String buffer for a conversion.
  1380.              */
  1381.             cd->ElemTyp(i) = A_SBuf;
  1382.             cd->Intgr(i) = alc_sbufs(1, intrnl_lftm);
  1383.             break;
  1384.  
  1385.          case ILC_CBuf:
  1386.             /*
  1387.              * Cset buffer for a conversion.
  1388.              */
  1389.             cd->ElemTyp(i) = A_CBuf;
  1390.             cd->Intgr(i) = alc_cbufs(1, intrnl_lftm);
  1391.             break;
  1392.  
  1393.          case ILC_Str:
  1394.             /*
  1395.              * String representing C code.
  1396.              */
  1397.             cd->ElemTyp(i) = A_Str;
  1398.             cd->Str(i) = ilc->s;
  1399.             break;
  1400.  
  1401.          default:
  1402.             ilc = NULL;  
  1403.          }
  1404.       ilc = ilc->next;
  1405.       }
  1406.  
  1407.    cd_add(cd);
  1408.    return last;
  1409.    }
  1410.  
  1411. /*
  1412.  * generate code to perform simple type checking.
  1413.  */
  1414. struct code *typ_chk(var, typcd)
  1415. struct il_code *var;
  1416. int typcd;
  1417.    {
  1418.    struct code *cd;
  1419.  
  1420.    if (typcd == int_typ && largeints) {
  1421.       /*
  1422.        * Handle large integer support specially.
  1423.        */
  1424.       cd = alc_ary(5);
  1425.       cd->ElemTyp(0) = A_Str;
  1426.       cd->Str(0) =                           "((";
  1427.       il_var(var, cd, 1);                    /* value */
  1428.       cd->ElemTyp(2) = A_Str;
  1429.       cd->Str(2) =                           ").dword == D_Integer || (";
  1430.       il_var(var, cd, 3);                    /* value */
  1431.       cd->ElemTyp(4) = A_Str;
  1432.       cd->Str(4) =                           ").dword == D_Lrgint)";
  1433.       return cd;
  1434.       }
  1435.    else if (typcd < 0) {
  1436.       /*
  1437.        * Not a standard Icon type name.
  1438.        */
  1439.       cd = alc_ary(3);
  1440.       cd->ElemTyp(0) = A_Str;
  1441.       switch (typcd) {
  1442.          case TypVar:
  1443.             cd->Str(0) =                     "(((";
  1444.             il_var(var, cd, 1);              /* value */
  1445.             cd->ElemTyp(2) = A_Str;
  1446.             cd->Str(2) =                     ").dword & D_Var) == D_Var)";
  1447.             break;
  1448.          case TypCInt:
  1449.             cd->Str(0) =                     "((";
  1450.             il_var(var, cd, 1);              /* value */
  1451.             cd->ElemTyp(2) = A_Str;
  1452.             cd->Str(2) =                     ").dword == D_Integer)";
  1453.             break;
  1454.          }
  1455.       }
  1456.    else if (typcd == str_typ) {
  1457.       cd = alc_ary(3);
  1458.       cd->ElemTyp(0) = A_Str;
  1459.       cd->Str(0) =                           "(!((";
  1460.       il_var(var, cd, 1);                    /* value */
  1461.       cd->ElemTyp(2) = A_Str;
  1462.       cd->Str(2) =                           ").dword & F_Nqual))";
  1463.       }
  1464.    else {
  1465.       cd = alc_ary(5);
  1466.       cd->ElemTyp(0) = A_Str;
  1467.       cd->Str(0) =                           "((";
  1468.       il_var(var, cd, 1);                    /* value */
  1469.       cd->ElemTyp(2) = A_Str;
  1470.       cd->Str(2) =                           ").dword == D_";
  1471.       cd->ElemTyp(3) = A_Str;
  1472.       cd->Str(3) = icontypes[typcd].cap_id;  /* type name */
  1473.       cd->ElemTyp(4) = A_Str;
  1474.       cd->Str(4) =                           ")";
  1475.       }
  1476.  
  1477.    return cd;
  1478.    }
  1479.  
  1480. /*
  1481.  * oper_lbl - generate a label with an associated comment that includes
  1482.  *   the operation name.
  1483.  */
  1484. static struct code *oper_lbl(s)
  1485. char *s;
  1486.    {
  1487.    char *sbuf;
  1488.  
  1489.    sbuf = (char *)alloc((unsigned int)(strlen(s) + strlen(impl->name) + 3));
  1490.    sprintf(sbuf, "%s: %s", s, impl->name);
  1491.    return alc_lbl(sbuf, 0);
  1492.    }
  1493.  
  1494. /*
  1495.  * sav_locs - save the current interpretation of symbols that may
  1496.  *  be affected by conversions.
  1497.  */
  1498. static struct val_loc **sav_locs()
  1499.    {
  1500.    struct val_loc **locs;
  1501.    int i;
  1502.  
  1503.    if (nsyms == 0)
  1504.       return NULL;
  1505.  
  1506.    locs = (struct val_loc **)alloc((unsigned int)(nsyms *
  1507.       sizeof(struct val_loc *)));
  1508.    for (i = 0; i < nsyms; ++i)
  1509.       locs[i] = cur_symtab[i].loc;
  1510.    return locs;
  1511.    }
  1512.  
  1513. /*
  1514.  * rstr_locs - restore the interpretation of symbols that may
  1515.  *  have been affected by conversions.
  1516.  */
  1517. static novalue rstr_locs(locs)
  1518. struct val_loc **locs;
  1519.    {
  1520.    int i;
  1521.  
  1522.    for (i = 0; i < nsyms; ++i)
  1523.       cur_symtab[i].loc = locs[i];
  1524.    free((char *)locs);
  1525.    }
  1526.  
  1527. /*
  1528.  * mrg_locs - merge the interpretations of symbols along two execution
  1529.  *  paths. Any ambiguity is caught by rtt, so differences only occur
  1530.  *  if one path involves program termination so that the symbols
  1531.  *  no longer have an interpretation along that path.
  1532.  */
  1533. static novalue mrg_locs(locs)
  1534. struct val_loc **locs;
  1535.    {
  1536.    int i;
  1537.  
  1538.    for (i = 0; i < nsyms; ++i)
  1539.       if (cur_symtab[i].loc == NULL)
  1540.          cur_symtab[i].loc = locs[i];
  1541.    free((char *)locs);
  1542.    }
  1543.  
  1544. /*
  1545.  * il_cnv - generate code for an in-line conversion.
  1546.  */
  1547. struct code *il_cnv(typcd, src, dflt, dest)
  1548. int typcd;
  1549. struct il_code *src;
  1550. struct il_c *dflt;
  1551. struct il_c *dest;
  1552.    {
  1553.    struct code *cd;
  1554.    struct code *cd1;
  1555.    int dflt_to_ptr;
  1556.    int loc;
  1557.    int is_cstr;
  1558.    int sym_indx;
  1559.    int n;
  1560.    int i;
  1561.  
  1562.    sym_indx = src->u[0].n;
  1563.  
  1564.    /*
  1565.     * Determine whether the address must be taken of a default value and
  1566.     *  whether the interpretation of the symbol in an in-place conversion
  1567.     *  changes.
  1568.     */
  1569.    dflt_to_ptr = 0;
  1570.    loc = PrmTend;
  1571.    is_cstr = 0;
  1572.    switch (typcd) {
  1573.       case TypCInt:
  1574.       case TypECInt:
  1575.          loc = PrmInt;
  1576.          break;
  1577.       case TypCDbl:
  1578.          loc = PrmDbl;
  1579.          break;
  1580.       case TypCStr:
  1581.          is_cstr = 1;
  1582.          break;
  1583.       case TypEInt:
  1584.          break;
  1585.       case TypTStr:
  1586.       case TypTCset:
  1587.          dflt_to_ptr = 1;
  1588.          break;
  1589.       default:
  1590.          /*
  1591.           * Cset, real, integer, or string
  1592.           */
  1593.          if (typcd == cset_typ || typcd == str_typ)
  1594.             dflt_to_ptr = 1;
  1595.          break;
  1596.       }
  1597.  
  1598.   if (typcd == TypCDbl && !(eval_is(real_typ, sym_indx) & MaybeFalse)) {
  1599.      /*
  1600.       * Conversion from Icon real to C double. Just copy the C value
  1601.       *  from the block.
  1602.       */
  1603.      cd = alc_ary(5);
  1604.      cd->ElemTyp(0) = A_Str;
  1605.      cd->Str(0) =                "(GetReal(&(";
  1606.      il_var(src, cd, 1);
  1607.      cd->ElemTyp(2) = A_Str;
  1608.      cd->Str(2) =                "), ";
  1609.      cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 3);
  1610.      cd->ElemTyp(4) = A_Str;
  1611.      cd->Str(4) =                "), 1)";
  1612.      }
  1613.   else if (typcd == TypCDbl && !largeints &&
  1614.      !(eval_is(int_typ, sym_indx) & MaybeFalse)) {
  1615.      /*
  1616.       * Conversion from Icon integer (not large integer) to C double.
  1617.       *  Do as a C conversion by an assigment.
  1618.       */
  1619.      cd = alc_ary(5);
  1620.      cd->ElemTyp(0) = A_Str;
  1621.      cd->Str(0) =                "(";
  1622.      cd->ElemTyp(2) = A_Str;
  1623.      cd->Str(2) =                " = IntVal( ";
  1624.      cd->ElemTyp(4) = A_Str;
  1625.      cd->Str(4) =                "), 1)";
  1626.      /*
  1627.       * Note that cnv_dest() must be called after the source is output
  1628.       *  in case it changes the location of the parameter.
  1629.       */
  1630.      il_var(src, cd, 3);
  1631.      cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 1);
  1632.      }
  1633.    else {
  1634.       /*
  1635.        * Compute the number of code fragments required to construct the
  1636.        *  call to the conversion routine.
  1637.        */
  1638.       n = 7;
  1639.       if (dflt != NULL)
  1640.         n += 2;
  1641.    
  1642.       cd = alc_ary(n);
  1643.    
  1644.       /*
  1645.        * The names of simple conversions are distinguished from defaulting
  1646.        *  conversions by a prefix of "cnv_" or "def_".
  1647.        */
  1648.       cd->ElemTyp(0) = A_Str;
  1649.       if (dflt == NULL)
  1650.          cd->Str(0) = "cnv_";
  1651.       else
  1652.          cd->Str(0) = "def_";
  1653.    
  1654.       /*
  1655.        * Determine the name of the conversion routine.
  1656.        */
  1657.       cd->ElemTyp(1) = A_Str;    /* may be overridden */
  1658.       switch (typcd) {
  1659.          case TypCInt:
  1660.             cd->Str(1) = "c_int(&(";
  1661.             break;
  1662.          case TypCDbl:
  1663.             cd->Str(1) = "c_dbl(&(";
  1664.             break;
  1665.          case TypCStr:
  1666.             cd->Str(1) = "c_str(&(";
  1667.             break;
  1668.          case TypEInt:
  1669.             cd->Str(1) = "eint(&(";
  1670.             break;
  1671.          case TypECInt:
  1672.             cd->Str(1) = "ec_int(&(";
  1673.             break;
  1674.          case TypTStr:
  1675.             /*
  1676.              * Allocate a string buffer.
  1677.              */
  1678.             cd1 = alc_ary(3);
  1679.             cd1->ElemTyp(0) = A_Str;
  1680.             cd1->Str(0) = "tstr(";
  1681.             cd1->ElemTyp(1) = A_SBuf;
  1682.             cd1->Intgr(1) = alc_sbufs(1, intrnl_lftm);
  1683.             cd1->ElemTyp(2) = A_Str;
  1684.             cd1->Str(2) = ", (&";
  1685.             cd->ElemTyp(1) = A_Ary;
  1686.             cd->Array(1) = cd1;
  1687.             break;
  1688.          case TypTCset:
  1689.             /*
  1690.              * Allocate a cset buffer.
  1691.              */
  1692.             cd1 = alc_ary(3);
  1693.             cd1->ElemTyp(0) = A_Str;
  1694.             cd1->Str(0) = "tcset(";
  1695.             cd1->ElemTyp(1) = A_CBuf;
  1696.             cd1->Intgr(1) = alc_cbufs(1, intrnl_lftm);
  1697.             cd1->ElemTyp(2) = A_Str;
  1698.             cd1->Str(2) = ", &(";
  1699.             cd->ElemTyp(1) = A_Ary;
  1700.             cd->Array(1) = cd1;
  1701.             break;
  1702.          default:
  1703.             /*
  1704.              * Cset, real, integer, or string
  1705.              */
  1706.             if (typcd == cset_typ)
  1707.                cd->Str(1) = "cset(&(";
  1708.             else if (typcd == real_typ) 
  1709.                cd->Str(1) = "real(&(";
  1710.             else if (typcd == int_typ) 
  1711.                cd->Str(1) = "int(&(";
  1712.             else if (typcd == str_typ)
  1713.                cd->Str(1) = "str(&(";
  1714.             break;
  1715.          }
  1716.    
  1717.       il_var(src, cd, 2);
  1718.    
  1719.       cd->ElemTyp(3) = A_Str;
  1720.       if (dflt != NULL && dflt_to_ptr)
  1721.          cd->Str(3) = "), &(";
  1722.       else
  1723.          cd->Str(3) = "), ";
  1724.    
  1725.    
  1726.       /*
  1727.        * Determine if this conversion has a default value.
  1728.        */
  1729.       i = 4;
  1730.       if (dflt != NULL) {
  1731.          sub_ilc(dflt, cd, i);
  1732.          ++i;
  1733.          cd->ElemTyp(i) = A_Str;
  1734.          if (dflt_to_ptr)
  1735.             cd->Str(i) = "), ";
  1736.          else
  1737.             cd->Str(i) = ", ";
  1738.          ++i;
  1739.          }
  1740.    
  1741.       cd->ElemTyp(i) = A_Str;
  1742.       cd->Str(i) = "&(";
  1743.       ++i;
  1744.       cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i);
  1745.       ++i;
  1746.       cd->ElemTyp(i) = A_Str;
  1747.       cd->Str(i) = "))";
  1748.       }
  1749.    return cd;
  1750.    }
  1751.  
  1752. /*
  1753.  * il_dflt - generate code for a defaulting conversion that always defaults.
  1754.  */
  1755. struct code *il_dflt(typcd, src, dflt, dest)
  1756. int typcd;
  1757. struct il_code *src;
  1758. struct il_c *dflt;
  1759. struct il_c *dest;
  1760.    {
  1761.    struct code *cd;
  1762.    int sym_indx;
  1763.  
  1764.    sym_indx = src->u[0].n;
  1765.  
  1766.    if (typcd == TypCDbl) {
  1767.       cd = alc_ary(5);
  1768.       cd->ElemTyp(0) = A_Str;
  1769.       cd->Str(0) =                                      "(";
  1770.       cnv_dest(PrmDbl, 0, src, sym_indx, dest, cd, 1);  /* variable */
  1771.       cd->ElemTyp(2) = A_Str;
  1772.       cd->Str(2) =                                      " = ";
  1773.       sub_ilc(dflt, cd, 3);                             /* default */
  1774.       cd->ElemTyp(4) = A_Str;
  1775.       cd->Str(4) =                                      ", 1)";
  1776.       }
  1777.    else if (typcd == TypCInt || typcd == TypECInt) {
  1778.       cd = alc_ary(5);
  1779.       cd->ElemTyp(0) = A_Str;
  1780.       cd->Str(0) =                                      "(";
  1781.       cnv_dest(PrmInt, 0, src, sym_indx, dest, cd, 1);  /* variable */
  1782.       cd->ElemTyp(2) = A_Str;
  1783.       cd->Str(2) =                                      " = ";
  1784.       sub_ilc(dflt, cd, 3);                             /* default */
  1785.       cd->ElemTyp(4) = A_Str;
  1786.       cd->Str(4) =                                      ", 1)";
  1787.       }
  1788.    else if (typcd == TypTStr || typcd == str_typ) {
  1789.       cd = alc_ary(5);
  1790.       cd->ElemTyp(0) = A_Str;
  1791.       cd->Str(0) =                                      "(";
  1792.       cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
  1793.       cd->ElemTyp(2) = A_Str;
  1794.       cd->Str(2) =                                      " = ";
  1795.       sub_ilc(dflt, cd, 3);                             /* default */
  1796.       cd->ElemTyp(4) = A_Str;
  1797.       cd->Str(4) =                                      ", 1)";
  1798.       }
  1799.    else if (typcd == TypCStr) {
  1800.       cd = alc_ary(5);
  1801.       cd->ElemTyp(0) = A_Str;
  1802.       cd->Str(0) =                                      "(AsgnCStr(";
  1803.       cnv_dest(0, 1, src, sym_indx, dest, cd, 1);       /* variable */
  1804.       cd->ElemTyp(2) = A_Str;
  1805.       cd->Str(2) =                                      ", ";
  1806.       sub_ilc(dflt, cd, 3);                             /* default */
  1807.       cd->ElemTyp(4) = A_Str;
  1808.       cd->Str(4) =                                      "), 1)";
  1809.       }
  1810.    else if (typcd == TypTCset || typcd == cset_typ) {
  1811.       cd = alc_ary(7);
  1812.       cd->ElemTyp(0) = A_Str;
  1813.       cd->Str(0) =                                      "(BlkLoc(";
  1814.       cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
  1815.       cd->ElemTyp(2) = A_Str;
  1816.       cd->Str(2) =                                      ") = (union block *)&";
  1817.       sub_ilc(dflt, cd, 3);                             /* default */
  1818.       cd->ElemTyp(4) = A_Str;
  1819.       cd->Str(4) =                                      ", ";
  1820.       cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
  1821.       cd->ElemTyp(6) = A_Str;
  1822.       cd->Str(6) =                                      ".dword = D_Cset, 1)";
  1823.       }
  1824.    else if (typcd == TypEInt || typcd == int_typ) {
  1825.       cd = alc_ary(7);
  1826.       cd->ElemTyp(0) = A_Str;
  1827.       cd->Str(0) =                                      "(IntVal(";
  1828.       cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
  1829.       cd->ElemTyp(2) = A_Str;
  1830.       cd->Str(2) =                                      ") = ";
  1831.       sub_ilc(dflt, cd, 3);                             /* default */
  1832.       cd->ElemTyp(4) = A_Str;
  1833.       cd->Str(4) =                                      ", ";
  1834.       cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
  1835.       cd->ElemTyp(6) = A_Str;
  1836.       cd->Str(6) =                                     ".dword = D_Integer, 1)";
  1837.       }
  1838.    else if (typcd == real_typ) {
  1839.       cd = alc_ary(7);
  1840.       cd->ElemTyp(0) = A_Str;
  1841.       cd->Str(0) =                                      "((BlkLoc(";
  1842.       cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
  1843.       cd->ElemTyp(2) = A_Str;
  1844.       cd->Str(2) =                                ") = (union block *)alcreal(";
  1845.       sub_ilc(dflt, cd, 3);                             /* default */
  1846.       cd->ElemTyp(4) = A_Str;
  1847.       cd->Str(4) =                     ")) == NULL ? (fatalerr(0,NULL), 0) : (";
  1848.       cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
  1849.       cd->ElemTyp(6) = A_Str;
  1850.       cd->Str(6) =                                     ".dword = D_Real, 1))";
  1851.       }
  1852.  
  1853.    return cd;
  1854.    }
  1855.  
  1856. /*
  1857.  * cnv_dest - output the destination of a conversion.
  1858.  */
  1859. static novalue cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i)
  1860. int loc;
  1861. int is_cstr;
  1862. struct il_code *src;
  1863. int sym_indx;
  1864. struct il_c *dest;
  1865. struct code *cd;
  1866. int i;
  1867.    {
  1868.    if (dest == NULL) {
  1869.       /*
  1870.        * Convert "in place", changing the location of a parameter if needed.
  1871.        */
  1872.       switch (loc) {
  1873.          case PrmInt:
  1874.             if (cur_symtab[sym_indx].itmp_indx < 0)
  1875.                cur_symtab[sym_indx].itmp_indx = alc_itmp(intrnl_lftm);
  1876.             cur_symtab[sym_indx].loc = itmp_loc(cur_symtab[sym_indx].itmp_indx);
  1877.             break;
  1878.          case PrmDbl:
  1879.             if (cur_symtab[sym_indx].dtmp_indx < 0)
  1880.                cur_symtab[sym_indx].dtmp_indx = alc_dtmp(intrnl_lftm);
  1881.             cur_symtab[sym_indx].loc = dtmp_loc(cur_symtab[sym_indx].dtmp_indx);
  1882.             break;
  1883.          }
  1884.       il_var(src, cd, i);
  1885.       if (is_cstr)
  1886.          cur_symtab[sym_indx].loc = loc_cpy(cur_symtab[sym_indx].loc,M_CharPtr);
  1887.       }
  1888.    else {
  1889.       if (is_cstr && dest->il_c_type == ILC_Mod && dest->next == NULL &&
  1890.          dest->n != RsltIndx && cur_symtab[dest->n].loc->mod_access != M_None) {
  1891.             /*
  1892.              * We are converting to a C string. The destination variable
  1893.              *  is not defined as a simple descriptor, but must be accessed
  1894.              *  as such for this conversion.
  1895.              */
  1896.             cd->ElemTyp(i) = A_ValLoc;
  1897.             cd->ValLoc(i) = loc_cpy(cur_symtab[dest->n].loc, M_None);
  1898.             }
  1899.       else 
  1900.          sub_ilc(dest, cd, i);
  1901.       }
  1902.  
  1903.    }
  1904.  
  1905. /*
  1906.  * il_copy - produce code for an optimized "conversion" that always succeeds
  1907.  *   and just copies a value from one place to another.
  1908.  */
  1909. struct code *il_copy(dest, src)
  1910. struct il_c *dest;
  1911. struct val_loc *src;
  1912.    {
  1913.    struct code *cd;
  1914.  
  1915.    cd = alc_ary(5);
  1916.    cd->ElemTyp(0) = A_Str;
  1917.    cd->Str(0) = "(";
  1918.    sub_ilc(dest, cd, 1);
  1919.    cd->ElemTyp(2) = A_Str;
  1920.    cd->Str(2) = " = ";
  1921.    cd->ElemTyp(3) = A_ValLoc;
  1922.    cd->ValLoc(3) = src;
  1923.    cd->ElemTyp(4) = A_Str;
  1924.    cd->Str(4) = ", 1)";
  1925.    return cd;
  1926.    }
  1927.  
  1928. /*
  1929.  * loc_cpy - make a copy of a reference to a value location, but change
  1930.  *  the way the location is accessed.
  1931.  */
  1932. struct val_loc *loc_cpy(loc, mod_access)
  1933. struct val_loc *loc;
  1934. int mod_access;
  1935.    {
  1936.    struct val_loc *new_loc;
  1937.  
  1938.    if (loc == NULL)
  1939.       return NULL;
  1940.    new_loc = NewStruct(val_loc);
  1941.    *new_loc = *loc;
  1942.    new_loc->mod_access = mod_access;
  1943.    return new_loc;
  1944.    }
  1945.  
  1946. /*
  1947.  * gen_tcase - generate in-line code for a type_case statement.
  1948.  */
  1949. static int gen_tcase(il, has_dflt)
  1950. struct il_code *il;
  1951. int has_dflt;
  1952.    {
  1953.    struct case_anlz case_anlz;
  1954.  
  1955.    /*
  1956.     * We can only get here if the type_case statement can be implemented
  1957.     *  with a no more than one type check. Determine how simple the
  1958.     *  code can be.
  1959.     */
  1960.    findcases(il, has_dflt, &case_anlz);
  1961.    if (case_anlz.il_then == NULL) {
  1962.       if (case_anlz.il_else == NULL)
  1963.          return 1;
  1964.       else
  1965.          return gen_il(case_anlz.il_else);
  1966.       }
  1967.    else
  1968.       return gen_if(typ_chk(il->u[0].fld, case_anlz.typcd), case_anlz.il_then,
  1969.          case_anlz.il_else, sav_locs());
  1970.    }
  1971.  
  1972. /*
  1973.  * gen_if - generate code to test a condition that might be true
  1974.  *  of false. Determine if execution can continue past this if statement.
  1975.  */
  1976. static int gen_if(cond_cd, il_then, il_else, locs)
  1977. struct code *cond_cd;
  1978. struct il_code *il_then;
  1979. struct il_code *il_else;
  1980. struct val_loc **locs;
  1981.    {
  1982.    struct val_loc **locs1;
  1983.    struct code *lbl_then;
  1984.    struct code *lbl_end;
  1985.    struct code *else_loc;
  1986.    struct code *cd;
  1987.    int fall_thru;
  1988.  
  1989.    lbl_then = oper_lbl("then");
  1990.    lbl_end = oper_lbl("end if");
  1991.    cd = NewCode(2);
  1992.    cd->cd_id = C_If;
  1993.    cd->Cond = cond_cd;
  1994.    cd->ThenStmt = mk_goto(lbl_then);
  1995.    cd_add(cd);
  1996.    else_loc = cur_fnc->cursor;
  1997.    cd_add(lbl_then);
  1998.    fall_thru = gen_il(il_then);
  1999.    cd_add(lbl_end);
  2000.    locs1 = sav_locs();
  2001.    rstr_locs(locs);
  2002.    cur_fnc->cursor = else_loc;  /* go back for the else clause */
  2003.    fall_thru |= gen_il(il_else);
  2004.    cd_add(mk_goto(lbl_end));
  2005.    cur_fnc->cursor = lbl_end;
  2006.    mrg_locs(locs1);
  2007.    return fall_thru;
  2008.    }
  2009.