text: /*
   * inline.c - routines to put run-time routines in-line.
   */
  #include "../h/gsupport.h"
  #include "ctrans.h"
  #include "ccode.h"
  #include "csym.h"
  #include "ctree.h"
  #include "cproto.h"
  #include "cglobals.h"
  
  /*
   * Prototypes for static functions.
   */
  static void          arth_arg  ( struct il_code *var,
                                      struct val_loc *v_orig, int chk,
                                      struct code *cnv);
  static int              body_fnc  (struct il_code *il);
  static void          chkforblk (void);
  static void          cnv_dest  (int loc, int is_cstr,
                                      struct il_code *src, int sym_indx,
                                      struct il_c *dest, struct code *cd, int i);
  static void          dwrd_asgn (struct val_loc *vloc, char *typ);
  static struct il_c     *line_ilc  (struct il_c *ilc);
  static int              gen_if    (struct code *cond_cd,
                                      struct il_code *il_then,
                                      struct il_code *il_else,
                                      struct val_loc **locs);
  static int              gen_il    (struct il_code *il);
  static void          gen_ilc   (struct il_c *il);
  static void          gen_ilret (struct il_c *ilc);
  static int              gen_tcase (struct il_code *il, int has_dflt);
  static void          il_var    (struct il_code *il, struct code *cd,
                                      int indx);
  static void          mrg_locs  (struct val_loc **locs);
  static struct code     *oper_lbl  (char *s);
  static int          part_asgn (struct val_loc *vloc, char *asgn,
                                      struct il_c *value);
  static void          rstr_locs (struct val_loc **locs);
  static struct val_loc **sav_locs  (void);
  static void         sub_ilc    (struct il_c *ilc, struct code *cd, int indx); 
  /* mdw */static void sub_ilc_fncall_explicit_arg(struct il_c * argilc, struct il_c * proto, struct code * cd, int indx);
  
  /*
   * There are many parameters that are shared by multiple routines. There
   *  are copied into statics.
   */
  static struct val_loc *rslt;     /* result location */
  static struct code **scont_strt; /* label following operation code */
  static struct code **scont_fail; /* resumption label for in-line suspend */
  static struct c_fnc *cont;       /* success continuation */
  static struct implement *impl;   /* data base entry for operation */
  static int nsyms;                /* number symbols in operation symbol table */
  static int n_vararg;             /* size of variable part of arg list */
  static nodeptr intrnl_lftm;      /* lifetime of internal variables */
  static struct val_loc **tended;  /* array of tended locals */
  
  /*
   * gen_inlin - generate in-line code for an operation.
   */
  void gen_inlin(il, r, strt, fail, c, ip, ns, st, n, dcl_var, n_va)
  struct il_code *il;
  struct val_loc *r;
  struct code **strt;
  struct code **fail;
  struct c_fnc *c;
  struct implement *ip;
  int ns;
  struct op_symentry *st;
  nodeptr n;
  int dcl_var;
  int n_va;
     {
     struct code *cd;
     struct val_loc *tnd;
     int i;
  
     /*
      * Copy arguments in to globals.
      */
     rslt = r;
     scont_strt = strt;
     scont_fail = fail;
     cont = c;
     impl = ip;
     nsyms = ns;
     cur_symtab = st;
     intrnl_lftm = n->intrnl_lftm;
     cur_symtyps = n->symtyps;
     n_vararg = n_va;
  
     /*
      * Generate code to initialize local tended descriptors and determine
      *  how to access the descriptors.
      */
     for (i = 0; i < impl->ntnds; ++i) {
        if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
           tnd = chk_alc(NULL, n->intrnl_lftm);
            switch (impl->tnds[i].var_type) {
               case TndDesc:
                  cur_symtab[dcl_var].loc = tnd; 
                  break;
               case TndStr:
                  cd = alc_ary(2);
                  cd->ElemTyp(0) = A_ValLoc;
                  cd->ValLoc(0) =                tnd;
                  cd->ElemTyp(1) = A_Str;
                  cd->Str(1) =                   " = emptystr;";
                  cd_add(cd);
                  cur_symtab[dcl_var].loc = loc_cpy(tnd, M_CharPtr);
                  break;
               case TndBlk:
                  cd = alc_ary(2);
                  cd->ElemTyp(0) = A_ValLoc;
                  cd->ValLoc(0) =                tnd;
                  cd->ElemTyp(1) = A_Str;
                  cd->Str(1) =                   " = nullptr;"; 
                  cd_add(cd);
                  cur_symtab[dcl_var].loc = loc_cpy(tnd, M_BlkPtr);
                  cur_symtab[dcl_var].loc->blk_name = impl->tnds[i].blk_name;
                  break;
               }
           if (impl->tnds[i].init != NULL) {
               cd = alc_ary(4);
               cd->ElemTyp(0) = A_ValLoc;
               cd->ValLoc(0) =                cur_symtab[dcl_var].loc;
               cd->ElemTyp(1) = A_Str;
               cd->Str(1) =                   " = "; 
               sub_ilc(impl->tnds[i].init, cd, 2);
               cd->ElemTyp(3) = A_Str;
               cd->Str(3) =                   ";"; 
               cd_add(cd);
               }
           }
        ++dcl_var;
        }
  
     /*
      * If there are local non-tended variables, generate code for the
      *  declarations, placing everything in braces.
       */
     if (impl->nvars > 0) {
        cd = NewCode(0);
        cd->cd_id = C_LBrack;    /* { */
        cd_add(cd);
        for (i = 0;  i < impl->nvars; ++i) {
           if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
              gen_ilc(impl->vars[i].dcl);
              cur_symtab[dcl_var].loc = cvar_loc(impl->vars[i].name);
              }
           ++dcl_var;
           }
        }
  
     gen_il(il);  /* generate executable code */
  
     if (impl->nvars > 0) {
        cd = NewCode(0);
        cd->cd_id = C_RBrack;    /* } */
        cd_add(cd);
        }
     }
  
  /*
   * gen_il - generate code from a sub-tree of in-line code from the data
   *  base. Determine if execution can continue past this code.
   *
   */
  static int gen_il(il)
  struct il_code *il;
     {
     struct code *cd;
     struct code *cd1;
     struct il_code *il_cond;
     struct il_code *il_then;
     struct il_code *il_else;
     struct il_code *il_t;
     struct val_loc **locs;
     struct val_loc **locs1;
     struct val_loc *tnd;
     int fall_thru;
     int cond;
     int ncases;
     int indx;
     int ntended;
     int i;
  
     if (il == NULL)
        return 1;
  
     switch (il->il_type) {
        case IL_Const: /* should have been replaced by literal node */
           return 1;
  
        case IL_If1:
        case IL_If2:
           /*
            * if-then or if-then-else statement.
            */
           il_then = il->u[1].fld;
           if (il->il_type == IL_If2)
              il_else = il->u[2].fld;
           else
              il_else = NULL;
           il_cond = il->u[0].fld;
           if (il->u[0].fld->il_type == IL_Bang) {
              il_cond = il_cond->u[0].fld;
              il_t = il_then;
              il_then = il_else;
              il_else = il_t;
              }
           locs = sav_locs();
           cond = cond_anlz(il_cond, &cd1);
           if (cond == (MaybeTrue | MaybeFalse))
              fall_thru = gen_if(cd1, il_then, il_else, locs);
           else {
              if (cd1 != NULL) {
                 cd_add(cd1);  /* condition contains needed conversions */
                 cd = alc_ary(1);
                 cd->ElemTyp(0) = A_Str;
                 cd->Str(0) =              ";";
                 cd_add(cd);
                 }
              if (cond == MaybeTrue)
                 fall_thru = gen_il(il_then);
              else if (cond == MaybeFalse) {
                 locs1 = sav_locs();
                 rstr_locs(locs);
                 locs = locs1;
                 fall_thru = gen_il(il_else);
                 }
              mrg_locs(locs);
              }
           return fall_thru;
  
        case IL_Tcase1:
           /*
            * type_case statement with no default clause.
            */
           return gen_tcase(il, 0);
  
        case IL_Tcase2:
           /*
            * type_case statement with a default clause.
            */
           return gen_tcase(il, 1);
  
        case IL_Lcase:
           /*
            * len_case statement. Determine which case matches the number
            *  of arguments.
            */
           ncases = il->u[0].n;
           indx = 1;
           for (i = 0; i < ncases; ++i) {
              if (il->u[indx++].n == n_vararg)    /* selection number */
                 return gen_il(il->u[indx].fld);  /* action */
              ++indx;
              }
           return gen_il(il->u[indx].fld);        /* default */
  
        case IL_Acase: {
           /*
            * arith_case statement.
            */
           struct il_code *var1;
           struct il_code *var2;
           struct val_loc *v_orig1;
           struct val_loc *v_orig2;
           struct code *cnv1;
           struct code *cnv2;
           int maybe_int;
           int maybe_dbl;
           int chk1;
           int chk2;
  
           var1 = il->u[0].fld;
           var2 = il->u[1].fld;
           v_orig1 = cur_symtab[var1->u[0].n].loc;  /* remember for error msgs */
           v_orig2 = cur_symtab[var2->u[0].n].loc;  /* remember for error msgs */
           arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, &cnv1,
             &chk2, &cnv2);
  
           /*
            * This statement is in-lined if there is only C integer
            *  arithmetic, only C double arithmetic, or only a run-time
            *  error.
            */
           arth_arg(var1, v_orig1, chk1, cnv1);
           arth_arg(var2, v_orig2, chk2, cnv2);
           if (maybe_int)
              return gen_il(il->u[2].fld);     /* C_integer action */
           else if (maybe_dbl)
              return gen_il(il->u[4].fld);     /* C_double action */
           else
              return 0;
           }
  
        case IL_Err1:
           /*
            * runerr() with no offending value.
            */
           cd = alc_ary(3);
           cd->ElemTyp(0) = A_Str;
           cd->Str(0) =              "err_msg(";
           cd->ElemTyp(1) = A_Intgr;
           cd->Intgr(1) =            il->u[0].n;
           cd->ElemTyp(2) = A_Str;
           cd->Str(2) =              ", NULL);";
           cd_add(cd);
           if (err_conv)
              cd_add(sig_cd(on_failure, cur_fnc));
           for (i = 0; i < nsyms; ++i)
              cur_symtab[i].loc = NULL;
           return 0;
  
        case IL_Err2:
           /*
            * runerr() with an offending value. Note the reference to
            *  the offending value descriptor.
            */
           cd = alc_ary(5);
           cd->ElemTyp(0) = A_Str;
           cd->Str(0) =              "err_msg(";
           cd->ElemTyp(1) = A_Intgr;
           cd->Intgr(1) =            il->u[0].n;
           cd->ElemTyp(2) = A_Str;
           cd->Str(2) =              ", &(";
           il_var(il->u[1].fld, cd, 3);
           cd->ElemTyp(4) = A_Str;
           cd->Str(4) =              "));";
           cd_add(cd);
           if (err_conv)
              cd_add(sig_cd(on_failure, cur_fnc));
           for (i = 0; i < nsyms; ++i)
              cur_symtab[i].loc = NULL;
           return 0;
  
        case IL_Lst:
           /*
            * Two consecutive pieces of RTL code.
            */
           fall_thru = gen_il(il->u[0].fld);
           if (fall_thru)
              fall_thru = gen_il(il->u[1].fld);
           return fall_thru;
  
        case IL_Block:
           /*
            * inline {...} statement.
            *
            *  Allocate and initialize any tended locals.
            */
           ntended = il->u[1].n;
           if (ntended > 0)
              tended = (struct val_loc **)alloc((unsigned int)
                 sizeof(struct val_loc *) * ntended);
           for (i = 2; i - 2 < ntended; ++i) {
               tnd = chk_alc(NULL, intrnl_lftm);
               tended[i - 2] = tnd;
               switch (il->u[i].n) {
                  case TndDesc:
                     break;
                  case TndStr:
                     cd = alc_ary(2);
                     cd->ElemTyp(0) = A_ValLoc;
                     cd->ValLoc(0) =                tnd;
                     cd->ElemTyp(1) = A_Str;
                     cd->Str(1) =                   " = emptystr;";
                     cd_add(cd);
                     break;
                  case TndBlk:
                     cd = alc_ary(2);
                     cd->ElemTyp(0) = A_ValLoc;
                     cd->ValLoc(0) =                tnd;
                     cd->ElemTyp(1) = A_Str;
                     cd->Str(1) =                   " = nullptr;"; 
                     cd_add(cd);
                     break;
                  }
              }
           gen_ilc(il->u[i].c_cd);    /* body of block */
           /*
            * See if execution can fall through this code.
            */
           if (il->u[0].n)
              return 1;
           else {
              for (i = 0; i < nsyms; ++i)
                 cur_symtab[i].loc = NULL;
              return 0;
              }
  
        case IL_Call:
           /*
            * call to body function.
            */
           return body_fnc(il);
  
        case IL_Abstr:
           /*
            * abstract type computation. Only used by type inference.
            */
           return 1;
  
        default:
           fprintf(stderr, "compiler error: unknown info in data base\n");
           exit(1);
           /* NOTREACHED */
        }
     }
  
  /*
   * arth_arg - in-line code to check a conversion for an arith_case statement.
   */
  static void arth_arg(var, v_orig, chk, cnv)
  struct il_code *var;
  struct val_loc *v_orig;
  int chk;
  struct code *cnv;
     {
     struct code *lbl;
     struct code *cd;
  
     if (chk) {
        /*
         * Must check the conversion.
         */
        lbl = oper_lbl("converted");
        cd_add(lbl);
        cur_fnc->cursor = lbl->prev;        /* code goes before label */
        if (cnv != NULL) {
           cd = NewCode(2);
           cd->cd_id = C_If;
           cd->Cond = cnv;
           cd->ThenStmt = mk_goto(lbl);
           cd_add(cd);
           }
        cd = alc_ary(3);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =              "err_msg(102, &(";
        cd->ElemTyp(1) = A_ValLoc;
        cd->ValLoc(1) =           v_orig;    /* var location before conversion */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =              "));";
        cd_add(cd);
        if (err_conv)
           cd_add(sig_cd(on_failure, cur_fnc));
        cur_fnc->cursor = lbl;
        }
     else if (cnv != NULL) {
        cd_add(cnv);          /* conversion cannot fail  */
        cd = alc_ary(1);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =              ";";
        cd_add(cd);
        }
     }
  
  /*
   * body_fnc - generate code to call a body function.
   */
  static int body_fnc(il)
  struct il_code *il;
     {
     struct code *arg_lst;
     struct code *cd;
     struct c_fnc *cont1;
     char *oper_nm;
     int ret_val;
     int ret_flag;
     int need_rslt;
     int num_sbuf;
     int num_cbuf;
     int expl_args;
     int arglst_sz;  /* size of arg list in number of code pieces */
     int il_indx;
     int cd_indx;
     int proto_prt;
     int i;
  
     /*
      * Determine if a function prototype has been printed yet for this
      *  body function.
      */
     proto_prt = il->u[0].n;
     il->u[0].n = 1;
  
     /*
      * Construct the name of the body function.
      */
     oper_nm = (char *)alloc((unsigned int)(strlen(impl->name) + 6));
     sprintf(oper_nm, "%c%c%c%c_%s", impl->oper_typ, impl->prefix[0],
        impl->prefix[1], (char)il->u[1].n, impl->name);
  
     /*
      * Extract from the call the flags and other information describing
      *  the function, then use this information to deduce the arguments
      *  needed by the function.
      */
     ret_val = il->u[2].n;
     ret_flag = il->u[3].n;
     need_rslt = il->u[4].n;
     num_sbuf = il->u[5].n;
     num_cbuf = il->u[6].n;
     expl_args = il->u[7].n;
  
     /*
      * determine how large the argument list is.
      */
     arglst_sz = 2 * expl_args - 1;
     if (num_sbuf > 0)
        arglst_sz += 3;
     if (num_cbuf > 0)
        arglst_sz += 2;
     if (need_rslt)
        arglst_sz += 3;
     if (arglst_sz > 0)
        arg_lst = alc_ary(arglst_sz);
     else
        arg_lst = alc_ary(0);
  
     if (!proto_prt) {
        /*
         * Determine whether the body function returns a C integer, double,
         *  no value, or a signal.
         */
        switch (ret_val) {
           case RetInt:
              fprintf(inclfile, "C_integer %s (", oper_nm);
              break;
           case RetDbl:
              fprintf(inclfile, "double %s (", oper_nm);
              break;
           case RetNoVal:
              fprintf(inclfile, "void %s (", oper_nm);
              break;
           case RetSig:
              fprintf(inclfile, "int %s (", oper_nm);
              break;
           }
       }
  
     /*
      * Produce prototype and code for the explicit arguments in the
      *  function call. Note that the call entry contains C code for both.
      */
     il_indx = 8;
     cd_indx = 0;
     while (expl_args--) {
        if (cd_indx > 0) {
           /*
            * Not first entry, precede by ','.
            */
           arg_lst->ElemTyp(cd_indx) = A_Str;                /* , */
           arg_lst->Str(cd_indx) = ", ";
           if (!proto_prt)
              fprintf(inclfile, ", ");
           ++cd_indx;
           }
        if (!proto_prt)
           fprintf(inclfile, "%s", il->u[il_indx].c_cd->s);   /* parameter dcl */
        sub_ilc_fncall_explicit_arg(il->u[il_indx+1].c_cd, il->u[il_indx].c_cd,
           arg_lst, cd_indx++);
        il_indx += 2;
        }
  
     /*
      * If string buffers are needed, allocate them and pass pointer to
      *   function.
      */
     if (num_sbuf > 0) {
        if (cd_indx > 0) {
           /*
            * Not first entry, precede by ','.
            */
           arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
           arg_lst->Str(cd_indx) = ", ";
           if (!proto_prt)
              fprintf(inclfile, ", ");
           ++cd_indx;
           }
        arg_lst->ElemTyp(cd_indx) = A_Str;
        arg_lst->Str(cd_indx) = "(char (*)[MaxCvtLen])";
        ++cd_indx;
        arg_lst->ElemTyp(cd_indx) = A_SBuf;
        arg_lst->Intgr(cd_indx) = alc_sbufs(num_sbuf, intrnl_lftm);
        if (!proto_prt)
           fprintf(inclfile, "char (*r_sbuf)[MaxCvtLen]");
        ++cd_indx;
        }
  
     /*
      * If cset buffers are needed, allocate them and pass pointer to
      *   function.
      */
     if (num_cbuf > 0) {
        if (cd_indx > 0) {
           /*
            * Not first entry, precede by ','.
            */
           arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
           arg_lst->Str(cd_indx) = ", ";
           if (!proto_prt)
              fprintf(inclfile, ", ");
           ++cd_indx;
           }
        arg_lst->ElemTyp(cd_indx) = A_CBuf;
        arg_lst->Intgr(cd_indx) = alc_cbufs(num_cbuf, intrnl_lftm);
        if (!proto_prt)
           fprintf(inclfile, "struct b_cset *r_cbuf");
        ++cd_indx;
        }
  
     /*
      * See if the function needs a pointer to the result location
      *  of the operation.
      */
     if (need_rslt) {
        if (cd_indx > 0) {
           /*
            * Not first entry, precede by ','.
            */
           arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
           arg_lst->Str(cd_indx) = ", ";
           if (!proto_prt)
              fprintf(inclfile, ", ");
           ++cd_indx;
           }
        arg_lst->ElemTyp(cd_indx) = A_Str;        /* location of result */
        arg_lst->Str(cd_indx) = "&";
        ++cd_indx;
        arg_lst->ElemTyp(cd_indx) = A_ValLoc;
        arg_lst->ValLoc(cd_indx) = rslt;
        if (!proto_prt)
           fprintf(inclfile, "dptr rslt");
        ++cd_indx;
        }
  
     if (!proto_prt) {
        /*
         * The last possible argument is the success continuation.
         *  If there are no arguments, indicate this in the prototype.
         */
        if (ret_flag & DoesSusp) {
           if (cd_indx > 0)
              fprintf(inclfile, ", ");
           fprintf(inclfile, "continuation succ_cont");
           }
        else if (cd_indx == 0)
           fprintf(inclfile, "void");
        fprintf(inclfile, ");\n");
        }
  
     /*
      * Does this call need the success continuation for the operation.
      */
     if (ret_flag & DoesSusp)
         cont1 = cont;
     else
         cont1 = NULL;
  
     switch (ret_val) {
        case RetInt:
           /*
            * The body function returns a C integer.
            */
           cd = alc_ary(6);
           cd->ElemTyp(0) = A_ValLoc;
           cd->ValLoc(0) =               rslt;
           cd->ElemTyp(1) = A_Str;
           cd->Str(1) =                  ".vword.integr = ";
           cd->ElemTyp(2) = A_Str;
           cd->Str(2) =                  oper_nm;
           cd->ElemTyp(3) = A_Str;
           cd->Str(3) =                  "(";
           cd->ElemTyp(4) = A_Ary;
           cd->Array(4) =                  arg_lst;
           cd->ElemTyp(5) = A_Str;
           cd->Str(5) =                  ");";
           cd_add(cd);
           dwrd_asgn(rslt, "Integer");
           cd_add(mk_goto(*scont_strt));
           break;
        case RetDbl:
           /*
            * The body function returns a C double.
            */
           cd = alc_ary(6);
           cd->ElemTyp(0) = A_ValLoc;
           cd->ValLoc(0) =               rslt;
           cd->ElemTyp(1) = A_Str;
  #ifdef DescriptorDouble
           cd->Str(1) =                  ".vword.realval = (double)(";
  #else					/* DescriptorDouble */
           cd->Str(1) =                  ".vword.bptr = (union block *)alcreal(";
  #endif					/* DescriptorDouble */
           cd->ElemTyp(2) = A_Str;
           cd->Str(2) =                  oper_nm;
           cd->ElemTyp(3) = A_Str;
           cd->Str(3) =                  "(";
           cd->ElemTyp(4) = A_Ary;
           cd->Array(4) =                  arg_lst;
           cd->ElemTyp(5) = A_Str;
           cd->Str(5) =                  "));";
           cd_add(cd);
           dwrd_asgn(rslt, "Real");
  #ifndef DescriptorDouble
           chkforblk();    /* make sure the block allocation succeeded */
  #endif					/* DescriptorDouble */
           cd_add(mk_goto(*scont_strt));
           break;
        case RetNoVal:
           /*
            * The body function does not directly return a value.
            */
           cd = alc_ary(4);
           cd->ElemTyp(0) = A_Str;
           cd->Str(0) =                  oper_nm;
           cd->ElemTyp(1) = A_Str;
           cd->Str(1) =                  "(";
           cd->ElemTyp(2) = A_Ary;
           cd->Array(2) =                  arg_lst;
           cd->ElemTyp(3) = A_Str;
           cd->Str(3) =                  ");";
           cd_add(cd);
           if ((ret_flag & DoesFail) | (err_conv && (ret_flag & DoesEFail)))
              cd_add(sig_cd(on_failure, cur_fnc));
           else if (ret_flag & DoesRet)
              cd_add(mk_goto(*scont_strt));
           break;
        case RetSig:
           /*
            * The body function returns a signal.
            */
           callo_add(oper_nm, ret_flag, cont1, 0, arg_lst, mk_goto(*scont_strt));
           break;
        }
     /*
      * See if execution can fall through this call.
      */
     if (ret_flag & DoesFThru)
        return 1;
     else {
        for (i = 0; i < nsyms; ++i)
           cur_symtab[i].loc = NULL;
        return 0;
        }
     }
  
  
  /*
   * il_var - generate code for a possibly subscripted variable into
   *   an element of a code array.
   */
  static void il_var(il, cd, indx)
  struct il_code *il;
  struct code *cd;
  int indx;
     {
     struct code *cd1;
  
     if (il->il_type == IL_Subscr) {
        /*
         * Subscripted variable.
         */
        cd1 = cd;
        cd = alc_ary(4);
        cd1->ElemTyp(indx) = A_Ary;
        cd1->Array(indx) = cd;
        indx = 0;
        cd->ElemTyp(1) = A_Str;
        cd->Str(1) =                  "[";
        cd->ElemTyp(2) = A_Intgr;
        cd->Intgr(2) =                il->u[1].n;
        cd->ElemTyp(3) = A_Str;
        cd->Str(3) =                  "]";
        }
  
     /*
      * See if this is the result location of the operation or an ordinary
      *  variable.
      */
     cd->ElemTyp(indx) = A_ValLoc;
     if (il->u[0].n == RsltIndx)
        cd->ValLoc(indx) = rslt;
     else
        cd->ValLoc(indx) = cur_symtab[il->u[0].n].loc;
     }
  
  /*
   * part_asgn - generate code for an assignment to (part of) a descriptor.
   */
  static int part_asgn(vloc, asgn, value)
  struct val_loc *vloc;
  char *asgn;
  struct il_c *value;
     {
     struct code *cd;
     struct val_loc *new_vloc;
     int rv = 0;
  
     cd = alc_ary(4);
     cd->ElemTyp(0) = A_ValLoc;
     cd->ValLoc(0) =                          vloc;
     cd->ElemTyp(1) = A_Str;
     cd->Str(1) =                             asgn;
     sub_ilc(value, cd, 2);                /* value */
     cd->ElemTyp(3) = A_Str;
     cd->Str(3) =                             ";";
  
     /*
      * TODO: review ifdef below, validate or remove.
      */
  #ifdef OptimizeDescripAsgn
     if ((strstr(cd->Str(1), "vword.integr =") != NULL) &&
         (cd->ElemTyp(2) == A_ValLoc) && 
         (cd->ValLoc(0)->mod_access == M_None) &&
         (cd->ValLoc(2)->mod_access == M_CInt)) {
        new_vloc = (struct val_loc *)alloc(sizeof(struct val_loc));
        memcpy(new_vloc, cd->ValLoc(2), sizeof(struct val_loc));
        new_vloc->mod_access = M_None;
        cd->Str(1)    = (char *)strdup(" = /*Q*/ "); /* why strdup?  why Q ? */
        cd->ValLoc(2) = new_vloc;
        rv = 1;
     }
  #endif				/* OptimizeDescripAsgn */
     cd_add(cd);
     return rv;
     }
  
  /*
   * dwrd_asgn - generate code to assign a type code to the dword of a descriptor.
   */
  static void dwrd_asgn(vloc, typ)
  struct val_loc *vloc;
  char *typ;
     {
     struct code *cd;
  
     cd = alc_ary(4);
     cd->ElemTyp(0) = A_ValLoc;
     cd->ValLoc(0) =               vloc;
     cd->ElemTyp(1) = A_Str;
     cd->Str(1) =                  ".dword = D_";
     cd->ElemTyp(2) = A_Str;
     cd->Str(2) =                  typ;
     cd->ElemTyp(3) = A_Str;
     cd->Str(3) =                  ";";
     cd_add(cd);
     }
  
  /*
   * Substitute inline C for the explicit arg in a func call.
   */
  static
  void
  sub_ilc_fncall_explicit_arg_old(argilc, protoilc, cd, indx)
     struct il_c * argilc;
     struct il_c * protoilc;
     struct code * cd;
     int indx;
  {
     /* printf("sub_ilc_fncall_explicit_arg: entry.\n"); */
  
     if (argilc->next) {
        /* don't process fncall args containing more than 1 piece of code */
        /* printf("sub_ilc_fncall_explicit_arg: bail 0.\n"); */
        sub_ilc(argilc, cd, indx);
        return;
     }
  
     if (argilc->il_c_type != ILC_Ref) {
        /* process non-modifying arg references only */
        /* printf("sub_ilc_fncall_explicit_arg: bail 1.\n"); */
        sub_ilc(argilc, cd, indx);
        return;
     }
  
     if (cur_symtab[argilc->n].loc->loc_type != V_Temp) {
        /* process args that refer to temp locations only */
        /* printf("sub_ilc_fncall_explicit_arg: bail 2.\n"); */
        sub_ilc(argilc, cd, indx);
        return;
     }
  
     if (protoilc->s == NULL || strncmp("C_integer", protoilc->s, 9)) {
        /* currently process only C_integer type */
        /* printf("sub_ilc_fncall_explicit_arg: bail 3.\n"); */
        sub_ilc(argilc, cd, indx);
        return;
     }
  
     cd->ElemTyp(indx) = A_ValLoc;
     cd->ValLoc(indx) = loc_cpy(cur_symtab[argilc->n].loc, M_CInt);
     /* printf("sub_ilc_fncall_explicit_arg: hit.\n"); */
     /* printf("sub_ilc_fncall_explicit_arg: proto: %s.\n", protoilc->s); */
  }
  
  static
  void
  sub_ilc_fncall_explicit_arg(argilc, protoilc, cd, indx)
     struct il_c * argilc;
     struct il_c * protoilc;
     struct code * cd;
     int indx;
  {
     int loctype;
     /* printf("sub_ilc_fncall_explicit_arg: entry.\n"); */
  
     for (; argilc && protoilc; argilc=argilc->next,protoilc=protoilc->next) {
        if (argilc->il_c_type != ILC_Ref) {
           /* process non-modifying arg references only */
           /* printf("sub_ilc_fncall_explicit_arg: bail 1.\n"); */
           sub_ilc(argilc, cd, indx);
           continue;
        }
  
        loctype = cur_symtab[argilc->n].loc->loc_type;
        if (loctype != V_Temp && loctype != V_NamedVar) {
           /* process args that refer to temp locations only */
           /* printf("sub_ilc_fncall_explicit_arg: bail 2.\n"); */
           sub_ilc(argilc, cd, indx);
           continue;
        }
  
        if (protoilc->s == NULL || strncmp("C_integer", protoilc->s, 9)) {
           /* currently process only C_integer type */
           /* printf("sub_ilc_fncall_explicit_arg: bail 3.\n"); */
           sub_ilc(argilc, cd, indx);
           continue;
        }
  
        cd->ElemTyp(indx) = A_ValLoc;
        cd->ValLoc(indx) = loc_cpy(cur_symtab[argilc->n].loc, M_CInt);
        /* printf("sub_ilc_fncall_explicit_arg: hit.\n"); */
        /* printf("sub_ilc_fncall_explicit_arg: proto: %s.\n", protoilc->s); */
     }
  }
  
  /*
   * sub_ilc - generate code from a sequence of C code and place it
   *  in a slot in a code array.
   */
  static void sub_ilc(ilc, cd, indx)
  struct il_c *ilc;
  struct code *cd;
  int indx;
     {
     struct il_c *ilc1;
     struct code *cd1;
     int n;
  
     /*
      * Count the number of pieces of C code to process.
      */
     n = 0;
     for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next)
        ++n;
  
     /*
      * If there is only one piece of code, place it directly in the 
      *  slot of the array. Otherwise allocate a sub-array and place it
      *  in the slot.
      */
     if (n > 1) {
        cd1 = cd;
        cd = alc_ary(n);
        cd1->ElemTyp(indx) = A_Ary;
        cd1->Array(indx) = cd;
        indx = 0;
        }
  
     while (ilc != NULL) {
        switch (ilc->il_c_type) {
  
           case ILC_Ref:
           case ILC_Mod:
              /*
               * Reference to variable in symbol table.
               */
              cd->ElemTyp(indx) = A_ValLoc;
              if (ilc->n == RsltIndx)
                 cd->ValLoc(indx) = rslt;
              else {
                 if (ilc->s == NULL)
                    cd->ValLoc(indx) = cur_symtab[ilc->n].loc;
                 else {
                    /*
                     * Access the entire descriptor.
                     */
                    cd->ValLoc(indx) = loc_cpy(cur_symtab[ilc->n].loc, M_None);
                    }
                 }
              break;
  
           case ILC_Tend:
              /*
               * Reference to a tended variable.
               */
              cd->ElemTyp(indx) = A_ValLoc;
              cd->ValLoc(indx) = tended[ilc->n];
              break;
  
           case ILC_Str:
              /*
               * String representing C code.
               */
              cd->ElemTyp(indx) = A_Str;
              cd->Str(indx) = ilc->s;
              break;
  
           case ILC_SBuf:
              /*
               * String buffer for a conversion.
               */
              cd->ElemTyp(indx) = A_SBuf;
              cd->Intgr(indx) = alc_sbufs(1, intrnl_lftm);
              break;
  
           case ILC_CBuf:
              /*
               * Cset buffer for a conversion.
               */
              cd->ElemTyp(indx) = A_CBuf;
              cd->Intgr(indx) = alc_cbufs(1, intrnl_lftm);
              break;
  
  
           default:
              fprintf(stderr, "compiler error: unknown info in data base\n");
              exit(1);
           }
        ilc = ilc->next;
        ++indx;
        }
     }
  
  /*
   * gen_ilret - generate code to set the result value from a suspend or
   *   return.
   */
  static void gen_ilret(ilc)
  struct il_c *ilc;
     {
     struct il_c *ilc0;
     struct code *cd;
     char *cap_id;
     int typcd;
  
     if (rslt == &ignore)
        return;    /* Don't bother computing the result; it's never used */
  
     ilc0 = ilc->code[0];
     typcd = ilc->n;
  
     if (typcd < 0) {
        /*
         * RTL returns that do not look like function calls to standard Icon
         *  type name.
         */
        switch (typcd) {
           case TypCInt:
              /*
               * return/suspend C_integer <expr>;
               */
              if (!part_asgn(rslt, ".vword.integr = ", ilc0))
  	       dwrd_asgn(rslt, "Integer");
              break;
           case TypCDbl:
              /*
               * return/suspend C_double <expr>;
               */
              cd = alc_ary(4);
              cd->ElemTyp(0) = A_ValLoc;
              cd->ValLoc(0) =             rslt;
              cd->ElemTyp(1) = A_Str;
  #ifdef DescriptorDouble
              cd->Str(1) =                ".vword.realval = (double)(";
  #else					/* DescriptorDouble */
              cd->Str(1) =                ".vword.bptr = (union block *)alcreal(";
  #endif					/* DescriptorDouble */
              sub_ilc(ilc0, cd, 2);       /* value */
              cd->ElemTyp(3) = A_Str;
              cd->Str(3) =                ");";
              cd_add(cd);
              dwrd_asgn(rslt, "Real");
  #ifndef DescriptorDouble
              chkforblk();    /* make sure the block allocation succeeded */
  #endif					/* DescriptorDouble */
              break;
           case TypCStr:
              /*
               * return/suspend C_string <expr>;
               */
              cd = alc_ary(5);
              cd->ElemTyp(0) = A_Str;
              cd->Str(0) =                  "AsgnCStr(";
              cd->ElemTyp(1) = A_ValLoc;
              cd->ValLoc(1) =               rslt;
              cd->ElemTyp(2) = A_Str;
              cd->Str(2) =                  ", ";
              sub_ilc(ilc0, cd, 3);         /* <expr> */
              cd->ElemTyp(4) = A_Str;
              cd->Str(4) =                  ");";
              cd_add(cd);
              break;
           case RetDesc:
              /*
               * return/suspend <expr>;
               */
              part_asgn(rslt, " = ", ilc0);
              break;
           case RetNVar:
              /*
               * return/suspend named_var(<desc-pntr>);
               */
              part_asgn(rslt, ".vword.descptr = ", ilc0);
              dwrd_asgn(rslt, "Var");
              break;
           case RetSVar:
              /*
               * return/suspend struct_var(<desc-pntr>, <block_pntr>);
               */
              part_asgn(rslt, ".vword.descptr = (dptr)", ilc->code[1]);
              cd = alc_ary(6);
              cd->ElemTyp(0) = A_ValLoc;
              cd->ValLoc(0) =               rslt;
              cd->ElemTyp(1) = A_Str;
              cd->Str(1) =                  ".dword = D_Var + ((word *)";
              sub_ilc(ilc0, cd, 2);       /* value */
              cd->ElemTyp(3) = A_Str;
              cd->Str(3) =                  " - (word *)";
              cd->ElemTyp(4) = A_ValLoc;
              cd->ValLoc(4) =               rslt;
              cd->ElemTyp(5) = A_Str;
              cd->Str(5) =                  ".vword.descptr);";
              cd_add(cd);
              break;
           case RetNone:
              /*
               * return/suspend result;
               *
               *  Result already set, do nothing.
               */
              break;
           default:
              fprintf(stderr,
                 "compiler error: unknown RLT return in data base\n");
              exit(1);
              /* NOTREACHED */
           }
        }
     else {
        /*
         * RTL returns that look like function calls to standard Icon type
         *  names.
         */
        cap_id = icontypes[typcd].cap_id;
        switch (icontypes[typcd].rtl_ret) {
           case TRetBlkP:
              /*
               * return/suspend <type>(<block-pntr>);
               */
              part_asgn(rslt, ".vword.bptr = (union block *)", ilc0);
              dwrd_asgn(rslt, cap_id);
              break;
           case TRetDescP:
              /*
               * return/suspend <type>(<descriptor-pntr>);
               */
              part_asgn(rslt, ".vword.descptr = (dptr)", ilc0);
              dwrd_asgn(rslt, cap_id);
              break;
           case TRetCharP:
              /*
               * return/suspend <type>(<char-pntr>);
               */
              part_asgn(rslt, ".vword.sptr = (char *)", ilc0);
              dwrd_asgn(rslt, cap_id);
              break;
           case TRetCInt:
              /*
               * return/suspend <type>(<integer>);
               */
              part_asgn(rslt, ".vword.integr = (word)", ilc0);
              dwrd_asgn(rslt, cap_id);
              break;
           case TRetSpcl:
              /*
               * RTL returns that look like function calls to standard type
               *  names but take more than one argument.
               */
              if (typcd == str_typ) {
                  /*
                  * return/suspend string(<len>, <char-pntr>);
                  */
                 part_asgn(rslt, ".vword.sptr = ", ilc->code[1]);
                 part_asgn(rslt, ".dword = ", ilc0);
                 }
              else if (typcd == stv_typ) {
                 /*
                  * return/suspend substr(<desc-pntr>, <start>, <len>);
                  */
                 cd = alc_ary(9);
                 cd->ElemTyp(0) = A_Str;
                 cd->Str(0) =                  "SubStr(&";
                 cd->ElemTyp(1) = A_ValLoc;
                 cd->ValLoc(1) =               rslt;
                 cd->ElemTyp(2) = A_Str;
                 cd->Str(2) =                  ", ";
                 sub_ilc(ilc0, cd, 3);
                 cd->ElemTyp(4) = A_Str;
                 cd->Str(4) =                  ", ";
                 sub_ilc(ilc->code[2], cd, 5);
                 cd->ElemTyp(6) = A_Str;
                 cd->Str(6) =                  ", ";
                 sub_ilc(ilc->code[1], cd, 7);
                 cd->ElemTyp(8) = A_Str;
                 cd->Str(8) =                  ");";
                 cd_add(cd);
                 chkforblk();    /* make sure the block allocation succeeded */
                 }
              else {
                 fprintf(stderr,
                    "compiler error: unknown RLT return in data base\n");
                 exit(1);
                 /* NOTREACHED */
                 }
              break;
           default:
              fprintf(stderr,
                 "compiler error: unknown RLT return in data base\n");
              exit(1);
              /* NOTREACHED */
           }
        }
     }
  
  /*
   * chkforblk - generate code to make sure the allocation of a block
   *   for the result descriptor was successful.
   */
  static void chkforblk()
     {
     struct code *cd;
     struct code *cd1;
     struct code *lbl;
  
     lbl = alc_lbl("got allocation", 0);
     cd_add(lbl);
     cur_fnc->cursor = lbl->prev;        /* code goes before label */
     cd = NewCode(2);
     cd->cd_id = C_If;
     cd1 = alc_ary(3);
     cd1->ElemTyp(0) = A_Str;
     cd1->Str(0) =                  "(";
     cd1->ElemTyp(1) = A_ValLoc;
     cd1->ValLoc(1) =               rslt;
     cd1->ElemTyp(2) = A_Str;
     cd1->Str(2) =                  ").vword.bptr != NULL";
     cd->Cond = cd1;
     cd->ThenStmt = mk_goto(lbl);
     cd_add(cd);
     cd = alc_ary(1);
     cd->ElemTyp(0) = A_Str;
     cd->Str(0) =                   "err_msg(307, NULL);";
     cd_add(cd);
     if (err_conv)
        cd_add(sig_cd(on_failure, cur_fnc));
     cur_fnc->cursor = lbl;
     }
  
  /*
   * gen_ilc - generate code for an sequence of in-line C code.
   */
  static void gen_ilc(ilc)
  struct il_c *ilc;
     {
     struct il_c *ilc1;
     struct code *cd;
     struct code *cd1;
     struct code *lbl1;
     struct code *fail_sav;
     struct code **lbls;
     int max_lbl;
     int i;
  
     /*
      * Determine how many labels there are in the code and allocate an
      *  array to map from label numbers to labels in the code.
      */
     max_lbl = -1;
     for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next) {
        switch(ilc1->il_c_type) {
           case ILC_CGto:
           case ILC_Goto:
           case ILC_Lbl:
              if (ilc1->n > max_lbl)
                 max_lbl = ilc1->n;
           }
        }
     ++max_lbl;    /* adjust for 0 indexing */
     if (max_lbl > 0) {
        lbls = (struct code **)alloc((unsigned int) sizeof(struct code *) *
           max_lbl);
        for (i = 0; i < max_lbl; ++i)
           lbls[i] = NULL;
        }
  
     while (ilc != NULL) {
        switch(ilc->il_c_type) {
           case ILC_Ref:
           case ILC_Mod:
           case ILC_Tend:
           case ILC_SBuf:
           case ILC_CBuf:
           case ILC_Str:
              /*
               * The beginning of a sequence of code fragments that can be
               *  place on one line.
               */
              ilc = line_ilc(ilc);
              break;
  
           case ILC_Fail:
              /*
               * fail - perform failure action.
               */
              cd_add(sig_cd(on_failure, cur_fnc));
              break;
  
           case ILC_EFail:
              /*
               * errorfail - same as fail if error conversion is supported.
               */
              if (err_conv)
                 cd_add(sig_cd(on_failure, cur_fnc));
              break;
  
           case ILC_Ret:
              /*
               * return - set result location and jump out of operation.
               */
              gen_ilret(ilc);
              cd_add(mk_goto(*scont_strt));
              break;
  
           case ILC_Susp:
              /*
               * suspend - set result location. If there is a success
               *  continuation, call it. Otherwise the "continuation"
               *  will be generated in-line, so set up a resumption label.
               */
              gen_ilret(ilc);
              if (cont == NULL)
                 *scont_strt = cur_fnc->cursor;
              lbl1 = oper_lbl("end suspend");
              cd_add(lbl1);
              if (cont == NULL)
                 *scont_fail = lbl1;
              else {
                 cur_fnc->cursor = lbl1->prev; 
                 fail_sav = on_failure;
                 on_failure = lbl1;
                 callc_add(cont);
                 on_failure = fail_sav;
                 cur_fnc->cursor = lbl1;
                 }
              break;
  
           case ILC_LBrc:
              /*
               * non-deletable '{'
               */
              cd = NewCode(0);
              cd->cd_id = C_LBrack;
              cd_add(cd);
              break;
  
           case ILC_RBrc:
              /*
               * non-deletable '}'
               */
              cd = NewCode(0);
              cd->cd_id = C_RBrack;
              cd_add(cd);
              break;
  
           case ILC_CGto:
              /*
               * Conditional goto.
               */
              i = ilc->n;
              if (lbls[i] == NULL)
                 lbls[i] = oper_lbl("within");
              cd = NewCode(2);
              cd->cd_id = C_If;
              cd1 = alc_ary(1);
              sub_ilc(ilc->code[0], cd1, 0);
              cd->Cond = cd1;
              cd->ThenStmt = mk_goto(lbls[i]);
              cd_add(cd);
              break;
  
           case ILC_Goto:
              /*
               * Goto.
               */
              i = ilc->n;
              if (lbls[i] == NULL)
                 lbls[i] = oper_lbl("within");
              cd_add(mk_goto(lbls[i]));
              break;
  
           case ILC_Lbl:
              /*
               * Label.
               */
              i = ilc->n;
              if (lbls[i] == NULL)
                 lbls[i] = oper_lbl("within");
              cd_add(lbls[i]);
              break;
  
           default:
              fprintf(stderr, "compiler error: unknown info in data base\n");
              exit(1);
           }
        ilc = ilc->next;
        }
  
     if (max_lbl > 0)
        free((char *)lbls);
     }
  
  /*
   * line_ilc - gather a line of in-line code.
   */
  static struct il_c *line_ilc(ilc)
  struct il_c *ilc;
     {
     struct il_c *ilc1;
     struct il_c *last;
     struct code *cd;
     int n;
     int i;
  
     /*
      * Count the number of pieces in the line. Determine the last
      *  piece in the sequence; this is returned to the caller.
      */
     n = 0;
     ilc1 = ilc;
     while (ilc1 != NULL) {
        switch(ilc1->il_c_type) {
           case ILC_Ref:
           case ILC_Mod:
           case ILC_Tend:
           case ILC_SBuf:
           case ILC_CBuf:
           case ILC_Str:
              ++n;
              last = ilc1;
              ilc1 = ilc1->next;
              break;
           default: 
              ilc1 = NULL;
           }
        }
  
     /*
      * Construct the line.
      */
     cd = alc_ary(n);
     for (i = 0; i < n; ++i) {
        switch(ilc->il_c_type) {
           case ILC_Ref:
           case ILC_Mod:
              /*
               * Reference to variable in symbol table.
               */
              cd->ElemTyp(i) = A_ValLoc;
              if (ilc->n == RsltIndx)
                 cd->ValLoc(i) = rslt;
              else
                 cd->ValLoc(i) = cur_symtab[ilc->n].loc;
              break;
  
           case ILC_Tend:
              /*
               * Reference to a tended variable.
               */
              cd->ElemTyp(i) = A_ValLoc;
              cd->ValLoc(i) = tended[ilc->n];
              break;
  
           case ILC_SBuf:
              /*
               * String buffer for a conversion.
               */
              cd->ElemTyp(i) = A_SBuf;
              cd->Intgr(i) = alc_sbufs(1, intrnl_lftm);
              break;
  
           case ILC_CBuf:
              /*
               * Cset buffer for a conversion.
               */
              cd->ElemTyp(i) = A_CBuf;
              cd->Intgr(i) = alc_cbufs(1, intrnl_lftm);
              break;
  
           case ILC_Str:
              /*
               * String representing C code.
               */
              cd->ElemTyp(i) = A_Str;
              cd->Str(i) = ilc->s;
              break;
  
           default:
              ilc = NULL;  
           }
        ilc = ilc->next;
        }
  
     cd_add(cd);
     return last;
     }
  
  /*
   * generate code to perform simple type checking.
   */
  struct code *typ_chk(var, typcd)
  struct il_code *var;
  int typcd;
     {
     struct code *cd;
  
     if (typcd == int_typ && largeints) {
        /*
         * Handle large integer support specially.
         */
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                           "((";
        il_var(var, cd, 1);                    /* value */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                           ").dword == D_Integer || (";
        il_var(var, cd, 3);                    /* value */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                           ").dword == D_Lrgint)";
        return cd;
        }
     else if (typcd < 0) {
        /*
         * Not a standard Icon type name.
         */
        cd = alc_ary(3);
        cd->ElemTyp(0) = A_Str;
        switch (typcd) {
           case TypVar:
              cd->Str(0) =                     "(((";
              il_var(var, cd, 1);              /* value */
              cd->ElemTyp(2) = A_Str;
              cd->Str(2) =                     ").dword & D_Var) == D_Var)";
              break;
           case TypCInt:
              cd->Str(0) =                     "((";
              il_var(var, cd, 1);              /* value */
              cd->ElemTyp(2) = A_Str;
              cd->Str(2) =                     ").dword == D_Integer)";
              break;
           }
        }
     else if (typcd == str_typ) {
        cd = alc_ary(3);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                           "(!((";
        il_var(var, cd, 1);                    /* value */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                           ").dword & F_Nqual))";
        }
     else {
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                           "((";
        il_var(var, cd, 1);                    /* value */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                           ").dword == D_";
        cd->ElemTyp(3) = A_Str;
        cd->Str(3) = icontypes[typcd].cap_id;  /* type name */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                           ")";
        }
  
     return cd;
     }
  
  /*
   * oper_lbl - generate a label with an associated comment that includes
   *   the operation name.
   */
  static struct code *oper_lbl(s)
  char *s;
     {
     char *sbuf;
  
     sbuf = (char *)alloc((unsigned int)(strlen(s) + strlen(impl->name) + 3));
     sprintf(sbuf, "%s: %s", s, impl->name);
     return alc_lbl(sbuf, 0);
     }
  
  /*
   * sav_locs - save the current interpretation of symbols that may
   *  be affected by conversions.
   */
  static struct val_loc **sav_locs()
     {
     struct val_loc **locs;
     int i;
  
     if (nsyms == 0)
        return NULL;
  
     locs = (struct val_loc **)alloc((unsigned int)(nsyms *
        sizeof(struct val_loc *)));
     for (i = 0; i < nsyms; ++i)
        locs[i] = cur_symtab[i].loc;
     return locs;
     }
  
  /*
   * rstr_locs - restore the interpretation of symbols that may
   *  have been affected by conversions.
   */
  static void rstr_locs(locs)
  struct val_loc **locs;
     {
     int i;
  
     for (i = 0; i < nsyms; ++i)
        cur_symtab[i].loc = locs[i];
     free((char *)locs);
     }
  
  /*
   * mrg_locs - merge the interpretations of symbols along two execution
   *  paths. Any ambiguity is caught by rtt, so differences only occur
   *  if one path involves program termination so that the symbols
   *  no longer have an interpretation along that path.
   */
  static void mrg_locs(locs)
  struct val_loc **locs;
     {
     int i;
  
     for (i = 0; i < nsyms; ++i)
        if (cur_symtab[i].loc == NULL)
           cur_symtab[i].loc = locs[i];
     free((char *)locs);
     }
  
  /*
   * il_cnv - generate code for an in-line conversion.
   */
  struct code *il_cnv(typcd, src, dflt, dest)
  int typcd;
  struct il_code *src;
  struct il_c *dflt;
  struct il_c *dest;
     {
     struct code *cd;
     struct code *cd1;
     int dflt_to_ptr;
     int loc;
     int is_cstr;
     int sym_indx;
     int n;
     int i;
  
     sym_indx = src->u[0].n;
  
     /*
      * Determine whether the address must be taken of a default value and
      *  whether the interpretation of the symbol in an in-place conversion
      *  changes.
      */
     dflt_to_ptr = 0;
     loc = PrmTend;
     is_cstr = 0;
     switch (typcd) {
        case TypCInt:
        case TypECInt:
           loc = PrmInt;
           break;
        case TypCDbl:
           loc = PrmDbl;
           break;
        case TypCStr:
           is_cstr = 1;
           break;
        case TypEInt:
           break;
        case TypTStr:
        case TypTCset:
           dflt_to_ptr = 1;
           break;
        default:
           /*
            * Cset, real, integer, or string
            */
           if (typcd == cset_typ || typcd == str_typ)
              dflt_to_ptr = 1;
           break;
        }
  
    if (typcd == TypCDbl && !(eval_is(real_typ, sym_indx) & MaybeFalse)) {
       /*
        * Conversion from Icon real to C double. Just copy the C value
        *  from the block.
        */
       cd = alc_ary(5);
       cd->ElemTyp(0) = A_Str;
       cd->Str(0) =                "(GetReal(&(";
       il_var(src, cd, 1);
       cd->ElemTyp(2) = A_Str;
       cd->Str(2) =                "), ";
       cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 3);
       cd->ElemTyp(4) = A_Str;
       cd->Str(4) =                "), 1)";
       }
    else if (typcd == TypCDbl && !largeints &&
       !(eval_is(int_typ, sym_indx) & MaybeFalse)) {
       /*
        * Conversion from Icon integer (not large integer) to C double.
        *  Do as a C conversion by an assigment.
        */
       cd = alc_ary(5);
       cd->ElemTyp(0) = A_Str;
       cd->Str(0) =                "(";
       cd->ElemTyp(2) = A_Str;
       cd->Str(2) =                " = IntVal( ";
       cd->ElemTyp(4) = A_Str;
       cd->Str(4) =                "), 1)";
       /*
        * Note that cnv_dest() must be called after the source is output
        *  in case it changes the location of the parameter.
        */
       il_var(src, cd, 3);
       cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 1);
       }
     else {
        /*
         * Compute the number of code fragments required to construct the
         *  call to the conversion routine.
         */
        n = 7;
        if (dflt != NULL)
          n += 2;
     
        cd = alc_ary(n);
     
        /*
         * The names of simple conversions are distinguished from defaulting
         *  conversions by a prefix of "cnv_" or "def_".
         */
        cd->ElemTyp(0) = A_Str;
        if (dflt == NULL)
           cd->Str(0) = "cnv_";
        else
           cd->Str(0) = "def_";
     
        /*
         * Determine the name of the conversion routine.
         */
        cd->ElemTyp(1) = A_Str;    /* may be overridden */
        switch (typcd) {
           case TypCInt:
              cd->Str(1) = "c_int(&(";
              break;
           case TypCDbl:
              cd->Str(1) = "c_dbl(&(";
              break;
           case TypCStr:
              cd->Str(1) = "c_str(&(";
              break;
           case TypEInt:
              cd->Str(1) = "eint(&(";
              break;
           case TypECInt:
              cd->Str(1) = "ec_int(&(";
              break;
           case TypTStr:
              /*
               * Allocate a string buffer.
               */
              cd1 = alc_ary(3);
              cd1->ElemTyp(0) = A_Str;
              cd1->Str(0) = "tstr(";
              cd1->ElemTyp(1) = A_SBuf;
              cd1->Intgr(1) = alc_sbufs(1, intrnl_lftm);
              cd1->ElemTyp(2) = A_Str;
              cd1->Str(2) = ", (&";
              cd->ElemTyp(1) = A_Ary;
              cd->Array(1) = cd1;
              break;
           case TypTCset:
              /*
               * Allocate a cset buffer.
               */
              cd1 = alc_ary(3);
              cd1->ElemTyp(0) = A_Str;
              cd1->Str(0) = "tcset(";
              cd1->ElemTyp(1) = A_CBuf;
              cd1->Intgr(1) = alc_cbufs(1, intrnl_lftm);
              cd1->ElemTyp(2) = A_Str;
              cd1->Str(2) = ", &(";
              cd->ElemTyp(1) = A_Ary;
              cd->Array(1) = cd1;
              break;
           default:
              /*
               * Cset, real, integer, or string
               */
              if (typcd == cset_typ)
                 cd->Str(1) = "cset(&(";
              else if (typcd == real_typ) 
                 cd->Str(1) = "real(&(";
              else if (typcd == int_typ) 
                 cd->Str(1) = "int(&(";
              else if (typcd == str_typ)
                 cd->Str(1) = "str(&(";
              break;
           }
     
        il_var(src, cd, 2);
     
        cd->ElemTyp(3) = A_Str;
        if (dflt != NULL && dflt_to_ptr)
           cd->Str(3) = "), &(";
        else
           cd->Str(3) = "), ";
     
     
        /*
         * Determine if this conversion has a default value.
         */
        i = 4;
        if (dflt != NULL) {
           sub_ilc(dflt, cd, i);
           ++i;
           cd->ElemTyp(i) = A_Str;
           if (dflt_to_ptr)
              cd->Str(i) = "), ";
           else
              cd->Str(i) = ", ";
           ++i;
           }
     
        cd->ElemTyp(i) = A_Str;
        cd->Str(i) = "&(";
        ++i;
        cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i);
        ++i;
        cd->ElemTyp(i) = A_Str;
        cd->Str(i) = "))";
        }
     return cd;
     }
  
  /*
   * il_dflt - generate code for a defaulting conversion that always defaults.
   */
  struct code *il_dflt(typcd, src, dflt, dest)
  int typcd;
  struct il_code *src;
  struct il_c *dflt;
  struct il_c *dest;
     {
     struct code *cd;
     int sym_indx;
  
     sym_indx = src->u[0].n;
  
     if (typcd == TypCDbl) {
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(";
        cnv_dest(PrmDbl, 0, src, sym_indx, dest, cd, 1);  /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      " = ";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      ", 1)";
        }
     else if (typcd == TypCInt || typcd == TypECInt) {
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(";
        cnv_dest(PrmInt, 0, src, sym_indx, dest, cd, 1);  /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      " = ";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      ", 1)";
        }
     else if (typcd == TypTStr || typcd == str_typ) {
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(";
        cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      " = ";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      ", 1)";
        }
     else if (typcd == TypCStr) {
        cd = alc_ary(5);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(AsgnCStr(";
        cnv_dest(0, 1, src, sym_indx, dest, cd, 1);       /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      ", ";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      "), 1)";
        }
     else if (typcd == TypTCset || typcd == cset_typ) {
        cd = alc_ary(7);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(BlkLoc(";
        cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      ") = (union block *)&";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      ", ";
        cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
        cd->ElemTyp(6) = A_Str;
        cd->Str(6) =                                      ".dword = D_Cset, 1)";
        }
     else if (typcd == TypEInt || typcd == int_typ) {
        cd = alc_ary(7);
        cd->ElemTyp(0) = A_Str;
        cd->Str(0) =                                      "(IntVal(";
        cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
        cd->ElemTyp(2) = A_Str;
        cd->Str(2) =                                      ") = ";
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
        cd->Str(4) =                                      ", ";
        cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
        cd->ElemTyp(6) = A_Str;
        cd->Str(6) =                                     ".dword = D_Integer, 1)";
        }
     else if (typcd == real_typ) {
        cd = alc_ary(7);
        cd->ElemTyp(0) = A_Str;
  #ifdef DescriptorDouble
        cd->Str(0) =                                      "(((";
  #else					/* DescriptorDouble */
        cd->Str(0) =                                      "((BlkLoc(";
  #endif					/* DescriptorDouble */
        cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
        cd->ElemTyp(2) = A_Str;
  #ifdef DescriptorDouble
        cd->Str(2) =                                ").vword.realval = (double)(";
  #else					/* DescriptorDouble */
        cd->Str(2) =                                ") = (union block *)alcreal(";
  #endif					/* DescriptorDouble */
        sub_ilc(dflt, cd, 3);                             /* default */
        cd->ElemTyp(4) = A_Str;
  #ifdef DescriptorDouble
        cd->Str(4) =                     ")) , (";
  #else					/* DescriptorDouble */
        cd->Str(4) =                     ")) == NULL ? (fatalerr(0,NULL), 0) : (";
  #endif					/* DescriptorDouble */
        cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
        cd->ElemTyp(6) = A_Str;
        cd->Str(6) =                                     ".dword = D_Real, 1))";
        }
  
     return cd;
     }
  
  /*
   * cnv_dest - output the destination of a conversion.
   */
  static void cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i)
  int loc;
  int is_cstr;
  struct il_code *src;
  int sym_indx;
  struct il_c *dest;
  struct code *cd;
  int i;
     {
     if (dest == NULL) {
        /*
         * Convert "in place", changing the location of a parameter if needed.
         */
        switch (loc) {
           case PrmInt:
              if (cur_symtab[sym_indx].itmp_indx < 0)
                 cur_symtab[sym_indx].itmp_indx = alc_itmp(intrnl_lftm);
              cur_symtab[sym_indx].loc = itmp_loc(cur_symtab[sym_indx].itmp_indx);
              break;
           case PrmDbl:
              if (cur_symtab[sym_indx].dtmp_indx < 0)
                 cur_symtab[sym_indx].dtmp_indx = alc_dtmp(intrnl_lftm);
              cur_symtab[sym_indx].loc = dtmp_loc(cur_symtab[sym_indx].dtmp_indx);
              break;
           }
        il_var(src, cd, i);
        if (is_cstr)
           cur_symtab[sym_indx].loc = loc_cpy(cur_symtab[sym_indx].loc,M_CharPtr);
        }
     else {
        if (is_cstr && dest->il_c_type == ILC_Mod && dest->next == NULL &&
           dest->n != RsltIndx && cur_symtab[dest->n].loc->mod_access != M_None) {
              /*
               * We are converting to a C string. The destination variable
               *  is not defined as a simple descriptor, but must be accessed
               *  as such for this conversion.
               */
              cd->ElemTyp(i) = A_ValLoc;
              cd->ValLoc(i) = loc_cpy(cur_symtab[dest->n].loc, M_None);
              }
        else 
           sub_ilc(dest, cd, i);
        }
  
     }
  
  /*
   * il_copy - produce code for an optimized "conversion" that always succeeds
   *   and just copies a value from one place to another.
   */
  struct code *il_copy(dest, src)
  struct il_c *dest;
  struct val_loc *src;
     {
     struct code *cd;
  
     cd = alc_ary(5);
     cd->ElemTyp(0) = A_Str;
     cd->Str(0) = "(";
     sub_ilc(dest, cd, 1);
     cd->ElemTyp(2) = A_Str;
     cd->Str(2) = " = ";
     cd->ElemTyp(3) = A_ValLoc;
     cd->ValLoc(3) = src;
     cd->ElemTyp(4) = A_Str;
     cd->Str(4) = ", 1)";
     return cd;
     }
  
  /*
   * loc_cpy - make a copy of a reference to a value location, but change
   *  the way the location is accessed.
   */
  struct val_loc *loc_cpy(loc, mod_access)
  struct val_loc *loc;
  int mod_access;
     {
     struct val_loc *new_loc;
  
     if (loc == NULL)
        return NULL;
     new_loc = NewStruct(val_loc);
     *new_loc = *loc;
     new_loc->mod_access = mod_access;
     return new_loc;
     }
  
  /*
   * gen_tcase - generate in-line code for a type_case statement.
   */
  static int gen_tcase(il, has_dflt)
  struct il_code *il;
  int has_dflt;
     {
     struct case_anlz case_anlz;
  
     /*
      * We can only get here if the type_case statement can be implemented
      *  with a no more than one type check. Determine how simple the
      *  code can be.
      */
     findcases(il, has_dflt, &case_anlz);
     if (case_anlz.il_then == NULL) {
        if (case_anlz.il_else == NULL)
           return 1;
        else
           return gen_il(case_anlz.il_else);
        }
     else
        return gen_if(typ_chk(il->u[0].fld, case_anlz.typcd), case_anlz.il_then,
           case_anlz.il_else, sav_locs());
     }
  
  /*
   * gen_if - generate code to test a condition that might be true
   *  of false. Determine if execution can continue past this if statement.
   */
  static int gen_if(cond_cd, il_then, il_else, locs)
  struct code *cond_cd;
  struct il_code *il_then;
  struct il_code *il_else;
  struct val_loc **locs;
     {
     struct val_loc **locs1;
     struct code *lbl_then;
     struct code *lbl_end;
     struct code *else_loc;
     struct code *cd;
     int fall_thru;
  
     lbl_then = oper_lbl("then");
     lbl_end = oper_lbl("end if");
     cd = NewCode(2);
     cd->cd_id = C_If;
     cd->Cond = cond_cd;
     cd->ThenStmt = mk_goto(lbl_then);
     cd_add(cd);
     else_loc = cur_fnc->cursor;
     cd_add(lbl_then);
     fall_thru = gen_il(il_then);
     cd_add(lbl_end);
     locs1 = sav_locs();
     rstr_locs(locs);
     cur_fnc->cursor = else_loc;  /* go back for the else clause */
     fall_thru |= gen_il(il_else);
     cd_add(mk_goto(lbl_end));
     cur_fnc->cursor = lbl_end;
     mrg_locs(locs1);
     return fall_thru;
     }
  