ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/historic/v92.tgz/v92.tar/v92/src/iconc/ccode.c

C/C++ Source or Header | 1996-03-22 | 135KB | 4,470 lines

/*
 * ccode.c - routines to produce internal representation of C code.
 */
#include "::h:gsupport.h"
#include "::h:lexdef.h"
#include "ctrans.h"
#include "cglobals.h"
#include "csym.h"
#include "ccode.h"
#include "ctree.h"
#include "ctoken.h"
#include "cproto.h"

/*
 * Prototypes for static functions.
 */
hidden struct c_fnc   *alc_fnc   Params((noargs));
hidden struct tmplftm *alc_lftm  Params((int num, union field *args));
hidden int             alc_tmp   Params((int n, struct tmplftm *lifetm_ary));
hidden struct code    *asgn_null Params((struct val_loc *loc1));
hidden struct val_loc *bound     Params((struct node *n, struct val_loc *rslt,
                                   int catch_fail));
hidden struct code    *check_var Params((struct val_loc *d, struct code *lbl));
hidden novalue         deref_cd  Params((struct val_loc *src,
                                   struct val_loc *dest));
hidden novalue         deref_ret Params((struct val_loc *src,
                                   struct val_loc *dest, int subtypes));
hidden novalue         endlife   Params((int kind, int indx, int old,
                                   nodeptr n));
hidden struct val_loc *field_ref Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gen_act   Params((nodeptr n, struct val_loc *rslt));
hidden struct val_loc *gen_apply Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gen_args  Params((struct node *n, int frst_arg,
                                   int nargs));
hidden struct val_loc *gen_case  Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gen_creat Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gen_lim   Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gen_scan  Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *gencode   Params((struct node *n, struct val_loc *rslt));
hidden struct val_loc *genretval Params((struct node *n, struct node *expr,
                                   struct val_loc *dest));
hidden struct val_loc *inv_prc   Params((nodeptr n, struct val_loc *rslt));
hidden struct val_loc *inv_op    Params((nodeptr n, struct val_loc *rslt));
hidden nodeptr         max_lftm  Params((nodeptr n1, nodeptr n2));
hidden novalue         mk_callop Params((char *oper_nm, int ret_flag,
                                   struct val_loc *arg1rslt, int nargs,
                                   struct val_loc *rslt, int optim));
hidden struct code    *mk_cpyval Params((struct val_loc *loc1,
                                   struct val_loc *loc2));
hidden struct code    *new_call  Params((noargs));
hidden char           *oper_name Params((struct implement *impl));
hidden novalue         restr_env Params((struct val_loc *sub_sav,
                                    struct val_loc *pos_sav));
hidden novalue         save_env  Params((struct val_loc *sub_sav,
                                   struct val_loc *pos_sav));
hidden novalue         setloc    Params((nodeptr n));
hidden struct val_loc *tmp_loc   Params((int n));
hidden struct val_loc *var_ref   Params((struct lentry *sym));
hidden struct val_loc *vararg_sz Params((int n));

#define FrstArg 2

/*
 * Information that must be passed between a loop and its next and break
 *   expressions.
 */
struct loop_info {
   struct code *next_lbl;       /* where to branch for a next expression */
   struct code *end_loop;       /* label at end of loop */
   struct code *on_failure;     /* where to go if the loop fails */
   struct scan_info *scan_info; /* scanning environment upon entering loop */
   struct val_loc *rslt;        /* place to put result of loop */
   struct c_fnc *succ_cont;     /* the success continuation for the loop */
   struct loop_info *prev;      /* link to info for outer loop */
   };

/*
 * The allocation status of a temporary variable can either be "in use",
 *  "not allocated", or reserved for use at a code position (indicated
 *  by a specific negative number).
 */
#define InUse 1
#define NotAlc 0

/*
 * tmplftm is used to precompute lifetime information for use in allocating
 *  temporary variables.
 */
struct tmplftm {
   int cur_status;
   nodeptr lifetime;
   };

/*
 * Places where &subject and &pos are saved during string scanning. "outer"
 *  values are saved when the scanning expression is executed. "inner"
 *  values are saved when the scanning expression suspends.
 */
struct scan_info {
   struct val_loc *outer_sub;
   struct val_loc *outer_pos;
   struct val_loc *inner_sub;
   struct val_loc *inner_pos;
   struct scan_info *next;
   };

struct scan_info scan_base = {NULL, 0, NULL, 0, NULL};
struct scan_info *nxt_scan = &scan_base;

struct val_loc ignore;         /* no values, just something to point at */
static struct val_loc proc_rslt; /* result location for procedure */

int *tmp_status = NULL;      /* allocation status of temp descriptor vars */
int *itmp_status = NULL;     /* allocation status of temp C int vars*/
int *dtmp_status = NULL;     /* allocation status of temp C double vars */
int *sbuf_status = NULL;     /* allocation of string buffers */
int *cbuf_status = NULL;     /* allocation of cset buffers */
int num_tmp;                 /* number of temp descriptors actually used */
int num_itmp;                /* number of temp C ints actually used */
int num_dtmp;                /* number of temp C doubles actually used */
int num_sbuf;                /* number of string buffers actually used */
int num_cbuf;                /* number of cset buffers actually used */
int status_sz = 20;          /* current size of tmp_status array */
int istatus_sz = 20;         /* current size of itmp_status array */
int dstatus_sz = 20;         /* current size of dtmp_status array */
int sstatus_sz = 20;         /* current size of sbuf_status array */
int cstatus_sz = 20;         /* current size of cbuf_status array */
struct freetmp *freetmp_pool = NULL;

static char frm_prfx[PrfxSz + 1];/* prefix for procedure frame */
static char *lastfiln;         /* last file name set in code */
static int lastline;         /* last line number set in code */

static struct c_fnc *fnc_lst;    /* list of C functions implementing proc */
static struct c_fnc **flst_end; /* pointer to null pointer at end of fnc_lst */
struct c_fnc *cur_fnc;       /* C function currently being built */
static int create_lvl = 0;      /* co-expression create level */

struct pentry *cur_proc;        /* procedure currently being translated */

struct code *on_failure;    /* place to go on failure */

static struct code *p_ret_lbl;   /* label for procedure return */
static struct code *p_fail_lbl;  /* label for procedure fail */
struct code *bound_sig;        /* bounding signal for current procedure */

/*
 * statically declared "signals".
 */
struct code resume;
struct code contin;
struct code fallthru;
struct code next_fail;

int lbl_seq_num = 0;  /* next label sequence number */

/*
 * proccode - generate code for a procedure.
 */
novalue proccode(proc)
struct pentry *proc;
   {
   struct c_fnc *fnc;
   struct code *cd;
   struct code *cd1;
   struct code *lbl;
   nodeptr n;
   nodeptr failer;
   int gen;
   int i;

   /*
    * Initialize arrays used for allocating temporary variables.
    */
   if (tmp_status == NULL)
      tmp_status = (int *)alloc((unsigned int)(status_sz * sizeof(int)));
   if (itmp_status == NULL)
      itmp_status = (int *)alloc((unsigned int)(istatus_sz * sizeof(int)));
   if (dtmp_status == NULL)
      dtmp_status = (int *)alloc((unsigned int)(dstatus_sz * sizeof(int)));
   if (sbuf_status == NULL)
      sbuf_status = (int *)alloc((unsigned int)(sstatus_sz * sizeof(int)));
   if (cbuf_status == NULL)
      cbuf_status = (int *)alloc((unsigned int)(cstatus_sz * sizeof(int)));
   for (i = 0; i < status_sz; ++i)
      tmp_status[i] = NotAlloc;
   for (i = 0; i < istatus_sz; ++i)
      itmp_status[i] = NotAlloc;
   for (i = 0; i < dstatus_sz; ++i)
      dtmp_status[i] = NotAlloc;
   for (i = 0; i < sstatus_sz; ++i)
      sbuf_status[i] = NotAlloc;
   for (i = 0; i < cstatus_sz; ++i)
      cbuf_status[i] = NotAlloc;
   num_tmp = 0;
   num_itmp = 0;
   num_dtmp = 0;
   num_sbuf = 0;
   num_cbuf = 0;

   /*
    * Initialize standard signals.
    */
   resume.cd_id = C_Resume;
   contin.cd_id = C_Continue;
   fallthru.cd_id = C_FallThru;

   /*
    * Initialize procedure result and the transcan locations.
    */
   proc_rslt.loc_type = V_PRslt;
   proc_rslt.mod_access = M_None;
   ignore.loc_type = V_Ignore;
   ignore.mod_access = M_None;

   cur_proc = proc;  /* current procedure */
   lastfiln = NULL;  /* file name */
   lastline = 0;     /* line number */

   /*
    * Procedure frame prefix is the procedure prefix.
    */
   for (i = 0; i < PrfxSz; ++i)
      frm_prfx[i] = cur_proc->prefix[i];
   frm_prfx[PrfxSz] = '\0';

   /*
    * Initialize the continuation list and allocate the outer function for
    *  this procedure.
    */
   fnc_lst = NULL;
   flst_end = &fnc_lst;
   cur_fnc = alc_fnc();

   /*
    * If the procedure is not used anywhere don't generate code for it.
    *  This can happen when using libraries containing several procedures,
    *  but not all are needed. However, if there is a block for the
    *  procedure, we need at least a dummy function.
    */
   if (!cur_proc->reachable) {
      if (!(glookup(cur_proc->name)->flag & F_SmplInv))
         outerfnc(fnc_lst);
      return;
      }

   /*
    * Allocate labels for the code for procedure failure, procedure return,
    *  and allocate the bounding signal for this procedure (at this point
    *  signals and labels are not distinguished).
    */
   p_fail_lbl = alc_lbl("proc fail", 0);
   p_ret_lbl = alc_lbl("proc return", 0);
   bound_sig = alc_lbl("bound", 0);

   n = proc->tree;
   setloc(n);
   if (Type(Tree1(n)) != N_Empty) {
      /*
       * initial clause.
       */
      Tree1(n)->lifetime = NULL;
      liveness(Tree1(n), NULL, &failer, &gen);
      if (tfatals > 0)
         return;
      lbl = alc_lbl("end initial", 0);
      cd_add(lbl);
      cur_fnc->cursor = lbl->prev;        /* code goes before label */
      cd = NewCode(2);
      cd->cd_id = C_If;
      cd1 = alc_ary(1);
      cd1->ElemTyp(0) = A_Str;
      cd1->Str(0) = "!first_time";
      cd->Cond = cd1;
      cd->ThenStmt = mk_goto(lbl);
      cd_add(cd);
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) = "first_time = 0;";
      cd_add(cd);
      bound(Tree1(n), &ignore, 1);
      cur_fnc->cursor = lbl;
      }
   Tree2(n)->lifetime = NULL;
   liveness(Tree2(n), NULL, &failer, &gen);
   if (tfatals > 0)
      return;
   bound(Tree2(n), &ignore, 1);

   /*
    * Place code to perform procedure failure and return and the
    *  end of the outer function.
    */
   setloc(Tree3(n));
   cd_add(p_fail_lbl);
   cd = NewCode(0);
   cd->cd_id = C_PFail;
   cd_add(cd);
   cd_add(p_ret_lbl);
   cd = NewCode(0);
   cd->cd_id = C_PRet;
   cd_add(cd);

   /*
    * Fix up signal handling code and perform peephole optimizations.
    */
   fix_fncs(fnc_lst);

   /*
    * The outer function is the first one on the list. It has the
    *  procedure interface; the others are just continuations.
    */
   outerfnc(fnc_lst);
   for (fnc = fnc_lst->next; fnc != NULL; fnc = fnc->next)
      if (fnc->ref_cnt > 0)
         prt_fnc(fnc);
   }

/*
 * gencode - generate code for a syntax tree.
 */
static struct val_loc *gencode(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct code *cd;
   struct code *cd1;
   struct code *fail_sav;
   struct code *lbl1;
   struct code *lbl2;
   struct code *cursor_sav;
   struct c_fnc *fnc_sav;
   struct c_fnc *fnc;
   struct implement *impl;
   struct implement *impl1;
   struct val_loc *r1[3];
   struct val_loc *r2[2];
   struct val_loc *frst_arg;
   struct lentry *single;
   struct freetmp *freetmp;
   struct freetmp *ft;
   struct tmplftm *lifetm_ary;
   char *sbuf;
   int i;
   int tmp_indx;
   int nargs;
   static struct loop_info *loop_info = NULL;
   struct loop_info *li_sav;

   switch (n->n_type) {
      case N_Activat:
         rslt = gen_act(n, rslt);
         break;

      case N_Alt:
         rslt = chk_alc(rslt, n->lifetime); /* insure a result location */

         fail_sav = on_failure;
         fnc_sav = cur_fnc;

         /*
          * If the first alternative fails, execution must go to the
          *  "alt" label.
          */
         lbl1 = alc_lbl("alt", 0);
         on_failure = lbl1;

         cd_add(lbl1);
         cur_fnc->cursor = lbl1->prev;  /* 1st alternative goes before label */
         gencode(Tree0(n), rslt);

         /*
          * Each alternative must call the same success continuation.
          */
         fnc = alc_fnc();
         callc_add(fnc);

         cur_fnc = fnc_sav;             /* return to the context of the label */
         cur_fnc->cursor = lbl1;        /* 2nd alternative goes after label */
         on_failure = fail_sav;         /* on failure, alternation fails */
         gencode(Tree1(n), rslt);
         callc_add(fnc);                /* call continuation */

         /*
          * Code following the alternation goes in the continuation. If
          *  the code fails, the continuation returns the resume signal.
          */
         cur_fnc = fnc;
         on_failure = &resume;
         break;

      case N_Apply:
         rslt = gen_apply(n, rslt);
         break;

      case N_Augop:
         impl = Impl0(n);       /* assignment */
         impl1 = Impl1(n);      /* the operation */
         if (impl == NULL || impl1 == NULL) {
            rslt = &ignore;    /* make sure code generation can continue */
            break;
            }

         /*
          * allocate an argument list for the operation.
          */
         lifetm_ary = alc_lftm(2, &n->n_field[2]);
         tmp_indx = alc_tmp(2, lifetm_ary);
         r1[0] = tmp_loc(tmp_indx);
         r1[1] = tmp_loc(tmp_indx + 1);

         gencode(Tree2(n), r1[0]);  /* first argument */

         /*
          * allocate an argument list for the assignment and copy the
          *  value of the first argument into it.
          */
         lifetm_ary[0].cur_status = InUse;
         lifetm_ary[1].cur_status = n->postn;
         lifetm_ary[1].lifetime = n->intrnl_lftm;
         tmp_indx = alc_tmp(2, lifetm_ary);
         r2[0] = tmp_loc(tmp_indx++);
         cd_add(mk_cpyval(r2[0], r1[0]));
         r2[1] = tmp_loc(tmp_indx);

         gencode(Tree3(n), r1[1]); /* second argument */

         /*
          * Produce code for the operation.
          */
         setloc(n);
         implproto(impl1);
         mk_callop(oper_name(impl1), impl1->ret_flag, r1[0], 2, r2[1], 0);

         /*
          * Produce code for the assignment.
          */
         implproto(impl);
         if (impl->ret_flag & (DoesRet | DoesSusp))
            rslt = chk_alc(rslt, n->lifetime);
         mk_callop(oper_name(impl), impl->ret_flag, r2[0], 2, rslt, 0);

         free((char *)lifetm_ary);
         break;

      case N_Bar: {
         struct val_loc *fail_flg;

         /*
          * Allocate an integer variable to keep track of whether the
          *  repeated alternation should fail when execution reaches
          *  the top of its loop, and generate code to initialize the
          *  variable to 0.
          */
         fail_flg = itmp_loc(alc_itmp(n->intrnl_lftm));
         cd = alc_ary(2);
         cd->ElemTyp(0) = A_ValLoc;
         cd->ValLoc(0) =                fail_flg;
         cd->ElemTyp(1) = A_Str;
         cd->Str(1) =                   " = 0;";
         cd_add(cd);

         /*
          * Code at the top of the repeated alternation loop checks
          *  the failure flag.
          */
         lbl1 = alc_lbl("rep alt", 0);
         cd_add(lbl1);
         cd = NewCode(2);
         cd->cd_id = C_If;
         cd1 = alc_ary(1);
         cd1->ElemTyp(0) = A_ValLoc;
         cd1->ValLoc(0) = fail_flg;
         cd->Cond = cd1;
         cd->ThenStmt = sig_cd(on_failure, cur_fnc);
         cd_add(cd);

         /*
          * If the expression fails without producing a value, the
          *  repeated alternation must fail.
          */
         cd = alc_ary(2);
         cd->ElemTyp(0) = A_ValLoc;
         cd->ValLoc(0) =                fail_flg;
         cd->ElemTyp(1) = A_Str;
         cd->Str(1) =                   " = 1;";
         cd_add(cd);

         /*
          * Generate code for the repeated expression. If it produces
          *  a value before before backtracking occurs, the loop is
          *  repeated as indicated by the value of the failure flag.
          */
         on_failure = lbl1;
         rslt = gencode(Tree0(n), rslt);
         cd = alc_ary(2);
         cd->ElemTyp(0) = A_ValLoc;
         cd->ValLoc(0) =                fail_flg;
         cd->ElemTyp(1) = A_Str;
         cd->Str(1) =                   " = 0;";
         cd_add(cd);
         }
        break;

      case N_Break:
         if (loop_info == NULL) {
            nfatal(n, "invalid context for a break expression", NULL);
            rslt = &ignore;
            break;
            }

         /*
          * If the break is in a different string scanning context from the
          *  loop itself, generate code to restore the scanning environment.
          */
         if (nxt_scan != loop_info->scan_info)
            restr_env(loop_info->scan_info->outer_sub,
               loop_info->scan_info->outer_pos);


         if (Tree0(n)->n_type == N_Empty && loop_info->rslt == &ignore) {
             /*
              * The break has no associated expression and the loop needs
              *  no value, so just branch out of the loop.
              */
             cd_add(sig_cd(loop_info->end_loop, cur_fnc));
             }
         else {
            /*
             * The code for the expression associated with the break is
             *  actually placed at the end of the loop. Go there and
             *  add a label to branch to.
             */
            cursor_sav = cur_fnc->cursor;
            fnc_sav = cur_fnc;
            fail_sav = on_failure;
            cur_fnc = loop_info->end_loop->Container;
            cur_fnc->cursor = loop_info->end_loop->prev;
            on_failure = loop_info->on_failure;
            lbl1 = alc_lbl("break", 0);
            cd_add(lbl1);

            /*
             * Make sure a result location has been allocated for the
             *  loop, restore the loop information for the next outer
             *  loop, generate code for the break expression, then
             *  restore the loop information for this loop.
             */
            loop_info->rslt = chk_alc(loop_info->rslt, Tree0(n)->lifetime);
            li_sav = loop_info;
            loop_info = loop_info->prev;
            gencode(Tree0(n), li_sav->rslt);
            loop_info = li_sav;

            /*
             * If this or another break expression suspends so we cannot
             *  just branch to the end of the loop, all breaks must
             *  call a common continuation.
             */
            if (cur_fnc->cursor->next != loop_info->end_loop &&
                loop_info->succ_cont == NULL)
               loop_info->succ_cont = alc_fnc();
            if (loop_info->succ_cont == NULL)
               cd_add(mk_goto(loop_info->end_loop)); /* go to end of loop */
            else
               callc_add(loop_info->succ_cont);      /* call continuation */

            /*
             * Return to the location of the break and generate a branch to
             *  the code for its associated expression.
             */
            cur_fnc = fnc_sav;
            cur_fnc->cursor = cursor_sav;
            on_failure = fail_sav;
            cd_add(sig_cd(lbl1, cur_fnc));
            }
         rslt = &ignore;   /* shouldn't be used but must be something valid */
         break;

      case N_Case:
         rslt = gen_case(n, rslt);
         break;

      case N_Create:
         rslt = gen_creat(n, rslt);
         break;

      case N_Cset:
      case N_Int:
      case N_Real:
      case N_Str:
         cd = NewCode(2);
         cd->cd_id = C_Lit;
         rslt = chk_alc(rslt, n->lifetime);
         cd->Rslt = rslt;
         cd->Literal = CSym0(n);
         cd_add(cd);
         break;

      case N_Empty:
         /*
          * Assume null value is needed.
          */
         if (rslt == &ignore)
           break;
         rslt = chk_alc(rslt, n->lifetime);
         cd_add(asgn_null(rslt));
         break;

      case N_Field:
         rslt = field_ref(n, rslt);
         break;

      case N_Id:
         /*
          * If the variable reference is not going to be used, don't bother
          *  building it.
          */
         if (rslt == &ignore)
           break;
         cd = NewCode(2);
         cd->cd_id = C_NamedVar;
         rslt = chk_alc(rslt, n->lifetime);
         cd->Rslt = rslt;
         cd->NamedVar = LSym0(n);
         cd_add(cd);
         break;

      case N_If:

         if (Type(Tree2(n)) == N_Empty) {
            /*
             * if-then. Control clause is bounded, but otherwise trivial.
             */
            bound(Tree0(n), &ignore, 0);      /* control clause */
            rslt = gencode(Tree1(n), rslt);     /* then clause */
            }
         else {
            /*
             * if-then-else. Establish an "else" label as the failure
             *   label of the bounded control clause.
             */
            fail_sav = on_failure;
            fnc_sav = cur_fnc;
            lbl1 = alc_lbl("else", 0);
            on_failure = lbl1;

            bound(Tree0(n), &ignore, 0);  /* control clause */

            cd_add(lbl1);
            cur_fnc->cursor = lbl1->prev; /* then clause goes before else lbl */
            on_failure = fail_sav;
            rslt = chk_alc(rslt, n->lifetime);
            gencode(Tree1(n), rslt);      /* then clause */

            /*
             * If the then clause is not a generator, execution can
             *  just go to the end of the if-then-else expression. If it
             *  is a generator, the continuation for the expression must be
             *  in a separate function.
             */
            if (cur_fnc->cursor->next == lbl1) {
               fnc = NULL;
               lbl2 = alc_lbl("end if", 0);
               cd_add(mk_goto(lbl2));
               cur_fnc->cursor = lbl1;
               cd_add(lbl2);
               }
            else {
               lbl2 = NULL;
               fnc = alc_fnc();
               callc_add(fnc);
               cur_fnc = fnc_sav;
               }

            cur_fnc->cursor = lbl1;    /* else clause goes after label */
            on_failure = fail_sav;
            gencode(Tree2(n), rslt);   /* else clause */

            /*
             * If the else clause is not a generator, execution is at
             *  the end of the if-then-else expression, but the if clause
             *  may have forced the continuation to be in a separate function.
             *  If the else clause is a generator, it forces the continuation
             *  to be in a separate function.
             */
            if (fnc == NULL) {
               if (cur_fnc->cursor->next == lbl2)
                  cur_fnc->cursor = lbl2;
               else {
                  fnc = alc_fnc();
                  callc_add(fnc);
                  /*
                   * The then clause is not a generator, so it has branched
                   *  to lbl2. We must add a call to the continuation there.
                   */
                  cur_fnc = fnc_sav;
                  cur_fnc->cursor = lbl2;
                  on_failure = fail_sav;
                  callc_add(fnc);
                  }
               }
            else
               callc_add(fnc);

            if (fnc != NULL) {
               /*
                * We produced a continuation for the if-then-else, so code
                *  generation must proceed in it.
                */
               cur_fnc = fnc;
               on_failure = &resume;
               }
            }
         break;

      case N_Invok:
         /*
          * General invocation.
          */
         nargs = Val0(n);
         if (Tree1(n)->n_type == N_Empty) {
            /*
             * Mutual evaluation.
             */
            for (i = 2; i <= nargs; ++i)
               gencode(n->n_field[i].n_ptr, &ignore);   /* arg i - 1 */
            rslt = chk_alc(rslt, n->lifetime);
            gencode(n->n_field[nargs + 1].n_ptr, rslt); /* last argument */
            }
         else {
            ++nargs; /* consider the procedure an argument to invoke() */
            frst_arg = gen_args(n, 1, nargs);
            setloc(n);
            /*
             * Assume this operation uses its result location as a work
             *   area. Give it a location that is tended, where the value
             *   is retained as long as the operation can be resumed.
             */
            if (rslt == &ignore)
               rslt = NULL;      /* force allocation of temporary */
            rslt = chk_alc(rslt, max_lftm(n->lifetime, n->intrnl_lftm));
            mk_callop( "invoke", DoesRet | DoesFail | DoesSusp, frst_arg, nargs,
               rslt, 0);
            }
         break;

      case N_InvOp:
         rslt = inv_op(n, rslt);
         break;

      case N_InvProc:
         rslt = inv_prc(n, rslt);
         break;

      case N_InvRec: {
         /*
          * Directly invoke a record constructor.
          */
         struct rentry *rec;

         nargs = Val0(n);             /* number of arguments */
         frst_arg = gen_args(n, 2, nargs);
         setloc(n);
         rec = Rec1(n);

         rslt = chk_alc(rslt, n->lifetime);

         /*
          * If error conversion can occur then the record constructor may
          *  fail and we must check the signal.
          */
         if (err_conv) {
            sbuf = (char *)alloc((unsigned int)(strlen(rec->name) +
                strlen("signal = R_") + PrfxSz + 1));
            sprintf(sbuf, "signal = R%s_%s(", rec->prefix, rec->name);
            }
         else {
            sbuf = (char *)alloc((unsigned int)(strlen(rec->name) + PrfxSz +4));
            sprintf(sbuf, "R%s_%s(", rec->prefix, rec->name);
            }
         cd = alc_ary(9);
         cd->ElemTyp(0) = A_Str;        /* constructor name */
         cd->Str(0) = sbuf;
         cd->ElemTyp(1) = A_Intgr;      /* number of arguments */
         cd->Intgr(1) = nargs;
         cd->ElemTyp(2) = A_Str;        /* , */
         cd->Str(2) = ", ";
         if (frst_arg == NULL) {        /* location of first argument */
            cd->ElemTyp(3) = A_Str;
            cd->Str(3) = "NULL";
            cd->ElemTyp(4) = A_Str;
            cd->Str(4) = "";
            }
         else {
            cd->ElemTyp(3) = A_Str;
            cd->Str(3) = "&";
            cd->ElemTyp(4) = A_ValLoc;
            cd->ValLoc(4) = frst_arg;
            }
         cd->ElemTyp(5) = A_Str;        /* , */
         cd->Str(5) = ", ";
         cd->ElemTyp(6) = A_Str;        /* location of result */
         cd->Str(6) = "&";
         cd->ElemTyp(7) = A_ValLoc;
         cd->ValLoc(7) = rslt;
         cd->ElemTyp(8) = A_Str;
         cd->Str(8) =                   ");";
         cd_add(cd);
         if (err_conv) {
            cd = NewCode(2);
            cd->cd_id = C_If;
            cd1 = alc_ary(1);
            cd1->ElemTyp(0) = A_Str;
            cd1->Str(0) =                  "signal == A_Resume";
            cd->Cond = cd1;
            cd->ThenStmt = sig_cd(on_failure, cur_fnc);
            cd_add(cd);
            }
         }
         break;

      case N_Limit:
         rslt = gen_lim(n, rslt);
         break;

      case N_Loop: {
         struct loop_info li;

         /*
          * Set up loop information for use by break and next expressions.
          */
         li.end_loop = alc_lbl("end loop", 0);
         cd_add(li.end_loop);
         cur_fnc->cursor = li.end_loop->prev;      /* loop goes before label */
         li.rslt = rslt;
         li.on_failure = on_failure;
         li.scan_info = nxt_scan;
         li.succ_cont = NULL;
         li.prev = loop_info;
         loop_info = &li;

         switch ((int)Val0(Tree0(n))) {
            case EVERY:
               /*
                * "next" in the control clause just fails.
                */
               li.next_lbl = &next_fail;
               gencode(Tree1(n), &ignore);          /* control clause */
               /*
                * "next" in the do clause transfers control to the
                *   statement at the end of the loop that resumes the
                *   control clause.
                */
               li.next_lbl = alc_lbl("next", 0);
               bound(Tree2(n), &ignore, 1);         /* do clause */
               cd_add(li.next_lbl);
               cd_add(sig_cd(on_failure, cur_fnc)); /* resume control clause */
               break;

            case REPEAT:
               li.next_lbl = alc_lbl("repeat", 0);
               cd_add(li.next_lbl);
               bound(Tree1(n), &ignore, 1);
               cd_add(mk_goto(li.next_lbl));
               break;

            case SUSPEND:            /* suspension expression */
               if (create_lvl > 0) {
                  nfatal(n, "invalid context for suspend", NULL);
                  return &ignore;
                  }
               /*
                * "next" in the control clause just fails. The result
                *   of the control clause goes in the procedure return
                *   location.
                */
               li.next_lbl = &next_fail;
               genretval(n, Tree1(n), &proc_rslt);

               /*
                * If necessary, swap scanning environments before suspending.
                *   if there is no success continuation, just return.
                */
               if (nxt_scan != &scan_base) {
                  save_env(scan_base.inner_sub, scan_base.inner_pos);
                  restr_env(scan_base.outer_sub, scan_base.outer_pos);
                  }
               cd = NewCode(2);
               cd->cd_id = C_If;
               cd1 = alc_ary(2);
               cd1->ElemTyp(0) = A_ProcCont;
               cd1->ElemTyp(1) = A_Str;
               cd1->Str(1) = " == NULL";
               cd->Cond = cd1;
               cd->ThenStmt = sig_cd(p_ret_lbl, cur_fnc);
               cd_add(cd);
               cd = NewCode(0);
               cd->cd_id = C_PSusp;
               cd_add(cd);
               cur_fnc->flag |= CF_ForeignSig;

               /*
                * Force updating file name and line number, and if needed,
                *  switch scanning environments before resuming.
                */
               lastfiln = NULL;
               lastline = 0;
               if (nxt_scan != &scan_base) {
                  save_env(scan_base.outer_sub, scan_base.outer_pos);
                  restr_env(scan_base.inner_sub, scan_base.inner_pos);
                  }

               /*
                * "next" in the do clause transfers control to the
                *   statement at the end of the loop that resumes the
                *   control clause.
                */
               li.next_lbl = alc_lbl("next", 0);
               bound(Tree2(n), &ignore, 1);       /* do clause */
               cd_add(li.next_lbl);
               cd_add(sig_cd(on_failure, cur_fnc));
               break;

            case WHILE:
               li.next_lbl = alc_lbl("while", 0);
               cd_add(li.next_lbl);
               /*
                * The control clause and do clause are both bounded expressions,
                *   but only the do clause establishes a new failure label.
                */
               bound(Tree1(n), &ignore, 0);      /* control clause */
               bound(Tree2(n), &ignore, 1);      /* do clause */
               cd_add(mk_goto(li.next_lbl));
               break;

            case UNTIL:
               fail_sav = on_failure;
               li.next_lbl = alc_lbl("until", 0);
               cd_add(li.next_lbl);

               /*
                * If the control clause fails, execution continues in
                *  the loop.
                */
               if (Type(Tree2(n)) == N_Empty)
                  on_failure = li.next_lbl;
               else {
                  lbl2 = alc_lbl("do", 0);
                  on_failure = lbl2;
                  cd_add(lbl2);
                  cur_fnc->cursor = lbl2->prev;  /* control before label */
                  }
               bound(Tree1(n), &ignore, 0);      /* control clause */

               /*
                * If the control clause succeeds, the loop fails.
                */
               cd_add(sig_cd(fail_sav, cur_fnc));

               if (Type(Tree2(n)) != N_Empty) {
                  /*
                   * Do clause goes after the label and the loop repeats.
                   */
                  cur_fnc->cursor = lbl2;
                  bound(Tree2(n), &ignore, 1);      /* do clause */
                  cd_add(mk_goto(li.next_lbl));
                  }
               break;
            }

         /*
          * Go to the end of the loop and see if the loop's success continuation
          *  is in a separate function.
          */
         cur_fnc = li.end_loop->Container;
         cur_fnc->cursor = li.end_loop;
         if (li.succ_cont != NULL) {
            callc_add(li.succ_cont);
            cur_fnc = li.succ_cont;
            on_failure = &resume;
            }
         if (li.rslt == NULL)
            rslt = &ignore; /* shouldn't be used but must be something valid */
         else
            rslt = li.rslt;
         loop_info = li.prev;
         break;
         }

      case N_Next:
         /*
          * In some contexts "next" just fails. In other contexts it
          *   transfers control to a label, in which case it may have
          *   to restore a scanning environment.
          */
         if (loop_info == NULL)
            nfatal(n, "invalid context for a next expression", NULL);
         else if (loop_info->next_lbl == &next_fail)
            cd_add(sig_cd(on_failure, cur_fnc));
         else {
            if (nxt_scan != loop_info->scan_info)
               restr_env(loop_info->scan_info->outer_sub,
                  loop_info->scan_info->outer_pos);
            cd_add(sig_cd(loop_info->next_lbl, cur_fnc));
            }
         rslt = &ignore; /* shouldn't be used but must be something valid */
         break;

      case N_Not:
         lbl1 = alc_lbl("not", 0);
         fail_sav = on_failure;
         on_failure = lbl1;
         cd_add(lbl1);
         cur_fnc->cursor = lbl1->prev;        /* code goes before label */
         bound(Tree0(n), &ignore, 0);
         on_failure = fail_sav;
         cd_add(sig_cd(on_failure, cur_fnc)); /* convert success to failure */
         cur_fnc->cursor = lbl1;          /* convert failure to null */
         if (rslt != &ignore) {
            rslt = chk_alc(rslt, n->lifetime);
            cd_add(asgn_null(rslt));
            }
         break;

      case N_Ret:
         if (create_lvl > 0) {
            nfatal(n, "invalid context for return or fail", NULL);
            return &ignore;
            }
         if (Val0(Tree0(n)) == RETURN) {
            /*
             * Set up the failure action of the return expression to do a
             *  procedure fail.
             */
            if (nxt_scan != &scan_base) {
               /*
                * we must switch scanning environments if the expression fails.
                */
               lbl1 = alc_lbl("return fail", 0);
               cd_add(lbl1);
               restr_env(scan_base.outer_sub, scan_base.outer_pos);
               cd_add(sig_cd(p_fail_lbl, cur_fnc));
               cur_fnc->cursor = lbl1->prev;        /* code goes before label */
               on_failure = lbl1;
               }
            else
               on_failure = p_fail_lbl;

            /*
             * Produce code to place return value in procedure result location.
             */
            genretval(n, Tree1(n), &proc_rslt);

            /*
             * See if a scanning environment must be restored and
             *  transfer control to the procedure return code.
             */
            if (nxt_scan != &scan_base)
               restr_env(scan_base.outer_sub, scan_base.outer_pos);
            cd_add(sig_cd(p_ret_lbl, cur_fnc));
            }
         else {
            /*
             * fail. See if a scanning environment must be restored and
             *  transfer control to the procedure failure code.
             */
            if (nxt_scan != &scan_base)
               restr_env(scan_base.outer_sub, scan_base.outer_pos);
            cd_add(sig_cd(p_fail_lbl, cur_fnc));
            }
         rslt = &ignore; /* shouldn't be used but must be something valid */
         break;

      case N_Scan:
         rslt = gen_scan(n, rslt);
         break;

      case N_Sect:
         /*
          * x[i+:j] or x[i-:j] (x[i:j] handled as ordinary operator)
          */
         impl1 = Impl0(n);     /* sectioning */
         if (impl1 == NULL) {
            rslt = &ignore;    /* make sure code generation can continue */
            break;
            }
         implproto(impl1);

         impl = Impl1(n);      /* plus or minus */
         /*
          * Allocate work area of temporary variables for sectioning.
          */
         lifetm_ary = alc_lftm(3, NULL);
         lifetm_ary[0].cur_status = Tree2(n)->postn;
         lifetm_ary[0].lifetime = n->intrnl_lftm;
         lifetm_ary[1].cur_status = Tree3(n)->postn;
         lifetm_ary[1].lifetime = n->intrnl_lftm;
         lifetm_ary[2].cur_status = n->postn;
         lifetm_ary[2].lifetime = n->intrnl_lftm;
         tmp_indx = alc_tmp(3, lifetm_ary);
         for (i = 0; i < 3; ++i)
            r1[i] = tmp_loc(tmp_indx++);
         gencode(Tree2(n), r1[0]);   /* generate code to compute x */
         gencode(Tree3(n), r1[1]);   /* generate code compute i */

         /*
          * Allocate work area of temporary variables for arithmetic.
          */
         lifetm_ary[0].cur_status = InUse;
         lifetm_ary[0].lifetime = Tree3(n)->lifetime;
         lifetm_ary[1].cur_status = Tree4(n)->postn;
         lifetm_ary[1].lifetime = Tree4(n)->lifetime;
         tmp_indx = alc_tmp(2, lifetm_ary);
         for (i = 0; i < 2; ++i)
            r2[i] = tmp_loc(tmp_indx++);
         cd_add(mk_cpyval(r2[0], r1[1])); /* generate code to copy i */
         gencode(Tree4(n), r2[1]);        /* generate code to compute j */

         /*
          * generate code for i op j.
          */
         setloc(n);
         implproto(impl);
         mk_callop(oper_name(impl), impl->ret_flag, r2[0], 2, r1[2], 0);

         /*
          * generate code for x[i : (i op j)]
          */
         rslt = chk_alc(rslt, n->lifetime);
         mk_callop(oper_name(impl1),impl1->ret_flag,r1[0],3,rslt,0);
         free((char *)lifetm_ary);
         break;

      case N_Slist:
         bound(Tree0(n), &ignore, 1);
         rslt = gencode(Tree1(n), rslt);
         break;

      case N_SmplAsgn: {
         struct val_loc *var, *val;

         /*
          * Optimized assignment to a named variable. Use information
          *  from type inferencing to determine if the right-hand-side
          *  is a variable.
          */
         var = var_ref(LSym0(Tree2(n)));
         if (HasVar(varsubtyp(Tree3(n)->type, &single)))
            Val0(n) = AsgnDeref;
         if (single != NULL) {
            /*
             * Right-hand-side results in a named variable. Compute
             *  the expression but don't bother saving the result, we
             *  know what it is. Assignment just copies value from
             *  one variable to the other.
             */
            gencode(Tree3(n), &ignore);
            val = var_ref(single);
            cd_add(mk_cpyval(var, val));
            }
         else switch (Val0(n)) {
            case AsgnDirect:
               /*
                * It is safe to compute the result directly into the variable.
                */
               gencode(Tree3(n), var);
               break;
            case AsgnCopy:
               /*
                * The result is not a variable reference, but it is not
                *  safe to compute it into the variable, we must use a
                *  temporary variable.
                */
               val = gencode(Tree3(n), NULL);
               cd_add(mk_cpyval(var, val));
               break;
            case AsgnDeref:
               /*
                * We must dereference the result into the variable.
                */
               val = gencode(Tree3(n), NULL);
               deref_cd(val, var);
               break;
            }

         /*
          * If the assignment has to produce a result, construct the
          *  variable reference.
          */
         if (rslt != &ignore)
            rslt = gencode(Tree2(n), rslt);
         }
         break;

      case N_SmplAug: {
         /*
          * Optimized augmented assignment to a named variable.
          */
         struct val_loc *var, *val;

         impl = Impl1(n);      /* the operation */
         if (impl == NULL) {
            rslt = &ignore;    /* make sure code generation can continue */
            break;
            }

         implproto(impl); /* insure prototype for operation */

         /*
          * Generate code to compute the arguments for the operation.
          */
         frst_arg = gen_args(n, 2, 2);
         setloc(n);

         /*
          * Use information from type inferencing to determine if the
          *  operation produces a variable.
          */
         if (HasVar(varsubtyp(Typ4(n), &single)))
            Val0(n) = AsgnDeref;
         var = var_ref(LSym0(Tree2(n)));
         if (single != NULL) {
            /*
             * The operation results in a named variable. Call the operation
             *  but don't bother saving the result, we know what it is.
             *  Assignment just copies value from one variable to the other.
             */
            mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2,
                  &ignore, 0);
            val = var_ref(single);
            cd_add(mk_cpyval(var, val));
            }
         else switch (Val0(n)) {
            case AsgnDirect:
               /*
                * It is safe to compute the result directly into the variable.
                */
               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2,
                  var, 0);
               break;
            case AsgnCopy:
               /*
                * The result is not a variable reference, but it is not
                *  safe to compute it into the variable, we must use a
                *  temporary variable.
                */
               val = chk_alc(NULL, n);
               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2, val, 0);
               cd_add(mk_cpyval(var, val));
               break;
            case AsgnDeref:
               /*
                * We must dereference the result into the variable.
                */
               val = chk_alc(NULL, n);
               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2, val, 0);
               deref_cd(val, var);
               break;
            }

         /*
          * If the assignment has to produce a result, construct the
          *  variable reference.
          */
         if (rslt != &ignore)
            rslt = gencode(Tree2(n), rslt);
         }
         break;

      default:
         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
         exit(ErrorExit);
      }

   /*
    * Free any temporaries whose lifetime ends at this node.
    */
   freetmp = n->freetmp;
   while (freetmp != NULL) {
      switch (freetmp->kind) {
         case DescTmp:
            tmp_status[freetmp->indx] = freetmp->old;
            break;
         case CIntTmp:
            itmp_status[freetmp->indx] = freetmp->old;
            break;
         case CDblTmp:
            dtmp_status[freetmp->indx] = freetmp->old;
            break;
         case SBuf:
            sbuf_status[freetmp->indx] = freetmp->old;
            break;
         case CBuf:
            cbuf_status[freetmp->indx] = freetmp->old;
            break;
         }
      ft = freetmp->next;
      freetmp->next = freetmp_pool;
      freetmp_pool = freetmp;
      freetmp = ft;
      }
   return rslt;
   }

/*
 * chk_alc - make sure a result location has been allocated. If it is
 *  a temporary variable, indicate that it is now in use.
 */
struct val_loc *chk_alc(rslt, lifetime)
struct val_loc *rslt;
nodeptr lifetime;
   {
   struct tmplftm tmplftm;

   if (rslt == NULL) {
      if (lifetime == NULL)
         rslt = &ignore;
      else {
         tmplftm.cur_status = InUse;
         tmplftm.lifetime = lifetime;
         rslt = tmp_loc(alc_tmp(1, &tmplftm));
         }
      }
   else if (rslt->loc_type == V_Temp)
      tmp_status[rslt->u.tmp] = InUse;
   return rslt;
   }

/*
 * mk_goto - make a code structure for goto label
 */
struct code *mk_goto(label)
struct code *label;
   {
   register struct code *cd;

   cd = NewCode(1);    /* # fields == # fields of C_RetSig & C_Break */
   cd->cd_id = C_Goto;
   cd->next = NULL;
   cd->prev = NULL;
   cd->Lbl = label;
   ++label->RefCnt;
   return cd;
   }

/*
 * mk_cpyval - make code to copy a value from one location to another.
 */
static struct code *mk_cpyval(loc1, loc2)
struct val_loc *loc1;
struct val_loc *loc2;
   {
   struct code *cd;

   cd = alc_ary(4);
   cd->ElemTyp(0) = A_ValLoc;
   cd->ValLoc(0) = loc1;
   cd->ElemTyp(1) = A_Str;
   cd->Str(1) = " = ";
   cd->ElemTyp(2) = A_ValLoc;
   cd->ValLoc(2) = loc2;
   cd->ElemTyp(3) = A_Str;
   cd->Str(3) = ";";
   return cd;
   }

/*
 * asgn_null - make code to assign the null value to a location.
 */
static struct code *asgn_null(loc1)
struct val_loc *loc1;
   {
   struct code *cd;

   cd = alc_ary(2);
   cd->ElemTyp(0) = A_ValLoc;
   cd->ValLoc(0) = loc1;
   cd->ElemTyp(1) = A_Str;
   cd->Str(1) = " = nulldesc;";
   return cd;
   }

/*
 * oper_name - create the name for the most general implementation of an Icon
 *   operation.
 */
static char *oper_name(impl)
struct implement *impl;
   {
   char *sbuf;

   sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
   sprintf(sbuf, "%c%c%c_%s", impl->oper_typ, impl->prefix[0], impl->prefix[1],
      impl->name);
   return sbuf;
   }

/*
 * gen_args - generate code to evaluate an argument list.
 */
static struct val_loc *gen_args(n, frst_arg, nargs)
struct node *n;
int frst_arg;
int nargs;
   {
   struct tmplftm *lifetm_ary;
   int i;
   int tmp_indx;

   if (nargs == 0)
      return NULL;

   lifetm_ary = alc_lftm(nargs, &n->n_field[frst_arg]);
   tmp_indx = alc_tmp(nargs, lifetm_ary);
   for (i = 0; i < nargs; ++i)
      gencode(n->n_field[frst_arg + i].n_ptr, tmp_loc(tmp_indx + i));
   free((char *)lifetm_ary);
   return tmp_loc(tmp_indx);
   }

/*
 * gen_case - generate code for a case expression.
 */
static struct val_loc *gen_case(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct node *control;
   struct node *cases;
   struct node *deflt;
   struct node *clause;
   struct val_loc *r1;
   struct val_loc *r2;
   struct val_loc *r3;
   struct code *cd;
   struct code *cd1;
   struct code *fail_sav;
   struct code *skp_lbl;
   struct code *cd_lbl;
   struct code *end_lbl;
   struct c_fnc *fnc_sav;
   struct c_fnc *succ_cont = NULL;

   control = Tree0(n);
   cases = Tree1(n);
   deflt = Tree2(n);

   /*
    * The control clause is bounded.
    */
   r1 = chk_alc(NULL, n);
   bound(control, r1, 0);

   /*
    * Remember the context in which the case expression occurs and
    *  establish a label at the end of the expression.
    */
   fail_sav = on_failure;
   fnc_sav = cur_fnc;
   end_lbl = alc_lbl("end case", 0);
   cd_add(end_lbl);
   cur_fnc->cursor = end_lbl->prev; /* generate code before the end label */

   /*
    * All cases share the result location of the case expression.
    */
   rslt = chk_alc(rslt, n->lifetime);
   r2 = chk_alc(NULL, n);      /* for result of selection clause */
   r3 = chk_alc(NULL, n);      /* for dereferenced result of control clause */

   while (cases != NULL) {
      /*
       * See if we are at the end of the case clause list.
       */
      if (cases->n_type == N_Ccls) {
         clause = cases;
         cases = NULL;
         }
      else {
         clause = Tree1(cases);
         cases = Tree0(cases);
         }

      /*
       * If the evaluation of the selection code or the comparison of
       *  its value to the control clause fail, execution will proceed
       *  to the "skip clause" label and on to the next case.
       */
      skp_lbl = alc_lbl("skip clause", 0);
      on_failure = skp_lbl;
      cd_add(skp_lbl);
      cur_fnc->cursor = skp_lbl->prev;  /* generate code before end label */

      /*
       * Bound the selection code for this clause.
       */
      cd_lbl = alc_lbl("selected code", Bounding);
      cd_add(cd_lbl);
      cur_fnc->cursor = cd_lbl->prev;
      gencode(Tree0(clause), r2);

      /*
       * Dereference the results of the control clause and the selection
       *  clause and compare them.
       */
      setloc(clause);
      deref_cd(r1, r3);
      deref_cd(r2, r2);
      cd = NewCode(2);
      cd->cd_id = C_If;
      cd1 = alc_ary(5);
      cd1->ElemTyp(0) = A_Str;
      cd1->Str(0) =                 "!equiv(&";
      cd1->ElemTyp(1) = A_ValLoc;
      cd1->ValLoc(1) =              r3;
      cd->Cond = cd1;
      cd1->ElemTyp(2) = A_Str;
      cd1->Str(2) =                 ", &";
      cd1->ElemTyp(3) = A_ValLoc;
      cd1->ValLoc(3) =              r2;
      cd1->ElemTyp(4) = A_Str;
      cd1->Str(4) =                 ")";
      cd->ThenStmt = sig_cd(on_failure, cur_fnc);
      cd_add(cd);
      cd_add(sig_cd(cd_lbl, cur_fnc));  /* transfer control to bounding label */

      /*
       * Generate code for the body of this clause after the bounding label.
       */
      cur_fnc = fnc_sav;
      cur_fnc->cursor = cd_lbl;
      on_failure = fail_sav;
      gencode(Tree1(clause), rslt);

      /*
       * If this clause is a generator, call the success continuation
       *  for the case expression, otherwise branch to the end of the
       *  expression.
       */
      if (cur_fnc->cursor->next != skp_lbl) {
         if (succ_cont == NULL)
            succ_cont = alc_fnc(); /* allocate a continuation function */
         callc_add(succ_cont);
         cur_fnc = fnc_sav;
         }
      else
         cd_add(mk_goto(end_lbl));

      /*
       * The code for the next clause goes after the  "skip" label of
       *   this clause.
       */
      cur_fnc->cursor = skp_lbl;
      }

   if (deflt == NULL)
      cd_add(sig_cd(fail_sav, cur_fnc));     /* default action is failure */
   else {
      /*
       * There is an explicit default action.
       */
      on_failure = fail_sav;
      gencode(deflt, rslt);
      if (cur_fnc->cursor->next != end_lbl) {
         if (succ_cont == NULL)
            succ_cont = alc_fnc();
         callc_add(succ_cont);
         cur_fnc = fnc_sav;
         }
      }
   cur_fnc->cursor = end_lbl;

   /*
    * If some clauses are generators but others have transferred control
    *  to here, we must call the success continuation of the case
    *  expression and generate subsequent code there.
    */
   if (succ_cont != NULL) {
      on_failure = fail_sav;
      callc_add(succ_cont);
      cur_fnc = succ_cont;
      on_failure = &resume;
      }
   return rslt;
   }

/*
 * gen_creat - generate code to create a co-expression.
 */
static struct val_loc *gen_creat(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct code *cd;
   struct code *fail_sav;
   struct code *fail_lbl;
   struct c_fnc *fnc_sav;
   struct c_fnc *fnc;
   struct val_loc *co_rslt;
   struct freetmp *ft;
   char sav_prfx[PrfxSz];
   int *tmp_sv;
   int *itmp_sv;
   int *dtmp_sv;
   int *sbuf_sv;
   int *cbuf_sv;
   int ntmp_sv;
   int nitmp_sv;
   int ndtmp_sv;
   int nsbuf_sv;
   int ncbuf_sv;
   int stat_sz_sv;
   int istat_sz_sv;
   int dstat_sz_sv;
   int sstat_sz_sv;
   int cstat_sz_sv;
   int i;


   rslt = chk_alc(rslt, n->lifetime);

   fail_sav = on_failure;
   fnc_sav = cur_fnc;
   for (i = 0; i < PrfxSz; ++i)
      sav_prfx[i] = frm_prfx[i];

   /*
    * Temporary variables are allocated independently for the co-expression.
    */
   tmp_sv = tmp_status;
   itmp_sv = itmp_status;
   dtmp_sv = dtmp_status;
   sbuf_sv = sbuf_status;
   cbuf_sv = cbuf_status;
   stat_sz_sv = status_sz;
   istat_sz_sv = istatus_sz;
   dstat_sz_sv = dstatus_sz;
   sstat_sz_sv = sstatus_sz;
   cstat_sz_sv = cstatus_sz;
   ntmp_sv = num_tmp;
   nitmp_sv = num_itmp;
   ndtmp_sv = num_dtmp;
   nsbuf_sv = num_sbuf;
   ncbuf_sv = num_cbuf;
   tmp_status = (int *)alloc((unsigned int)(status_sz * sizeof(int)));
   itmp_status = (int *)alloc((unsigned int)(istatus_sz * sizeof(int)));
   dtmp_status = (int *)alloc((unsigned int)(dstatus_sz * sizeof(int)));
   sbuf_status = (int *)alloc((unsigned int)(sstatus_sz * sizeof(int)));
   cbuf_status = (int *)alloc((unsigned int)(cstatus_sz * sizeof(int)));
   for (i = 0; i < status_sz; ++i)
      tmp_status[i] = NotAlloc;
   for (i = 0; i < istatus_sz; ++i)
      itmp_status[i] = NotAlloc;
   for (i = 0; i < dstatus_sz; ++i)
      dtmp_status[i] = NotAlloc;
   for (i = 0; i < sstatus_sz; ++i)
      sbuf_status[i] = NotAlloc;
   for (i = 0; i < cstatus_sz; ++i)
      cbuf_status[i] = NotAlloc;
   num_tmp = 0;
   num_itmp = 0;
   num_dtmp = 0;
   num_sbuf = 0;
   num_cbuf = 0;

   /*
    * Put code for co-expression in separate function. We will need a new
    *  type of procedure frame which contains copies of local variables,
    *  copies of arguments, and temporaries for use by the co-expression.
    */
   fnc = alc_fnc();
   fnc->ref_cnt = 1;
   fnc->flag |= CF_Coexpr;
   ChkPrefix(fnc->prefix);
   for (i = 0; i < PrfxSz; ++i)
      frm_prfx[i] = fnc->frm_prfx[i] = fnc->prefix[i];
   cur_fnc = fnc;

   /*
    * Set up a co-expression failure label followed by a context switch
    *  and a branch back to the failure label.
    */
   fail_lbl = alc_lbl("co_fail", 0);
   cd_add(fail_lbl);
   lastline = 0;  /* force setting line number so tracing matches interp */
   setloc(n);
   cd = alc_ary(2);
   cd->ElemTyp(0) = A_Str;
   cd->ElemTyp(1) = A_Str;
   cd->Str(0) = "co_chng(popact((struct b_coexpr *)BlkLoc(k_current)),";
   cd->Str(1) =    "NULL, NULL, A_Cofail, 1);";
   cd_add(cd);
   cd_add(mk_goto(fail_lbl));
   cur_fnc->cursor = fail_lbl->prev;  /* code goes before failure label */
   on_failure = fail_lbl;

   /*
    * Generate code for the co-expression body, using the same
    *  dereferencing rules as for procedure return.
    */
   lastfiln = "";  /* force setting of file name and line number */
   lastline = 0;
   setloc(n);
   ++create_lvl;
   co_rslt = genretval(n, Tree0(n), NULL);
   --create_lvl;

   /*
    * If the co-expression might produce a result, generate a co-expression
    *  context switch.
    */
   if (co_rslt != NULL) {
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) = "++BlkLoc(k_current)->coexpr.size;";
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) = "co_chng(popact((struct b_coexpr *)BlkLoc(k_current)), &";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) = co_rslt;
      cd->ElemTyp(2) = A_Str;
      cd->Str(2) = ", NULL, A_Coret, 1);";
      cd_add(cd);
      cd_add(sig_cd(on_failure, cur_fnc)); /* if reactivated, resume expr */
      }

   /*
    * Output the new frame definition.
    */
   prt_frame(frm_prfx, cur_proc->tnd_loc + num_tmp + Abs(cur_proc->nargs),
      num_itmp, num_dtmp, num_sbuf, num_cbuf);

   /*
    * Now return to original function and produce code to create the
    *  co-expression.
    */
   cur_fnc = fnc_sav;
   for (i = 0; i < PrfxSz; ++i)
      frm_prfx[i] = sav_prfx[i];
   on_failure = fail_sav;

   lastfiln = "";  /* force setting of file name and line number */
   lastline = 0;
   setloc(n);
   cd = NewCode(5);
   cd->cd_id =  C_Create;
   cd->Rslt = rslt;
   cd->Cont = fnc;
   cd->NTemps = num_tmp;
   cd->WrkSize = num_itmp;
   cd->NextCreat = cur_fnc->creatlst;
   cur_fnc->creatlst = cd;
   cd_add(cd);

   /*
    * Restore arrays for temporary variable allocation.
    */
   free((char *)tmp_status);
   free((char *)itmp_status);
   free((char *)dtmp_status);
   free((char *)sbuf_status);
   free((char *)cbuf_status);
   tmp_status = tmp_sv;
   itmp_status = itmp_sv;
   dtmp_status = dtmp_sv;
   sbuf_status = sbuf_sv;
   cbuf_status = cbuf_sv;
   status_sz = stat_sz_sv;
   istatus_sz = istat_sz_sv;
   dstatus_sz = dstat_sz_sv;
   sstatus_sz = sstat_sz_sv;
   cstatus_sz = cstat_sz_sv;
   num_tmp = ntmp_sv;
   num_itmp = nitmp_sv;
   num_dtmp = ndtmp_sv;
   num_sbuf = nsbuf_sv;
   num_cbuf = ncbuf_sv;

   /*
    * Temporary variables that exist to the end of the co-expression
    *   have no meaning in the surrounding code and must not be
    *   deallocated there.
    */
   while (n->freetmp != NULL) {
      ft = n->freetmp->next;
      n->freetmp->next = freetmp_pool;
      freetmp_pool = n->freetmp;
      n->freetmp = ft;
      }

   return rslt;
   }

/*
 * gen_lim - generate code for limitation.
 */
static struct val_loc *gen_lim(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct node *expr;
   struct node *limit;
   struct val_loc *lim_desc;
   struct code *cd;
   struct code *cd1;
   struct code *lbl;
   struct code *fail_sav;
   struct c_fnc *fnc_sav;
   struct c_fnc *succ_cont;
   struct val_loc *lim_int;
   struct lentry *single;
   int deref;

   expr = Tree0(n);
   limit = Tree1(n);

   /*
    * Generate code to compute the limitation value and dereference it.
    */
   deref = HasVar(varsubtyp(limit->type, &single));
   if (single != NULL) {
      /*
       * Limitation is in a named variable. Use value directly from
       *  the variable rather than saving the result of the expression.
       */
      gencode(limit, &ignore);
      lim_desc = var_ref(single);
      }
   else {
      lim_desc = gencode(limit, NULL);
      if (deref)
         deref_cd(lim_desc, lim_desc);
      }

   setloc(n);
   fail_sav = on_failure;

   /*
    * Try to convert the limitation value into an integer.
    */
   lim_int = itmp_loc(alc_itmp(n->intrnl_lftm));
   cur_symtyps = n->symtyps;
   if (largeints || (eval_is(int_typ, 0) & MaybeFalse)) {
      /*
       * Must call the conversion routine.
       */
      lbl = alc_lbl("limit is int", 0);
      cd_add(lbl);
      cur_fnc->cursor = lbl->prev;        /* conversion goes before label */
      cd = NewCode(2);
      cd->cd_id = C_If;
      cd1 = alc_ary(5);
      cd1->ElemTyp(0) = A_Str;
      cd1->Str(0) =                  "cnv_c_int(&";
      cd1->ElemTyp(1) = A_ValLoc;
      cd1->ValLoc(1) =               lim_desc;
      cd1->ElemTyp(2) = A_Str;
      cd1->Str(2) =                  ", &";
      cd1->ElemTyp(3) = A_ValLoc;
      cd1->ValLoc(3) =                lim_int;
      cd1->ElemTyp(4) = A_Str;
      cd1->Str(4) =                  ")";
      cd->Cond = cd1;
      cd->ThenStmt = mk_goto(lbl);
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =                  "err_msg(101, &";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =               lim_desc;
      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 {
      /*
       * The C integer is in the vword.
       */
      cd = alc_ary(4);
      cd->ElemTyp(0) = A_ValLoc;
      cd->ValLoc(0) =                lim_int;
      cd->ElemTyp(1) = A_Str;
      cd->Str(1) =                   " = IntVal(";
      cd->ElemTyp(2) = A_ValLoc;
      cd->ValLoc(2) =                lim_desc;
      cd->ElemTyp(3) = A_Str;
      cd->Str(3) =                   ");";
      cd_add(cd);
      }

   /*
    * Make sure the limitation value is positive.
    */
   lbl = alc_lbl("limit positive", 0);
   cd_add(lbl);
   cur_fnc->cursor = lbl->prev;        /* code goes before label */
   cd = NewCode(2);
   cd->cd_id = C_If;
   cd1 = alc_ary(2);
   cd1->ElemTyp(0) = A_ValLoc;
   cd1->ValLoc(0) =                lim_int;
   cd1->ElemTyp(1) = A_Str;
   cd1->Str(1) =                  " >= 0";
   cd->Cond = cd1;
   cd->ThenStmt = mk_goto(lbl);
   cd_add(cd);
   cd = alc_ary(3);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =                  "err_msg(205, &";
   cd->ElemTyp(1) = A_ValLoc;
   cd->ValLoc(1) =               lim_desc;
   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;

   /*
    * If the limitation value is 0, fail immediately.
    */
   cd = NewCode(2);
   cd->cd_id = C_If;
   cd1 = alc_ary(2);
   cd1->ElemTyp(0) = A_ValLoc;
   cd1->ValLoc(0) =              lim_int;
   cd1->ElemTyp(1) = A_Str;
   cd1->Str(1) =                  " == 0";
   cd->Cond = cd1;
   cd->ThenStmt = sig_cd(on_failure, cur_fnc);
   cd_add(cd);

   /*
    * Establish where to go when limit has been reached.
    */
   fnc_sav = cur_fnc;
   lbl = alc_lbl("limit", 0);
   cd_add(lbl);
   cur_fnc->cursor = lbl->prev;  /* limited expression goes before label */

   /*
    * Generate code for limited expression and to check the limit value.
    */
   rslt = gencode(expr, rslt);
   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) =               lim_int;
   cd1->ElemTyp(2) = A_Str;
   cd1->Str(2) =                  " == 0";
   cd->Cond = cd1;
   cd->ThenStmt = sig_cd(lbl, cur_fnc);
   cd_add(cd);

   /*
    * Call the success continuation both here and after the limitation
    *  label.
    */
   succ_cont = alc_fnc();
   callc_add(succ_cont);
   cur_fnc = fnc_sav;
   cur_fnc->cursor = lbl;
   on_failure = fail_sav;
   callc_add(succ_cont);
   cur_fnc = succ_cont;
   on_failure = &resume;

   return rslt;
   }

/*
 * gen_apply - generate code for the apply operator, !.
 */
static struct val_loc *gen_apply(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct val_loc *callee;
   struct val_loc *lst;
   struct code *arg_lst;
   struct code *on_ret;
   struct c_fnc *fnc;

   /*
    * Generate code to compute the two operands.
    */
   callee = gencode(Tree0(n), NULL);
   lst = gencode(Tree1(n), NULL);
   rslt = chk_alc(rslt, n->lifetime);
   setloc(n);

   /*
    * Construct argument list for apply().
    */
   arg_lst = alc_ary(6);
   arg_lst->ElemTyp(0) = A_Str;
   arg_lst->Str(0) =                   "&";
   arg_lst->ElemTyp(1) = A_ValLoc;
   arg_lst->ValLoc(1) =                callee;
   arg_lst->ElemTyp(2) = A_Str;
   arg_lst->Str(2) =                   ", &";
   arg_lst->ElemTyp(3) = A_ValLoc;
   arg_lst->ValLoc(3) =                lst;
   arg_lst->ElemTyp(4) = A_Str;
   arg_lst->Str(4) =                   ", &";
   arg_lst->ElemTyp(5) = A_ValLoc;
   arg_lst->ValLoc(5) =                rslt;

   /*
    * Generate code to call apply(). Assume the operation can suspend and
    *   allocate a continuation. If it returns a "continue" signal,
    *   just break out of the signal handling code and fall into a call
    *   to the continuation.
    */
   on_ret = NewCode(1);      /* #fields for C_Break == #fields for C_Goto */
   on_ret->cd_id = C_Break;
   on_ret->next = NULL;
   on_ret->prev = NULL;
   fnc = alc_fnc();          /* success continuation */
   callo_add("apply", DoesFail | DoesRet | DoesSusp, fnc, 1, arg_lst, on_ret);
   callc_add(fnc);
   cur_fnc = fnc;            /* subsequent code goes in the continuation */
   on_failure = &resume;

   return rslt;
   }


/*
 * gen_scan - generate code for string scanning.
 */
static struct val_loc *gen_scan(n, rslt)
nodeptr n;
struct val_loc *rslt;
   {
   struct node *op;
   struct node *subj;
   struct node *body;
   struct scan_info *scanp;
   struct val_loc *asgn_var;
   struct val_loc *new_subj;
   struct val_loc *scan_rslt;
   struct tmplftm *lifetm_ary;
   struct lentry *subj_single;
   struct lentry *body_single;
   struct code *cd;
   struct code *cd1;
   struct code *lbl;
   struct implement *impl;
   int subj_deref;
   int body_deref;
   int op_tok;
   int tmp_indx;

   op = Tree0(n);          /* operator node '?' or '?:=' */
   subj = Tree1(n);        /* subject expression */
   body = Tree2(n);        /* scanning expression */
   op_tok = optab[Val0(op)].tok.t_type;

   /*
    * The location of the save areas for scanning environments is stored
    *  in list so they can be accessed by expressions that transfer
    *  control out of string scanning. Get the next list element and
    *  allocate the save areas in the procedure frame.
    */
   scanp = nxt_scan;
   if (nxt_scan->next == NULL)
      nxt_scan->next = NewStruct(scan_info);
   nxt_scan = nxt_scan->next;
   scanp->outer_sub = chk_alc(NULL, n->intrnl_lftm);
   scanp->outer_pos = itmp_loc(alc_itmp(n->intrnl_lftm));
   scanp->inner_sub = chk_alc(NULL, n->intrnl_lftm);
   scanp->inner_pos = itmp_loc(alc_itmp(n->intrnl_lftm));

   subj_deref = HasVar(varsubtyp(subj->type, &subj_single));
   if (subj_single != NULL) {
      /*
       * The subject value is in a named variable. Use value directly from
       *  the variable rather than saving the result of the expression.
       */
      gencode(subj, &ignore);
      new_subj = var_ref(subj_single);

      if (op_tok == AUGQMARK) {
         body_deref = HasVar(varsubtyp(body->type, &body_single));
         if (body_single != NULL)
            scan_rslt = &ignore; /* we know where the value will be */
         else
            scan_rslt = chk_alc(NULL, n->intrnl_lftm);
         }
      else
         scan_rslt = rslt; /* result of 2nd operand is result of scanning */
      }
   else if (op_tok == AUGQMARK) {
      /*
       * Augmented string scanning using general assignment. The operands
       *  must be in consecutive locations.
       */
      lifetm_ary = alc_lftm(2, &n->n_field[1]);
      tmp_indx = alc_tmp(2, lifetm_ary);
      asgn_var = tmp_loc(tmp_indx++);
      scan_rslt = tmp_loc(tmp_indx);
      free((char *)lifetm_ary);

      gencode(subj, asgn_var);
      new_subj = chk_alc(NULL, n->intrnl_lftm);
      deref_cd(asgn_var, new_subj);
      }
   else {
      new_subj = gencode(subj, NULL);
      if (subj_deref)
          deref_cd(new_subj, new_subj);
      scan_rslt = rslt; /* result of 2nd operand is result of scanning */
      }

   /*
    * Produce code to save the old scanning environment.
    */
   setloc(op);
   save_env(scanp->outer_sub, scanp->outer_pos);

   /*
    * Produce code to handle failure of the body of string scanning.
    */
   lbl = alc_lbl("scan fail", 0);
   cd_add(lbl);
   restr_env(scanp->outer_sub, scanp->outer_pos);
   cd_add(sig_cd(on_failure, cur_fnc)); /* fail */
   cur_fnc->cursor = lbl->prev;         /* body goes before label */
   on_failure = lbl;

   /*
    * If necessary, try to convert the subject to a string. Note that if
    *   error conversion occurs, backtracking will restore old subject.
    */
   cur_symtyps = n->symtyps;
   if (eval_is(str_typ, 0) & MaybeFalse) {
      lbl = alc_lbl("&subject is string", 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) =                 "cnv_str(&";
      cd1->ElemTyp(1) = A_ValLoc;
      cd1->ValLoc(1) =              new_subj;
      cd1->ElemTyp(2) = A_Str;
      cd1->Str(2) =                 ", &k_subject)";
      cd->Cond = cd1;
      cd->ThenStmt = mk_goto(lbl);
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =                  "err_msg(103, &";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =               new_subj;
      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 {
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =                  "k_subject = ";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =               new_subj;
      cd->ElemTyp(2) = A_Str;
      cd->Str(2) =                  ";";
      cd_add(cd);
      }
   cd = alc_ary(1);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =                 "k_pos = 1;";
   cd_add(cd);

   scan_rslt = gencode(body, scan_rslt);

   setloc(op);
   if (op_tok == AUGQMARK) {
      /*
       * '?:=' - perform assignment.
       */
      if (subj_single != NULL) {
         /*
          * Assignment to a named variable.
          */
         if (body_single != NULL)
            cd_add(mk_cpyval(new_subj, var_ref(body_single)));
         else if (body_deref)
            deref_cd(scan_rslt, new_subj);
         else
             cd_add(mk_cpyval(new_subj, scan_rslt));
         }
      else {
         /*
          * Use general assignment.
          */
         impl = optab[asgn_loc].binary;
         if (impl == NULL) {
            nfatal(op, "assignment not implemented", NULL);
            rslt = &ignore; /* make sure code generation can continue */
            }
         else {
            implproto(impl);
            rslt = chk_alc(rslt, n->lifetime);
            mk_callop(oper_name(impl), impl->ret_flag, asgn_var, 2, rslt,0);
            }
         }
      }
   else {
      /*
       * '?'
       */
      rslt = scan_rslt;
      }

   /*
    * Produce code restore subject and pos when the body of the
    *  scanning expression succeeds. The new subject and pos must
    *  be saved in case of resumption.
    */
   save_env(scanp->inner_sub, scanp->inner_pos);
   restr_env(scanp->outer_sub, scanp->outer_pos);

   /*
    * Produce code to handle resumption of string scanning.
    */
   lbl = alc_lbl("scan resume", 0);
   cd_add(lbl);
   save_env(scanp->outer_sub, scanp->outer_pos);
   restr_env(scanp->inner_sub, scanp->inner_pos);
   cd_add(sig_cd(on_failure, cur_fnc)); /* fail */
   cur_fnc->cursor = lbl->prev;     /* success continuation goes before label */
   on_failure = lbl;

   nxt_scan = scanp;
   return rslt;
   }

/*
 * gen_act - generate code for co-expression activation.
 */
static struct val_loc *gen_act(n, rslt)
nodeptr n;
struct val_loc *rslt;
   {
   struct node *op;
   struct node *transmit;
   struct node *coexpr;
   struct tmplftm *lifetm_ary;
   struct val_loc *trans_loc;
   struct val_loc *coexpr_loc;
   struct val_loc *asgn1;
   struct val_loc *asgn2;
   struct val_loc *act_rslt;
   struct lentry *c_single;
   struct code *cd;
   struct code *cd1;
   struct code *lbl;
   struct implement *impl;
   int c_deref;
   int op_tok;
   int tmp_indx;

   op = Tree0(n);        /* operator node for '@' or '@:=' */
   transmit = Tree1(n);  /* expression for value to transmit */
   coexpr = Tree2(n);    /* expression for co-expression */
   op_tok = optab[Val0(op)].tok.t_type;

   /*
    * Produce code for the value to be transmitted.
    */
   if (op_tok == AUGAT) {
      /*
       * Augmented activation. This is seldom used so don't try too
       *  hard to optimize it. Allocate contiguous temporaries for
       *  the operands to the assignment.
       */
      lifetm_ary = alc_lftm(2, &n->n_field[1]);
      tmp_indx = alc_tmp(2, lifetm_ary);
      asgn1 = tmp_loc(tmp_indx++);
      asgn2 = tmp_loc(tmp_indx);
      free((char *)lifetm_ary);

      /*
       * Generate code to produce the left-hand-side of the assignment.
       *  This is also the transmitted value. Activation may need a
       *  dereferenced value, so this must be in a different location.
       */
      gencode(transmit, asgn1);
      trans_loc = chk_alc(NULL, n->intrnl_lftm);
      setloc(op);
      deref_ret(asgn1, trans_loc, varsubtyp(transmit->type, NULL));
      }
   else
      trans_loc = genretval(op, transmit, NULL); /* ordinary activation */

   /*
    * Determine if the value to be activated needs dereferencing, and
    *  see if it can only come from a single named variable.
    */
   c_deref = HasVar(varsubtyp(coexpr->type, &c_single));
   if (c_single == NULL) {
      /*
       * The value is something other than a single named variable.
       */
      coexpr_loc = gencode(coexpr, NULL);
      if (c_deref)
         deref_cd(coexpr_loc, coexpr_loc);
      }
   else {
      /*
       * The value is in a named variable. Use it directly from the
       *  variable rather than saving the result of the expression.
       */
      gencode(coexpr, &ignore);
      coexpr_loc = var_ref(c_single);
      }

   /*
    * Make sure the value to be activated is a co-expression. Perform
    *   run-time checking if necessary.
    */
   cur_symtyps = n->symtyps;
   if (eval_is(coexp_typ, 1) & MaybeFalse) {
      lbl = alc_lbl("is co-expression", 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) =               coexpr_loc;
      cd1->ElemTyp(2) = A_Str;
      cd1->Str(2) =                  ").dword == D_Coexpr";
      cd->Cond = cd1;
      cd->ThenStmt = mk_goto(lbl);
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =                   "err_msg(118, &(";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =                coexpr_loc;
      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;
      }

   /*
    * Make sure a result location has been allocated. For ordinary
    *  activation, this is where activate() puts its result. For
    *  augmented activation, this is where assignment puts its result.
    */
   rslt = chk_alc(rslt, n->lifetime);
   if (op_tok == AUGAT)
      act_rslt = asgn2;
   else
      act_rslt = rslt;

   /*
    * Generate code to call activate().
    */
   setloc(n);
   cd = NewCode(2);
   cd->cd_id = C_If;
   cd1 = alc_ary(7);
   cd1->ElemTyp(0) = A_Str;
   cd1->Str(0) =                  "activate(&";
   cd1->ElemTyp(1) = A_ValLoc;
   cd1->ValLoc(1) =                trans_loc;
   cd1->ElemTyp(2) = A_Str;
   cd1->Str(2) =                  ", (struct b_coexpr *)BlkLoc(";
   cd1->ElemTyp(3) = A_ValLoc;
   cd1->ValLoc(3) =                coexpr_loc;
   cd1->ElemTyp(4) = A_Str;
   cd1->Str(4) =                  "), &";
   cd1->ElemTyp(5) = A_ValLoc;
   cd1->ValLoc(5) =                act_rslt;
   cd1->ElemTyp(6) = A_Str;
   cd1->Str(6) =                  ") == A_Resume";
   cd->Cond = cd1;
   cd->ThenStmt = sig_cd(on_failure, cur_fnc);
   cd_add(cd);

   /*
    * For augmented activation, generate code to call assignment.
    */
   if (op_tok == AUGAT) {
      impl = optab[asgn_loc].binary;
      if (impl == NULL) {
         nfatal(op, "assignment not implemented", NULL);
         rslt = &ignore; /* make sure code generation can continue */
         }
      else {
         implproto(impl);
         mk_callop(oper_name(impl), impl->ret_flag, asgn1, 2, rslt, 0);
         }
      }

   return rslt;
   }

/*
 * save_env - generate code to save scanning environment.
 */
static novalue save_env(sub_sav, pos_sav)
struct val_loc *sub_sav;
struct val_loc *pos_sav;
   {
   struct code *cd;

   cd = alc_ary(2);
   cd->ElemTyp(0) = A_ValLoc;
   cd->ValLoc(0) =              sub_sav;
   cd->ElemTyp(1) = A_Str;
   cd->Str(1) =                 " = k_subject;";
   cd_add(cd);
   cd = alc_ary(2);
   cd->ElemTyp(0) = A_ValLoc;
   cd->ValLoc(0) =              pos_sav;
   cd->ElemTyp(1) = A_Str;
   cd->Str(1) =                 " = k_pos;";
   cd_add(cd);
   }

/*
 * restr_env - generate code to restore scanning environment.
 */
static novalue restr_env(sub_sav, pos_sav)
struct val_loc *sub_sav;
struct val_loc *pos_sav;
   {
   struct code *cd;

   cd = alc_ary(3);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =                 "k_subject = ";
   cd->ElemTyp(1) = A_ValLoc;
   cd->ValLoc(1) =              sub_sav;
   cd->ElemTyp(2) = A_Str;
   cd->Str(2) =                 ";";
   cd_add(cd);
   cd = alc_ary(3);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =                 "k_pos = ";
   cd->ElemTyp(1) = A_ValLoc;
   cd->ValLoc(1) =              pos_sav;
   cd->ElemTyp(2) = A_Str;
   cd->Str(2) =                 ";";
   cd_add(cd);
   }

/*
 * mk_callop - produce the code to directly call an operation.
 */
static novalue mk_callop(oper_nm, ret_flag, arg1rslt, nargs, rslt, optim)
char *oper_nm;
int ret_flag;
struct val_loc *arg1rslt;
int nargs;
struct val_loc *rslt;
int optim;
   {
   struct code *arg_lst;
   struct code *on_ret;
   struct c_fnc *fnc;
   int n;
   int need_cont;

   /*
    * If this operation can return an "continue" signal, we will need
    *   a break statement in the signal switch to handle it.
    */
   if (ret_flag & DoesRet) {
      on_ret = NewCode(1);      /* #fields == #fields C_Goto */
      on_ret->cd_id = C_Break;
      on_ret->next = NULL;
      on_ret->prev = NULL;
      }
   else
      on_ret = NULL;

   /*
    * Construct argument list for the C function implementing the
    *  operation. First compute the size of the code array for the
    *  argument list; this varies if we are using an optimized calling
    *  interface.
    */
   if (optim) {
      n = 0;
      if (arg1rslt != NULL)
         n += 2;
      if (ret_flag & (DoesRet | DoesSusp)) {
         if (n > 0)
            ++n;
         n += 2;
         }
      }
   else
      n = 7;
   if (n == 0)
      arg_lst = NULL;
   else {
      arg_lst = alc_ary(n);
      n = 0;
      if (!optim) {
         arg_lst->ElemTyp(n) = A_Intgr;       /* number of arguments */
         arg_lst->Intgr(n) = nargs;
         ++n;
         arg_lst->ElemTyp(n) = A_Str;        /* , */
         arg_lst->Str(n) = ", ";
         ++n;
         }
      if (arg1rslt == NULL) {             /* location of first argument */
         if (!optim) {
            arg_lst->ElemTyp(n) = A_Str;
            arg_lst->Str(n) = "NULL";
            ++n;
            arg_lst->ElemTyp(n) = A_Str;
            arg_lst->Str(n) = "";         /* nothing, but must fill slot */
            ++n;
            }
         }
      else {
         arg_lst->ElemTyp(n) = A_Str;
         arg_lst->Str(n) = "&";
         ++n;
         arg_lst->ElemTyp(n) = A_ValLoc;
         arg_lst->ValLoc(n) = arg1rslt;
         ++n;
         }
      if (!optim || ret_flag & (DoesRet | DoesSusp)) {
         if (n > 0) {
            arg_lst->ElemTyp(n) = A_Str;        /* , */
            arg_lst->Str(n) = ", ";
            ++n;
            }
         arg_lst->ElemTyp(n) = A_Str;        /* location of result */
         arg_lst->Str(n) = "&";
         ++n;
         arg_lst->ElemTyp(n) = A_ValLoc;
         arg_lst->ValLoc(n) = rslt;
         }
      }

   /*
    * Generate code to call the operation and handle returned signals.
    */
   if (ret_flag & DoesSusp) {
      /*
       * The operation suspends, so call it with a continuation, then
       *  proceed to generate code in the continuation.
       */
      fnc = alc_fnc();
      callo_add(oper_nm, ret_flag, fnc, 1, arg_lst, on_ret);
      if (ret_flag & DoesRet)
         callc_add(fnc);
      cur_fnc = fnc;
      on_failure = &resume;
      }
   else {
      /*
       * No continuation is needed, but if standard calling conventions
       *  are used, a NULL continuation argument is required.
       */
      if (optim)
         need_cont = 0;
      else
         need_cont = 1;
      callo_add(oper_nm, ret_flag, NULL, need_cont, arg_lst, on_ret);
      }
   }

/*
 * genretval - generate code for the expression in a return/suspend or
 *  for the expression for the value to be transmitted in a co-expression
 *  context switch.
 */
static struct val_loc *genretval(n, expr, dest)
struct node *n;
struct node *expr;
struct val_loc *dest;
   {
   int subtypes;
   struct lentry *single;
   struct val_loc *val;

   subtypes = varsubtyp(expr->type, &single);

   /*
    * If we have a single local or argument, we don't need to construct
    *  a variable reference; we need the value and we know where it is.
    */
   if (single != NULL && (subtypes & (HasLcl | HasPrm))) {
      gencode(expr, &ignore);
      val = var_ref(single);
      if (dest == NULL)
         dest = val;
      else
         cd_add(mk_cpyval(dest, val));
      }
   else {
      dest = gencode(expr, dest);
      setloc(n);
      deref_ret(dest, dest, subtypes);
      }

   return dest;
   }

/*
 * deref_ret - produced dereferencing code for values returned from
 *  procedures or transmitted to co-expressions.
 */
static novalue deref_ret(src, dest, subtypes)
struct val_loc *src;
struct val_loc *dest;
int subtypes;
   {
   struct code *cd;
   struct code *lbl;

   if (src == NULL)
      return;  /* no value to dereference */

   /*
    * If there may be values that do not need dereferencing, insure that the
    *  values are in the destination and make it the source of dereferencing.
    */
   if ((subtypes & (HasVal | HasGlb)) && (src != dest)) {
      cd_add(mk_cpyval(dest, src));
      src = dest;
      }

   if (subtypes & (HasLcl | HasPrm)) {
      /*
       * Some values may need to be dereferenced.
       */
      lbl = NULL;
      if (subtypes & HasVal) {
         /*
          * We may have a non-variable and must check at run time.
          */
         lbl = check_var(dest, NULL);
         }

      if (subtypes & HasGlb) {
         /*
          * Make sure we don't dereference any globals, use retderef().
          */
         if (subtypes & HasLcl) {
            /*
             * We must dereference any locals.
             */
            cd = alc_ary(3);
            cd->ElemTyp(0) = A_Str;
            cd->Str(0) =                "retderef(&";
            cd->ElemTyp(1) = A_ValLoc;
            cd->ValLoc(1) =             dest;
            cd->ElemTyp(2) = A_Str;
            cd->Str(2) =
               ", (word *)pfp->tend.d, (word *)(pfp->tend.d + pfp->tend.num));";
            cd_add(cd);
            /*
             * We may now have a value. We must check at run-time and skip
             *  any attempt to dereference an argument.
             */
            lbl = check_var(dest, lbl);
            }

         if (subtypes & HasPrm) {
            /*
             * We must dereference any arguments.
             */
            cd = alc_ary(5);
            cd->ElemTyp(0) = A_Str;
            cd->Str(0) =                "retderef(&";
            cd->ElemTyp(1) = A_ValLoc;
            cd->ValLoc(1) =             dest;
            cd->ElemTyp(2) = A_Str;
            cd->Str(2) =                ", (word *)argp, (word *)(argp + ";
            cd->ElemTyp(3) = A_Intgr;
            cd->Intgr(3) =              Abs(cur_proc->nargs);
            cd->ElemTyp(4) = A_Str;
            cd->Str(4) =                 "));";
            cd_add(cd);
            }
         }
      else /* No globals */
         deref_cd(src, dest);

      if (lbl != NULL)
         cur_fnc->cursor = lbl;   /* continue after label */
      }
   }

/*
 * check_var - generate code to make sure a descriptor contains a variable
 *  reference. If no label is given to jump to for a non-variable, allocate
 *  one and generate code before it.
 */
static struct code *check_var(d, lbl)
struct val_loc *d;
struct code *lbl;
   {
   struct code *cd, *cd1;

   if (lbl == NULL) {
      lbl = alc_lbl("not variable", 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) =                  "!Var(";
   cd1->ElemTyp(1) = A_ValLoc;
   cd1->ValLoc(1) =               d;
   cd1->ElemTyp(2) = A_Str;
   cd1->Str(2) =                  ")";
   cd->Cond = cd1;
   cd->ThenStmt = mk_goto(lbl);
   cd_add(cd);

   return lbl;
   }

/*
 * field_ref - generate code for a field reference.
 */
static struct val_loc *field_ref(n, rslt)
struct node *n;
struct val_loc *rslt;
   {
   struct node *rec;
   struct node *fld;
   struct fentry *fp;
   struct par_rec *rp;
   struct val_loc *rec_loc;
   struct code *cd;
   struct code *cd1;
   struct code *lbl;
   struct lentry *single;
   int deref;
   int num_offsets;
   int offset;
   int bad_recs;

   rec = Tree0(n);
   fld = Tree1(n);

   /*
    * Generate code to compute the record value and dereference it.
    */
   deref = HasVar(varsubtyp(rec->type, &single));
   if (single != NULL) {
      /*
       * The record is in a named variable. Use value directly from
       *  the variable rather than saving the result of the expression.
       */
      gencode(rec, &ignore);
      rec_loc = var_ref(single);
      }
   else {
      rec_loc = gencode(rec, NULL);
      if (deref)
         deref_cd(rec_loc, rec_loc);
      }

   setloc(fld);

   /*
    * Make sure the operand is a record.
    */
   cur_symtyps = n->symtyps;
   if (eval_is(rec_typ, 0) & MaybeFalse) {
      lbl = alc_lbl("is record", 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) =               rec_loc;
      cd1->ElemTyp(2) = A_Str;
      cd1->Str(2) =                  ").dword == D_Record";
      cd->Cond = cd1;
      cd->ThenStmt = mk_goto(lbl);
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =                   "err_msg(107, &";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =                rec_loc;
      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;
      }

   rslt = chk_alc(rslt, n->lifetime);

   /*
    * Find the list of records containing this field.
    */
   if ((fp = flookup(Str0(fld))) == NULL) {
      nfatal(n, "invalid field", Str0(fld));
      return rslt;
      }

   /*
    * Generate code for declarations and to get the record block pointer.
    */
   cd = alc_ary(1);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =             "{";
   cd_add(cd);
   cd = alc_ary(3);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =           "struct b_record *r_rp = (struct b_record *) BlkLoc(";
   cd->ElemTyp(1) = A_ValLoc;
   cd->ValLoc(1) =          rec_loc;
   cd->ElemTyp(2) = A_Str;
   cd->Str(2) =             ");";
   cd_add(cd);
   if (err_conv) {
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =             "int r_must_fail = 0;";
      cd_add(cd);
      }

   /*
    * Determine which records are in the record type.
    */
   mark_recs(fp, cur_symtyps->types[0], &num_offsets, &offset, &bad_recs);

   /*
    * Generate code to insure that the field belongs to the record
    *  and to index into the record block.
    */
   if (num_offsets == 1 && !bad_recs) {
      /*
       * We already know the offset of the field.
       */
      cd = alc_ary(4);
      cd->ElemTyp(0) = A_ValLoc;
      cd->ValLoc(0) =           rslt;
      cd->ElemTyp(1) = A_Str;
      cd->Str(1) =              ".dword = D_Var + ((word *)&r_rp->fields[";
      cd->ElemTyp(2) = A_Intgr;
      cd->Intgr(2) =            offset;
      cd->ElemTyp(3) = A_Str;
      cd->Str(3) =              "] - (word *)r_rp);";
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "VarLoc(";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =           rslt;
      cd->ElemTyp(2) = A_Str;
      cd->Str(2) =              ") = (dptr)r_rp;";
      cd_add(cd);
      for (rp = fp->rlist; rp != NULL; rp = rp->next)
         rp->mark = 0;
      }
   else {
      /*
       * The field appears in several records. generate code to determine
       *  which one it is.
       */

      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "dptr r_dp;";
      cd_add(cd);
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "switch (r_rp->recdesc->proc.recnum) {";
      cd_add(cd);

      rp = fp->rlist;
      while (rp != NULL) {
         offset = rp->offset;
         while (rp != NULL && rp->offset == offset) {
            if (rp->mark) {
               rp->mark = 0;
               cd = alc_ary(3);
               cd->ElemTyp(0) = A_Str;
               cd->Str(0) =              "   case ";
               cd->ElemTyp(1) = A_Intgr;
               cd->Intgr(1) =            rp->rec->rec_num;
               cd->ElemTyp(2) = A_Str;
               cd->Str(2) =              ":";
               cd_add(cd);
               }
            rp = rp->next;
            }

         cd = alc_ary(3);
         cd->ElemTyp(0) = A_Str;
         cd->Str(0) =              "      r_dp = &r_rp->fields[";
         cd->ElemTyp(1) = A_Intgr;
         cd->Intgr(1) =                   offset;
         cd->ElemTyp(2) = A_Str;
         cd->Str(2) =                     "];";
         cd_add(cd);
         cd = alc_ary(1);
         cd->ElemTyp(0) = A_Str;
         cd->Str(0) =              "      break;";
         cd_add(cd);
         }

      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "   default:";
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "      err_msg(207, &";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =                   rec_loc;
      cd->ElemTyp(2) = A_Str;
      cd->Str(2) =                     ");";
      cd_add(cd);
      if (err_conv) {
         /*
          * The peephole analyzer doesn't know how to handle a goto or return
          *  in a switch statement, so just set a flag here.
          */
         cd = alc_ary(1);
         cd->ElemTyp(0) = A_Str;
         cd->Str(0) =       "      r_must_fail = 1;";
         cd_add(cd);
         }
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "   }";
      cd_add(cd);
      if (err_conv) {
         /*
          * Now that we are out of the switch statement, see if the flag
          *   was set to indicate error conversion.
          */
         cd = NewCode(2);
         cd->cd_id = C_If;
         cd1 = alc_ary(1);
         cd1->ElemTyp(0) = A_Str;
         cd1->Str(0) =                  "r_must_fail";
         cd->Cond = cd1;
         cd->ThenStmt = sig_cd(on_failure, cur_fnc);
         cd_add(cd);
         }
      cd = alc_ary(2);
      cd->ElemTyp(0) = A_ValLoc;
      cd->ValLoc(0) =           rslt;
      cd->ElemTyp(1) = A_Str;
      cd->Str(1) =            ".dword = D_Var + ((word *)r_dp - (word *)r_rp);";
      cd_add(cd);
      cd = alc_ary(3);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) =              "VarLoc(";
      cd->ElemTyp(1) = A_ValLoc;
      cd->ValLoc(1) =           rslt;
      cd->ElemTyp(2) = A_Str;
      cd->Str(2) =              ") = (dptr)r_rp;";
      cd_add(cd);
      }

   cd = alc_ary(1);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =              "}";
   cd_add(cd);
   return rslt;
   }

/*
 * bound - bound the code for the given sub-tree. If catch_fail is true,
 *   direct failure to the bounding label.
 */
static struct val_loc *bound(n, rslt, catch_fail)
struct node *n;
struct val_loc *rslt;
int catch_fail;
   {
   struct code *lbl1;
   struct code *fail_sav;
   struct c_fnc *fnc_sav;

   fnc_sav = cur_fnc;
   fail_sav = on_failure;

   lbl1 = alc_lbl("bound", Bounding);
   cd_add(lbl1);
   cur_fnc->cursor = lbl1->prev;     /* code goes before label */
   if (catch_fail)
      on_failure = lbl1;

   rslt = gencode(n, rslt);

   cd_add(sig_cd(lbl1, cur_fnc));   /* transfer control to bounding label */
   cur_fnc = fnc_sav;
   cur_fnc->cursor = lbl1;

   on_failure = fail_sav;
   return rslt;
   }

/*
 * cd_add - add a code struct at the cursor in the current function.
 */
novalue cd_add(cd)
struct code *cd;
   {
   register struct code *cursor;

   cursor = cur_fnc->cursor;
   cd->next = cursor->next;
   cd->prev = cursor;
   if (cursor->next != NULL)
      cursor->next->prev = cd;
   cursor->next = cd;
   cur_fnc->cursor = cd;
   }

/*
 * sig_cd - convert a signal/label into a goto or return signal in
 *   the context of the given function.
 */
struct code *sig_cd(sig, fnc)
struct code *sig;
struct c_fnc *fnc;
   {
   struct code *cd;

   if (sig->cd_id == C_Label && sig->Container == fnc)
      return mk_goto(sig);
   else {
      cd = NewCode(1);      /* # fields <= # fields of C_Goto */
      cd->cd_id = C_RetSig;
      cd->next = NULL;
      cd->prev = NULL;
      cd->SigRef = add_sig(sig, fnc);
      return cd;
      }
   }

/*
 * add_sig - add signal to list of signals returned by function.
 */
struct sig_lst *add_sig(sig, fnc)
struct code *sig;
struct c_fnc *fnc;
   {
   struct sig_lst *sl;

   for (sl = fnc->sig_lst; sl != NULL && sl->sig != sig; sl = sl->next)
      ;
   if (sl == NULL) {
      sl = NewStruct(sig_lst);
      sl->sig = sig;
      sl->ref_cnt = 1;
      sl->next = fnc->sig_lst;
      fnc->sig_lst = sl;
      }
   else
      ++sl->ref_cnt;
   return sl;
   }

/*
 * callc_add - add code to call a continuation. Note the action to be
 *  taken if the continuation returns resumption. The actual list
 *  signals returned and actions to take will be figured out after
 *  the continuation has been optimized.
 */
novalue callc_add(cont)
struct c_fnc *cont;
   {
   struct code *cd;

   cd = new_call();
   cd->OperName = NULL;
   cd->Cont = cont;
   cd->ArgLst = NULL;
   cd->ContFail = on_failure;
   cd->SigActs = NULL;
   ++cont->ref_cnt;
   }

/*
 * callo_add - add code to call an operation.
 */
novalue callo_add(oper_nm, ret_flag, cont, need_cont, arglist, on_ret)
char *oper_nm;
int ret_flag;
struct c_fnc *cont;
int need_cont;
struct code *arglist;
struct code *on_ret;
   {
   struct code *cd;
   struct code *cd1;

   cd = new_call();
   cd->OperName = oper_nm;
   cd->Cont = cont;
   if (need_cont)
      cd->Flags = NeedCont;
   cd->ArgLst = arglist;
   cd->ContFail = NULL;   /* operation handles failure from the continuation */
   /*
    * Decide how to handle the signals produced by the operation. (Those
    *  produced by the continuation will be examined after the continuation
    *  is optimized.)
    */
   cd->SigActs = NULL;
   if (MightFail(ret_flag))
      cd->SigActs = new_sgact(&resume, sig_cd(on_failure,cur_fnc), cd->SigActs);
   if (ret_flag & DoesRet)
      cd->SigActs = new_sgact(&contin, on_ret, cd->SigActs);
   if (ret_flag & DoesFThru) {
      cd1 = NewCode(1);      /* #fields == #fields C_Goto */
      cd1->cd_id = C_Break;
      cd1->next = NULL;
      cd1->prev = NULL;
      cd->SigActs = new_sgact(&fallthru, cd1, cd->SigActs);
      }
   if (cont != NULL)
      ++cont->ref_cnt;  /* increment reference count */
   }

/*
 * Create a call, add it to the code for the current function, and
 *  add it to the list of calls from the current function.
 */
static struct code *new_call()
   {
   struct code *cd;

   cd = NewCode(7);
   cd->cd_id = C_CallSig;
   cd_add(cd);
   cd->Flags = 0;
   cd->NextCall = cur_fnc->call_lst;
   cur_fnc->call_lst = cd;
   return cd;
   }

/*
 * sig_act - create a new binding of an action to a signal.
 */
struct sig_act *new_sgact(sig, cd, next)
struct code *sig;
struct code *cd;
struct sig_act *next;
   {
   struct sig_act *sa;

   sa = NewStruct(sig_act);
   sa->sig = sig;
   sa->cd = cd;
   sa->shar_act = NULL;
   sa->next = next;
   return sa;
   }

/*
 * setloc produces code to set the file name and line number to the
 *  source location of node n.  Code is only produced if the corresponding
 *  value has changed since the last time setloc was called.
 */
static novalue setloc(n)
nodeptr n;
   {
   struct code *cd;

   if (n == NULL || File(n) == NULL || Line(n) == 0)
      return;

   if (File(n) != lastfiln || Line(n) != lastline) {
      cd = alc_ary(1);
      cd->ElemTyp(0) = A_Str;
      cd->Str(0) = "Poll();";
      cd_add(cd);

      if (line_info) {
         cd = NewCode(2);
         cd->cd_id = C_SrcLoc;

         if (File(n) == lastfiln)
            cd->FileName = NULL;
         else {
            lastfiln = File(n);
            cd->FileName = lastfiln;
            }

         if (Line(n) == lastline)
            cd->LineNum = 0;
         else {
            lastline = Line(n);
            cd->LineNum = lastline;
            }

         cd_add(cd);
         }
      }
   }

/*
 * alc_ary - create an array for a sequence of code fragments.
 */
struct code *alc_ary(n)
int n;
   {
   struct code *cd;

   cd = NewCode(2 * n + 1);
   cd->cd_id = C_CdAry;
   cd->next = NULL;
   cd->prev = NULL;
   cd->ElemTyp(n) = A_End;
   return cd;
   }


/*
 * alc_lbl - create a label.
 */
struct code *alc_lbl(desc, flag)
char *desc;
int flag;
   {
   register struct code *cd;

   cd = NewCode(5);
   cd->cd_id = C_Label;
   cd->next = NULL;
   cd->prev = NULL;
   cd->Container = cur_fnc; /* function containing label */
   cd->SeqNum = 0;          /* sequence number is allocated later */
   cd->Desc = desc;         /* identifying comment */
   cd->RefCnt = 0;          /* reference count */
   cd->LabFlg = flag;
   return cd;
   }

/*
 * alc_fnc - allocate a function structure;
 */
static struct c_fnc *alc_fnc()
   {
   register struct c_fnc *cf;
   int i;

   cf = NewStruct(c_fnc);
   cf->prefix[0] = '\0';             /* prefix is allocated later */
   cf->prefix[PrfxSz] = '\0';        /* terminate prefix for printing */
   cf->flag = 0;
   for (i = 0; i < PrfxSz; ++i)
      cf->frm_prfx[i] = frm_prfx[i]; /* note procedure frame prefix */
   cf->frm_prfx[PrfxSz] = '\0';      /* terminate prefix for printing */
   cf->cd.cd_id = C_Null;            /* base of code sequence in function */
   cf->cd.next = NULL;
   cf->cursor = &cf->cd;             /* current place to insert code */
   cf->call_lst = NULL;              /* functions called by this function */
   cf->creatlst = NULL;              /* creates within this function */
   cf->sig_lst = NULL;               /* signals returned by this function */
   cf->ref_cnt = 0;
   cf->next = NULL;
   *flst_end = cf;                   /* link entry onto global list */
   flst_end = &(cf->next);
   return cf;
   }

/*
 * tmp_loc - allocate a value location structure for nth temporary descriptor
 *  variable in procedure frame.
 */
static struct val_loc *tmp_loc(n)
int n;
   {
   register struct val_loc *r;

   r = NewStruct(val_loc);
   r->loc_type = V_Temp;
   r->mod_access = M_None;
   r->u.tmp = n;
   return r;
   }

/*
 * itmp_loc - allocate a value location structure for nth temporary integer
 *  variable in procedure frame.
 */
struct val_loc *itmp_loc(n)
int n;
   {
   register struct val_loc *r;

   r = NewStruct(val_loc);
   r->loc_type = V_ITemp;
   r->mod_access = M_None;
   r->u.tmp = n;
   return r;
   }

/*
 * dtmp_loc - allocate a value location structure for nth temporary double
 *  variable in procedure frame.
 */
struct val_loc *dtmp_loc(n)
int n;
   {
   register struct val_loc *r;

   r = NewStruct(val_loc);
   r->loc_type = V_DTemp;
   r->mod_access = M_None;
   r->u.tmp = n;
   return r;
   }

/*
 * vararg_sz - allocate a value location structure that refers to the size
 *  of the variable part of an argument list.
 */
static struct val_loc *vararg_sz(n)
int n;
   {
   register struct val_loc *r;

   r = NewStruct(val_loc);
   r->loc_type = V_Const;
   r->mod_access = M_None;
   r->u.int_const = n;
   return r;
   }

/*
 * cvar_loc - allocate a value location structure for a C variable.
 */
struct val_loc *cvar_loc(name)
char *name;
   {
   register struct val_loc *r;

   r = NewStruct(val_loc);
   r->loc_type = V_CVar;
   r->mod_access = M_None;
   r->u.name = name;
   return r;
   }

/*
 * var_ref - allocate a value location structure for an Icon named variable.
 */
static struct val_loc *var_ref(sym)
struct lentry *sym;
   {
   struct val_loc *loc;

   loc = NewStruct(val_loc);
   loc->loc_type = V_NamedVar;
   loc->mod_access = M_None;
   loc->u.nvar = sym;
   return loc;
   }

/*
 * deref_cd - generate code to dereference a descriptor.
 */
static novalue deref_cd(src, dest)
struct val_loc *src;
struct val_loc *dest;
   {
   struct code *cd;

   cd = alc_ary(5);
   cd->ElemTyp(0) = A_Str;
   cd->Str(0) =                  "deref(&";
   cd->ElemTyp(1) = A_ValLoc;
   cd->ValLoc(1) =               src;
   cd->ElemTyp(2) = A_Str;
   cd->Str(2) =                  ", &";
   cd->ElemTyp(3) = A_ValLoc;
   cd->ValLoc(3) =               dest;
   cd->ElemTyp(4) = A_Str;
   cd->Str(4) =                  ");";
   cd_add(cd);
   }

/*
 * inv_op - directly invoke a run-time operation, in-lining it if possible.
 */
static struct val_loc *inv_op(n, rslt)
nodeptr n;
struct val_loc *rslt;
   {
   struct implement *impl;
   struct code *scont_strt;
   struct code *scont_fail;
   struct c_fnc *fnc;
   struct val_loc *frst_arg;
   struct val_loc *arg_rslt;
   struct val_loc *r;
   struct val_loc **varg_rslt;
   struct op_symentry *symtab;
   struct lentry **single;
   struct tmplftm *lifetm_ary;
   nodeptr rslt_lftm;
   char *sbuf;
   int *maybe_var;
   int may_mod;
   int nsyms;
   int nargs;
   int nparms;
   int cont_loc;
   int flag;
   int refs;
   int var_args;
   int n_varargs;
   int arg_loc;
   int dcl_var;
   int i;
   int j;
   int v;

   nargs = Val0(n);
   impl = Impl1(n);
   if (impl == NULL) {
      /*
       * We have already printed an error, just make sure we can
       *  continue.
       */
      return &ignore;
      }

   /*
    * If this operation uses its result location as a work area, it must
    *   be given a tended result location and the value must be retained
    *   as long as the operation can be resumed.
    */
   rslt_lftm = n->lifetime;
   if (impl->use_rslt) {
       rslt_lftm = max_lftm(rslt_lftm, n->intrnl_lftm);
       if (rslt == &ignore)
          rslt = NULL;      /* force allocation of temporary */
       }

   /*
    * Determine if this operation takes a variable number of arguments
    *  and determine the size of the variable part of the arg list.
    */
   nparms = impl->nargs;
   if (nparms > 0 && impl->arg_flgs[nparms - 1] & VarPrm) {
      var_args = 1;
      n_varargs = nargs - nparms + 1;
      if (n_varargs < 0)
         n_varargs = 0;
      }
   else {
      var_args = 0;
      n_varargs = 0;
      }

   /*
    * Construct a symbol table (implemented as an array) for the operation.
    *  The symbol table includes parameters, and both the tended and
    *  ordinary variables from the RTL declare statement.
    */
   nsyms = (n->symtyps == NULL ? 0 : n->symtyps->nsyms);
   if (var_args)
      ++nsyms;
   nsyms += impl->ntnds + impl->nvars;
   if (nsyms > 0)
      symtab = (struct op_symentry *)alloc((unsigned int)(nsyms *
         sizeof(struct op_symentry)));
   else
      symtab = NULL;
   for (i = 0; i < nsyms; ++i) {
      symtab[i].n_refs = 0;     /* number of non-modifying references */
      symtab[i].n_mods = 0;     /* number of modifying references */
      symtab[i].n_rets = 0;     /* number of times returned directly */
      symtab[i].var_safe = 0;   /* Icon variable arg can be passed directly */
      symtab[i].adjust = 0;     /* adjustments needed to "dereference" */
      symtab[i].itmp_indx = -1; /* loc after "in-place" convert to C integer */
      symtab[i].dtmp_indx = -1; /* loc after "in-place" convert to C double */
      symtab[i].loc = NULL;     /* location as a descriptor */
      }

   /*
    * If in-lining has not been disabled or the operation is a keyword,
    *  check to see if it can reasonably be in-lined and gather information
    *  needed to in-line it.
    */
   if ((allow_inline || impl->oper_typ == 'K') &&
      do_inlin(impl, n, &cont_loc, symtab, n_varargs)) {
      /*
       * In-line the operation.
       */

      if (impl->ret_flag & DoesRet || impl->ret_flag & DoesSusp)
         rslt = chk_alc(rslt, rslt_lftm);  /* operation produces a result */

      /*
       * Allocate arrays to hold information from type inferencing about
       *  whether arguments are variables. This is used to optimize
       *  dereferencing.
       */
      if (nargs > 0) {
         maybe_var = (int *)alloc((unsigned int)(nargs * sizeof(int)));
         single = (struct lentry **)alloc((unsigned int)(nargs *
            sizeof(struct lentry *)));
         }

      if (var_args)
         --nparms; /* don't deal with varargs parameter yet. */

      /*
       * Match arguments with parameters and generate code for the
       *  arguments. The type of code generated depends on the kinds
       *  of dereferencing optimizations that are possible, though
       *  in general, dereferencing must wait until all arguments are
       *  computed. Because there may be both dereferenced and undereferenced
       *  parameters for an argument, the symbol table index does not always
       *  match the argument index.
       */
      i = 0;  /* symbol table index */
      for (j = 0; j < nparms && j < nargs; ++j) {
         /*
          * Use information from type inferencing to determine if the
          *  argument might me a variable and whether it is a single
          *  known named variable.
          */
         maybe_var[j] = HasVar(varsubtyp(n->n_field[FrstArg + j].n_ptr->type,
             &(single[j])));

         /*
          * Determine how many times the argument is referenced. If we
          *  optimize away return statements because we don't need the
          *  result, those references don't count. Take into account
          *  that there may be both dereferenced and undereferenced
          *  parameters for this argument.
          */
         if (rslt == &ignore)
            symtab[i].n_refs -= symtab[i].n_rets;
         refs = symtab[i].n_refs + symtab[i].n_mods;
         flag = impl->arg_flgs[j] & (RtParm | DrfPrm);
         if (flag == (RtParm | DrfPrm))
            refs += symtab[i + 1].n_refs + symtab[i + 1].n_mods;
         if (refs == 0) {
            /*
             * Indicate that we don't need the argument value (we must
             *  still perform the computation in case it has side effects).
             */
            arg_rslt = &ignore;
            symtab[i].adjust = AdjNone;
            }
         else {
            /*
             * Decide whether the result location for the argument can be
             *  used directly as the parameter.
             */
            if (flag == (RtParm | DrfPrm) && symtab[i].n_refs +
               symtab[i].n_mods == 0) {
                  /*
                   * We have both dereferenced and undereferenced parameters,
                   *  but don't use the undereferenced one so ignore it.
                   */
                  symtab[i].adjust = AdjNone;
                  ++i;
                  flag = DrfPrm;
                  }
            if (flag == DrfPrm && single[j] != NULL) {
               /*
                * We need only a dereferenced value, but know what variable
                *  it is in. We don't need the computed argument value, we will
                *  get it directly from the variable. If it is safe to do
                *  so, we will pass a pointer to the variable as the argument
                *  to the operation.
                */
               arg_rslt = &ignore;
               symtab[i].loc = var_ref(single[j]);
               if (symtab[i].var_safe)
                  symtab[i].adjust = AdjNone;
               else
                  symtab[i].adjust = AdjCpy;
               }
            else {
               /*
                * Determine if the argument descriptor is modified by the
                *  operation; dereferencing a variable is a modification.
                */
               may_mod = (symtab[i].n_mods != 0);
               if (flag == DrfPrm)
                  may_mod |= maybe_var[j];
               if (n->n_field[FrstArg + j].n_ptr->reuse && may_mod) {
                  /*
                   * The parameter may be reused without recomputing
                   *  the argument and the value may be modified. The
                   *  argument result location and the parameter location
                   *  must be separate so the parameter is reloaded upon
                   *  each invocation.
                   */
                  arg_rslt = chk_alc(NULL,
                     n->n_field[FrstArg + j].n_ptr->lifetime);
                  if (flag == DrfPrm && maybe_var[j])
                     symtab[i].adjust = AdjNDrf;  /* var: must dereference */
                  else
                     symtab[i].adjust = AdjCpy;   /* value only: just copy */
                  }
               else {
                  /*
                   * Argument result location will act as parameter location.
                   *  Its lifetime must be as long as both that of the
                   *  the argument and the parameter (operation internal
                   *  lifetime).
                   */
                  arg_rslt = chk_alc(NULL, max_lftm(n->intrnl_lftm,
                     n->n_field[FrstArg + j].n_ptr->lifetime));
                  if (flag == DrfPrm && maybe_var[j])
                     symtab[i].adjust = AdjDrf;   /* var: must dereference */
                  else
                     symtab[i].adjust = AdjNone;
                  }
               symtab[i].loc = arg_rslt;
               }
            }

         /*
          * Generate the code for the argument.
          */
         gencode(n->n_field[FrstArg + j].n_ptr, arg_rslt);

         if (flag == (RtParm | DrfPrm)) {
            /*
             * We have computed the value for the undereferenced parameter,
             *  decide how to get the dereferenced value.
             */
            ++i;
            if (symtab[i].n_refs + symtab[i].n_mods == 0)
               symtab[i].adjust = AdjNone;  /* not needed, ignore */
            else {
               if (single[j] != NULL) {
                  /*
                   * The value is in a specific Icon variable, get it from
                   *  there. If is is safe to pass the variable directly
                   *  to the operation, do so.
                   */
                  symtab[i].loc = var_ref(single[j]);
                  if (symtab[i].var_safe)
                     symtab[i].adjust = AdjNone;
                  else
                     symtab[i].adjust = AdjCpy;
                  }
               else {
                  /*
                   * If there might be a variable reference, note that it
                   *  must be dereferenced. Otherwise decide whether the
                   *  argument location can be used for both the dereferenced
                   *  and undereferenced parameter.
                   */
                  symtab[i].loc = arg_rslt;
                  if (maybe_var[j])
                     symtab[i].adjust = AdjNDrf;
                  else if (symtab[i - 1].n_mods + symtab[i].n_mods == 0)
                     symtab[i].adjust = AdjNone;
                  else
                     symtab[i].adjust = AdjCpy;
                  }
               }
            }
         ++i;
         }

      /*
       * Fill out parameter list with null values.
       */
      while (j < nparms) {
         int k, kn;
         kn = 0;
         if (impl->arg_flgs[j] & RtParm)
            ++kn;
         if (impl->arg_flgs[j] & DrfPrm)
            ++kn;
         for (k = 0; k < kn; ++k) {
            if (symtab[i].n_refs + symtab[i].n_mods > 0) {
               arg_rslt = chk_alc(NULL, n->intrnl_lftm);
               cd_add(asgn_null(arg_rslt));
               symtab[i].loc = arg_rslt;
               }
            symtab[i].adjust = AdjNone;
            ++i;
            }
         ++j;
         }

      if (var_args) {
         /*
          * Compute variable part of argument list.
          */
         ++nparms;   /* add varargs parameter back into parameter list  */

         /*
          * The variable part of the parameter list must be in contiguous
          *  descriptors. Create location and lifetime arrays for use in
          *  allocating the descriptors.
          */
         if (n_varargs > 0) {
            varg_rslt = (struct val_loc **)alloc((unsigned int)(n_varargs *
               sizeof(struct val_loc *)));
            lifetm_ary = alc_lftm(n_varargs, NULL);
            }

         flag = impl->arg_flgs[j] & (RtParm | DrfPrm);

         /*
          * Compute the lifetime of the elements of the varargs parameter array.
          */
         for (v = 0; v < n_varargs; ++v) {
            /*
             * Use information from type inferencing to determine if the
             *  argument might me a variable and whether it is a single
             *  known named variable.
             */
            maybe_var[j + v] = HasVar(varsubtyp(
               n->n_field[FrstArg+j+v].n_ptr->type, &(single[j + v])));

            /*
             * Determine if the elements of the vararg parameter array
             *  might be modified. If it is a variable, dereferencing
             *  modifies it.
             */
            may_mod = (symtab[j].n_mods != 0);
            if (flag == DrfPrm)
               may_mod |= maybe_var[j + v];

            if ((flag == DrfPrm && single[j + v] != NULL) ||
               (n->n_field[FrstArg + j + v].n_ptr->reuse && may_mod)) {
               /*
                * The argument value is only placed in the vararg parameter
                *  array during "dereferencing". So the lifetime of the array
                *  element is the lifetime of the parameter and the element
                *  is not used until dereferencing.
                */
               lifetm_ary[v].lifetime = n->intrnl_lftm;
               lifetm_ary[v].cur_status = n->postn;
               }
            else {
               /*
                * The argument is computed into the vararg parameter array.
                *  The lifetime of the array element encompasses both
                *  the lifetime of the argument and the parameter. The
                *  element is used as soon as the argument is computed.
                */
               lifetm_ary[v].lifetime = max_lftm(n->intrnl_lftm,
                   n->n_field[FrstArg+j+v].n_ptr->lifetime);
               lifetm_ary[v].cur_status = n->n_field[FrstArg+j+v].n_ptr->postn;
               }
            }

         /*
          * Allocate (reserve) the array of temporary variables for the
          *  vararg list.
          */
         if (n_varargs > 0) {
            arg_loc = alc_tmp(n_varargs, lifetm_ary);
            free((char *)lifetm_ary);
            }

         /*
          * Generate code to compute arguments.
          */
         for (v = 0; v < n_varargs; ++v) {
            may_mod = (symtab[j].n_mods != 0);
            if (flag == DrfPrm)
               may_mod |= maybe_var[j + v];
            if (flag == DrfPrm && single[j + v] != NULL) {
              /*
               * We need a dereferenced value and it is in a known place: a
               *  named variable; don't bother saving the result of the
               *  argument computation.
               */
               r = &ignore;
               }
            else if (n->n_field[FrstArg + j + v].n_ptr->reuse && may_mod) {
               /*
                * The argument can be reused without being recomputed and
                *  the parameter may be modified, so we cannot safely
                *  compute the argument into the vararg parameter array; we
                *  must compute it elsewhere and copy (dereference) it at the
                *  beginning of the operation. Let gencode allocate an argument
                *  result location.
                */
               r = NULL;
               }
            else {
               /*
                * We can compute the argument directly into the vararg
                *  parameter array.
                */
               r = tmp_loc(arg_loc + v);
               }
            varg_rslt[v] = gencode(n->n_field[FrstArg + j + v].n_ptr, r);
            }

         setloc(n);
         /*
          * Dereference or copy argument values that are not already in vararg
          *  parameter list. Preceding arguments are dereferenced later, but
          *  it is okay if dereferencing is out-of-order.
          */
         for (v = 0; v < n_varargs; ++v) {
            if (flag == DrfPrm && single[j + v] != NULL) {
               /*
                * Copy the value from the known named variable into the
                *  parameter list.
                */
               varg_rslt[v] = var_ref(single[j + v]);
               cd_add(mk_cpyval(tmp_loc(arg_loc + v), varg_rslt[v]));
               }
            else if (flag == DrfPrm && maybe_var[j + v]) {
               /*
                * Dereference the argument into the parameter list.
                */
               deref_cd(varg_rslt[v], tmp_loc(arg_loc + v));
               }
            else if (arg_loc + v != varg_rslt[v]->u.tmp) {
               /*
                * The argument is a dereferenced value, but is not yet
                *  in the parameter list; copy it there.
                */
               cd_add(mk_cpyval(tmp_loc(arg_loc + v), varg_rslt[v]));
               }
            tmp_status[arg_loc + v] = InUse; /* parameter location in use */
            }

         /*
          * The vararg parameter gets the address of the first element
          *  in the variable part of the argument list and the size
          *  parameter gets the number of elements in the list.
          */
         if (n_varargs > 0) {
            free((char *)varg_rslt);
            symtab[i].loc = tmp_loc(arg_loc);
            }
         else
            symtab[i].loc = chk_alc(NULL, n); /* dummy arg location */
         symtab[i].loc->mod_access = M_Addr;
         ++i;
         symtab[i].loc = vararg_sz(n_varargs);
         ++i;
         }
      else {
         /*
          * Compute extra arguments, but discard the results.
          */
         while (j < nargs) {
            gencode(n->n_field[FrstArg + j].n_ptr, &ignore);
            ++j;
            }
         }

      if (nargs > 0) {
         free((char *)maybe_var);
         free((char *)single);
         }

      /*
       * If execution does not continue through the parameter evaluation,
       *  don't try to generate in-line code. A lack of parameter types
       *  will cause problems with some in-line type conversions.
       */
      if (!past_prms(n))
         return rslt;

      setloc(n);

      dcl_var = i;

      /*
       * Perform any needed copying or dereferencing.
       */
      for (i = 0; i < nsyms; ++i) {
         switch (symtab[i].adjust) {
            case AdjNDrf:
               /*
                * Dereference into a new temporary which is used as the
                *  parameter.
                */
               arg_rslt = chk_alc(NULL, n->intrnl_lftm);
               deref_cd(symtab[i].loc, arg_rslt);
               symtab[i].loc = arg_rslt;
               break;
            case AdjDrf:
               /*
                * Dereference in place.
                */
               deref_cd(symtab[i].loc, symtab[i].loc);
               break;
           case AdjCpy:
               /*
                * Copy into a new temporary which is used as the
                *  parameter.
                */
              arg_rslt = chk_alc(NULL, n->intrnl_lftm);
              cd_add(mk_cpyval(arg_rslt, symtab[i].loc));
              symtab[i].loc = arg_rslt;
              break;
           case AdjNone:
              break;     /* nothing need be done */
            }
         }

      switch (cont_loc) {
         case SepFnc:
            /*
             * success continuation must be in a separate function.
             */
            fnc = alc_fnc();
            sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
            sprintf(sbuf, "end %s", impl->name);
            scont_strt = alc_lbl(sbuf, 0);
            cd_add(scont_strt);
            cur_fnc->cursor = scont_strt->prev; /* put oper before label */
            gen_inlin(impl->in_line, rslt, &scont_strt, NULL, fnc, impl,
               nsyms, symtab, n, dcl_var, n_varargs);
            cur_fnc->cursor = scont_strt;
            callc_add(fnc);
            cur_fnc = fnc;
            on_failure = &resume;
            break;
         case SContIL:
            /*
             * one suspend an no return: success continuation is put in-line.
             */
            gen_inlin(impl->in_line, rslt, &scont_strt, &scont_fail, NULL, impl,
                nsyms, symtab, n, dcl_var, n_varargs);
            cur_fnc->cursor = scont_strt;
            on_failure = scont_fail;
            break;
         case EndOper:
            /*
             * no suspends: success continuation goes at end of operation.
             */

            sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
            sprintf(sbuf, "end %s", impl->name);
            scont_strt = alc_lbl(sbuf, 0);
            cd_add(scont_strt);
            cur_fnc->cursor = scont_strt->prev; /* put operation before lbl */
            gen_inlin(impl->in_line, rslt, &scont_strt, NULL, NULL, impl,
               nsyms, symtab, n, dcl_var, n_varargs);
            cur_fnc->cursor = scont_strt;
            break;
         }
      }
   else {
      /*
       * Do not in-line operation.
       */
      implproto(impl);
      frst_arg = gen_args(n, 2, nargs);
      setloc(n);
      if (impl->ret_flag & (DoesRet | DoesSusp))
         rslt = chk_alc(rslt, rslt_lftm);
      mk_callop(oper_name(impl), impl->ret_flag, frst_arg, nargs, rslt,
         0);
      }
   if (symtab != NULL)
      free((char *)symtab);
   return rslt;
   }

/*
 * max_lftm - given two lifetimes (in the form of nodes) return the
 *   maximum one.
 */
static nodeptr max_lftm(n1, n2)
nodeptr n1;
nodeptr n2;
   {
   if (n1 == NULL)
      return n2;
   else if (n2 == NULL)
      return n1;
   else if (n1->postn > n2->postn)
      return n1;
   else
      return n2;
   }

/*
 * inv_prc - directly invoke a procedure.
 */
static struct val_loc *inv_prc(n, rslt)
nodeptr n;
struct val_loc *rslt;
   {
   struct pentry *proc;
   struct val_loc *r;
   struct val_loc *arg1rslt;
   struct val_loc *var_part;
   int *must_deref;
   struct lentry **single;
   struct val_loc **arg_rslt;
   struct code *cd;
   struct tmplftm *lifetm_ary;
   char *sbuf;
   int nargs;
   int nparms;
   int i, j;
   int arg_loc;
   int var_sz;
   int var_loc;

   /*
    * This procedure is implemented without argument list adjustment or
    *  dereferencing, so they must be done before the call.
    */
   nargs = Val0(n);              /* number of arguments */
   proc = Proc1(n);
   nparms = Abs(proc->nargs);

   if (nparms > 0) {
      must_deref = (int *)alloc((unsigned int)(nparms * sizeof(int)));
      single = (struct lentry **)alloc((unsigned int)(nparms *
         sizeof(struct lentry *)));
      arg_rslt = (struct val_loc **)alloc((unsigned int)(nparms *
         sizeof(struct val_loc *)));
      }

   /*
    * Allocate a work area of temporaries to use as argument list. If
    *  an argument can be reused without being recomputed, it must not
    *  be computed directly into the work area. It will be copied or
    *  dereferenced into the work area when execution reaches the
    *  operation. If an argument is a single named variable, it can
    *  be dereferenced directly into the argument location. These
    *  conditions affect when the temporary will receive a value.
    */
   if (nparms > 0)
      lifetm_ary = alc_lftm(nparms, NULL);
   for (i = 0; i < nparms; ++i)
      lifetm_ary[i].lifetime = n->intrnl_lftm;
   for (i = 0; i < nparms && i < nargs; ++i) {
      must_deref[i] = HasVar(varsubtyp(n->n_field[FrstArg + i].n_ptr->type,
         &(single[i])));
      if (single[i] != NULL || n->n_field[FrstArg + i].n_ptr->reuse)
         lifetm_ary[i].cur_status = n->postn;
      else
         lifetm_ary[i].cur_status = n->n_field[FrstArg + i].n_ptr->postn;
      }
   while (i < nparms) {
      lifetm_ary[i].cur_status = n->postn; /* arg list extension */
      ++i;
      }
   if (proc->nargs < 0)
      lifetm_ary[nparms - 1].cur_status = n->postn;  /* variable part */

   if (nparms > 0) {
      arg_loc = alc_tmp(nparms, lifetm_ary);
      free((char *)lifetm_ary);
      }
   if (proc->nargs < 0)
      --nparms;     /* treat variable part specially */
   for (i = 0; i < nparms && i < nargs;  ++i) {
      if (single[i] != NULL)
         r = &ignore;   /* we know where the dereferenced value is */
      else if (n->n_field[FrstArg + i].n_ptr->reuse)
         r = NULL;      /* let gencode allocate a new temporary */
      else
         r = tmp_loc(arg_loc + i);
      arg_rslt[i] = gencode(n->n_field[FrstArg + i].n_ptr, r);
      }

   /*
    * If necessary, fill out argument list with nulls.
    */
   while (i < nparms) {
      cd_add(asgn_null(tmp_loc(arg_loc + i)));
      tmp_status[arg_loc + i] = InUse;
      ++i;
      }

   if (proc->nargs < 0) {
      /*
       * handle variable part of list.
       */
      var_sz = nargs - nparms;

      if (var_sz > 0) {
         lifetm_ary = alc_lftm(var_sz, &n->n_field[FrstArg + nparms]);
         var_loc = alc_tmp(var_sz, lifetm_ary);
         free((char *)lifetm_ary);
         for (j = 0; j < var_sz; ++j)
            gencode(n->n_field[FrstArg + nparms + j].n_ptr,
               tmp_loc(var_loc + j));
         }
      }
   else {
      /*
       * If there are extra arguments, compute them, but discard the
       *  results.
       */
      while (i < nargs) {
         gencode(n->n_field[FrstArg + i].n_ptr, &ignore);
         ++i;
         }
      }

   setloc(n);
   /*
    * Dereference or copy argument values that are not already in argument
    *  list as dereferenced values.
    */
   for (i = 0; i < nparms && i < nargs;  ++i) {
      if (must_deref[i]) {
         if (single[i] == NULL)
            deref_cd(arg_rslt[i], tmp_loc(arg_loc + i));
         else {
            arg_rslt[i] = var_ref(single[i]);
            cd_add(mk_cpyval(tmp_loc(arg_loc + i), arg_rslt[i]));
            }
         }
      else if (n->n_field[FrstArg + i].n_ptr->reuse)
         cd_add(mk_cpyval(tmp_loc(arg_loc + i), arg_rslt[i]));
      tmp_status[arg_loc + i] = InUse;
      }

   if (proc->nargs < 0) {
      var_part = tmp_loc(arg_loc + nparms);
      tmp_status[arg_loc + nparms] = InUse;
      if (var_sz <= 0) {
         cd = alc_ary(3);
         cd->ElemTyp(0) = A_Str;
         cd->Str(0) =                 "varargs(NULL, 0, &";
         cd->ElemTyp(1) = A_ValLoc;
         cd->ValLoc(1) =               var_part;
         cd->ElemTyp(2) = A_Str;
         cd->Str(2) =                 ");";
         }
      else {
         cd = alc_ary(7);
         cd->ElemTyp(0) = A_Str;
         cd->Str(0) =                 "varargs(&";
         cd->ElemTyp(1) = A_ValLoc;
         cd->ValLoc(1) =               tmp_loc(var_loc);
         cd->ElemTyp(2) = A_Str;
         cd->Str(2) =                  ", ";
         cd->ElemTyp(3) = A_Intgr;
         cd->Intgr(3) =               var_sz;
         cd->ElemTyp(4) = A_Str;
         cd->Str(4) =                 ", &";
         cd->ElemTyp(5) = A_ValLoc;
         cd->ValLoc(5) =               var_part;
         cd->ElemTyp(6) = A_Str;
         cd->Str(6) =                 ");";
         }
      cd_add(cd);
      ++nparms;   /* include variable part in call */
      }

   if (nparms > 0) {
      free((char *)must_deref);
      free((char *)single);
      free((char *)arg_rslt);
      }

   sbuf = (char *)alloc((unsigned int)(strlen(proc->name) + PrfxSz + 3));
   sprintf(sbuf, "P%s_%s", proc->prefix, proc->name);
   if (nparms > 0)
      arg1rslt = tmp_loc(arg_loc);
   else
      arg1rslt = NULL;
   if (proc->ret_flag & (DoesRet | DoesSusp))
      rslt = chk_alc(rslt, n->lifetime);
   mk_callop(sbuf, proc->ret_flag, arg1rslt, nargs, rslt, 1);
   return rslt;
   }

/*
 * endlife - link a temporary variable onto the list to be freed when
 *  execution reaches a node.
 */
static novalue endlife(kind, indx, old, n)
int kind;
int indx;
int old;
nodeptr n;
   {
   struct freetmp *freetmp;

   if ((freetmp = freetmp_pool) == NULL)
     freetmp = NewStruct(freetmp);
   else
      freetmp_pool = freetmp_pool->next;
   freetmp->kind = kind;
   freetmp->indx = indx;
   freetmp->old = old;
   freetmp->next = n->freetmp;
   n->freetmp = freetmp;
   }

/*
 * alc_tmp - allocate a block of temporary variables with the given lifetimes.
 */
static int alc_tmp(num, lifetm_ary)
int num;
struct tmplftm *lifetm_ary;
   {
   int i, j, k;
   register int status;
   int *new_status;
   int new_size;

   i = 0;
   for (;;) {
      if (i + num > status_sz) {
         /*
          * The status array is too small, expand it.
          */
         new_size = status_sz + Max(num, status_sz);
         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
         k = 0;
         while (k < status_sz) {
            new_status[k] = tmp_status[k];
            ++k;
            }
         while (k < new_size) {
            new_status[k] = NotAlloc;
            ++k;
            }
         free((char *)tmp_status);
         tmp_status = new_status;
         status_sz = new_size;
         }
      for (j = 0; j < num; ++j) {
         status = tmp_status[i + j];
         if (status != NotAlloc &&
            (status == InUse || status <= lifetm_ary[j].lifetime->postn))
               break;
         }
      /*
       * Did we find a block of temporaries that we can use?
       */
      if (j == num) {
         while (--j >= 0) {
            endlife(DescTmp, i + j, tmp_status[i + j], lifetm_ary[j].lifetime);
            tmp_status[i + j] = lifetm_ary[j].cur_status;
            }
         if (i + num > num_tmp)
            num_tmp = i + num;
         return i;
         }
      ++i;
      }
   }

/*
 * alc_lftm - allocate an array of lifetime information for an argument
 *  list.
 */
static struct tmplftm *alc_lftm(num, args)
int num;
union field *args;
   {
   struct tmplftm *lifetm_ary;
   int i;

   lifetm_ary = (struct tmplftm *)alloc((unsigned int)(num *
      sizeof(struct tmplftm)));
   if (args != NULL)
     for (i = 0; i < num; ++i) {
        lifetm_ary[i].cur_status = args[i].n_ptr->postn; /* reserved for arg */
        lifetm_ary[i].lifetime = args[i].n_ptr->lifetime;
        }
   return lifetm_ary;
   }

/*
 * alc_itmp - allocate a temporary C integer variable.
 */
int alc_itmp(lifetime)
nodeptr lifetime;
   {
   int i, j;
   int new_size;

   i = 0;
   while (i < istatus_sz && itmp_status[i] == InUse)
      ++i;
   if (i >= istatus_sz) {
      /*
       * The status array is too small, expand it.
       */
      free((char *)itmp_status);
      new_size = istatus_sz * 2;
      itmp_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
      j = 0;
      while (j < istatus_sz)
         itmp_status[j++] = InUse;
      while (j < new_size)
         itmp_status[j++] = NotAlloc;
      istatus_sz = new_size;
      }
   endlife(CIntTmp, i, NotAlloc, lifetime);
   itmp_status[i] = InUse;
   if (num_itmp < i + 1)
     num_itmp = i + 1;
   return i;
   }

/*
 * alc_dtmp - allocate a temporary C integer variable.
 */
int alc_dtmp(lifetime)
nodeptr lifetime;
   {
   int i, j;
   int new_size;

   i = 0;
   while (i < dstatus_sz && dtmp_status[i] == InUse)
      ++i;
   if (i >= dstatus_sz) {
      /*
       * The status array is too small, expand it.
       */
      free((char *)dtmp_status);
      new_size = dstatus_sz * 2;
      dtmp_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
      j = 0;
      while (j < dstatus_sz)
         dtmp_status[j++] = InUse;
      while (j < new_size)
         dtmp_status[j++] = NotAlloc;
      dstatus_sz = new_size;
      }
   endlife(CDblTmp, i, NotAlloc, lifetime);
   dtmp_status[i] = InUse;
   if (num_dtmp < i + 1)
     num_dtmp = i + 1;
   return i;
   }

/*
 * alc_sbufs - allocate a block of string buffers with the given lifetime.
 */
int alc_sbufs(num, lifetime)
int num;
nodeptr lifetime;
   {
   int i, j, k;
   int *new_status;
   int new_size;

   i = 0;
   for (;;) {
      if (i + num > sstatus_sz) {
         /*
          * The status array is too small, expand it.
          */
         new_size = sstatus_sz + Max(num, sstatus_sz);
         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
         k = 0;
         while (k < sstatus_sz) {
            new_status[k] = sbuf_status[k];
            ++k;
            }
         while (k < new_size) {
            new_status[k] = NotAlloc;
            ++k;
            }
         free((char *)sbuf_status);
         sbuf_status = new_status;
         sstatus_sz = new_size;
         }
      for (j = 0; j < num && sbuf_status[i + j] == NotAlloc; ++j)
         ;
      /*
       * Did we find a block of buffers that we can use?
       */
      if (j == num) {
         while (--j >= 0) {
            endlife(SBuf, i + j, sbuf_status[i + j], lifetime);
            sbuf_status[i + j] = InUse;
            }
         if (i + num > num_sbuf)
            num_sbuf = i + num;
         return i;
         }
      ++i;
      }
   }

/*
 * alc_cbufs - allocate a block of cset buffers with the given lifetime.
 */
int alc_cbufs(num, lifetime)
int num;
nodeptr lifetime;
   {
   int i, j, k;
   int *new_status;
   int new_size;

   i = 0;
   for (;;) {
      if (i + num > cstatus_sz) {
         /*
          * The status array is too small, expand it.
          */
         new_size = cstatus_sz + Max(num, cstatus_sz);
         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
         k = 0;
         while (k < cstatus_sz) {
            new_status[k] = cbuf_status[k];
            ++k;
            }
         while (k < new_size) {
            new_status[k] = NotAlloc;
            ++k;
            }
         free((char *)cbuf_status);
         cbuf_status = new_status;
         cstatus_sz = new_size;
         }
      for (j = 0; j < num && cbuf_status[i + j] == NotAlloc; ++j)
         ;
      /*
       * Did we find a block of buffers that we can use?
       */
      if (j == num) {
         while (--j >= 0) {
            endlife(CBuf, i + j, cbuf_status[i + j], lifetime);
            cbuf_status[i + j] = InUse;
            }
         if (i + num > num_cbuf)
            num_cbuf = i + num;
         return i;
         }
      ++i;
      }
   }