Initial upstream version 9.4.3upstream/9.4.3

28 files changed, 23362 insertions, 0 deletions

diff --git a/src/iconc/Makefile b/src/iconc/Makefile
new file mode 100644
index 0000000..bce6aa8
--- /dev/null
+++ b/src/iconc/Makefile
@@ -0,0 +1,73 @@
+#  Makefile for the Icon compiler, iconc.
+#
+#  This is no longer supported and may not work.
+
+include ../../Makedefs
+
+
+OBJS =		cmain.o ctrans.o dbase.o clex.o\
+		cparse.o csym.o cmem.o ctree.o ccode.o ccomp.o\
+                ivalues.o codegen.o fixcode.o inline.o chkinv.o\
+		typinfer.o types.o lifetime.o incheck.o
+
+COBJS =		../common/long.o ../common/getopt.o ../common/time.o\
+		  ../common/filepart.o ../common/identify.o ../common/munix.o\
+		  ../common/strtbl.o ../common/rtdb.o ../common/literals.o \
+		  ../common/alloc.o ../common/ipp.o
+
+
+
+iconc:		$(OBJS) $(COBJS)
+		$(CC) -o iconc $(OBJS) $(COBJS)
+		cp iconc ../../bin
+		strip ../../bin/iconc$(EXE)
+
+$(OBJS):	../h/config.h ../h/cpuconf.h ../h/cstructs.h ../h/define.h\
+		../h/mproto.h ../h/typedefs.h ../h/gsupport.h \
+		ccode.h cglobals.h cproto.h csym.h ctrans.h ctree.h
+
+$(COBJS):	../h/mproto.h
+		cd ../common; $(MAKE); $(MAKE) xpm
+
+ccode.o:	../h/lexdef.h ctoken.h
+chkinv.o:	ctoken.h
+clex.o:		../h/lexdef.h ../h/parserr.h ctoken.h \
+		   ../common/lextab.h ../common/yylex.h ../common/error.h
+clocal.o:	../h/config.h
+cparse.o:	../h/lexdef.h
+ctrans.o:	ctoken.h
+ctree.o:	../h/lexdef.h ctoken.h
+csym.o:		ctoken.h
+dbase.o:	../h/lexdef.h
+lifetime.o:	../h/lexdef.h ctoken.h
+typinfer.o:	../h/lexdef.h ctoken.h
+types.o:	../h/lexdef.h ctoken.h
+
+
+
+#  The following sections are commented out because they do not need to
+#  be performed unless changes are made to cgrammar.c, ../h/grammar.h,
+#  ../common/tokens.txt, or ../common/op.txt.  Such changes involve
+#  modifications to the syntax of Icon and are not part of the installation
+#  process. However, if the distribution files are unloaded in a fashion
+#  such that their dates are not set properly, the following sections would
+#  be attempted.
+#
+#  Note that if any changes are made to the files mentioned above, the comment
+#  characters at the beginning of the following lines should be removed.
+#  icont must be on your search path for these actions to work.
+#
+#../common/lextab.h ../common/yacctok.h ../common/fixgram ../common/pscript: \
+#			../common/tokens.txt ../common/op.txt
+#		cd ../common; $(MAKE) gfiles
+#
+#cparse.c ctoken.h:	cgram.g ../common/pscript
+## expect 218 shift/reduce conflicts
+#		yacc -d cgram.g
+#		../common/pscript <y.tab.c >cparse.c
+#		mv y.tab.h ctoken.h
+#		rm -f y.tab.c
+#
+#cgram.g:	cgrammar.c ../h/define.h ../h/grammar.h \
+#			../common/yacctok.h ../common/fixgram
+#		$(CC) -E -C cgrammar.c | ../common/fixgram >cgram.g
diff --git a/src/iconc/ccode.c b/src/iconc/ccode.c
new file mode 100644
index 0000000..108cd15
--- /dev/null
+++ b/src/iconc/ccode.c
@@ -0,0 +1,4954 @@
+/*
+ * 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"
+
+#ifdef OptimizeLit
+
+#define NO_LIMIT       0
+#define LIMITED        1
+#define LIMITED_TO_INT 2
+#define NO_TOUCH       3
+
+struct lit_tbl {
+   int    modified;
+   int    index;
+   int    safe;
+   struct code    *initial;
+   struct code    *end;
+   struct val_loc *vloc;
+   struct centry  *csym; 
+   struct lit_tbl *prev;
+   struct lit_tbl *next;
+};
+#endif					/* OptimizeLit */
+
+/*
+ * Prototypes for static functions.
+ */
+static struct c_fnc *alc_fnc	(void);
+static struct tmplftm *alc_lftm	(int num, union field *args);
+static int alc_tmp 		(int n, struct tmplftm *lifetm_ary);
+
+#ifdef	OptimizePoll
+   static int analyze_poll 	(void);
+   static void remove_poll 	(void);
+#endif					/* OptimizePoll */
+
+#ifdef	OptimizeLit
+   static int instr		(const	char *str, int chr);
+   static void invalidate	(struct val_loc *val,struct code *end,int code);
+   static void analyze_literals	(struct code *start, struct code *top, int lvl);
+   static int eval_code		(struct code *cd, struct lit_tbl *cur);
+   static void propagate_literals (void);
+   static void free_tbl		(void);
+   static struct lit_tbl *alc_tbl (void);
+   static void tbl_add		(truct lit_tbl *add);
+#endif					/* OptimizeLit */
+
+static struct code *asgn_null	(struct val_loc *loc1);
+static struct val_loc *bound	(struct node *n, struct val_loc *rslt,
+				   int catch_fail);
+static struct code *check_var	(struct val_loc *d, struct code *lbl);
+static void deref_cd		(struct val_loc *src, struct val_loc *dest);
+static void deref_ret		(struct val_loc *src, struct val_loc *dest,
+				   int subtypes);
+static void endlife		(int	kind, int indx, int old, nodeptr n);
+static struct val_loc *field_ref(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_act	(nodeptr n, struct val_loc *rslt);
+static struct val_loc *gen_apply(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_args	(struct node *n, int frst_arg, int nargs);
+static struct val_loc *gen_case	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_creat(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_lim	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_scan	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gencode	(struct node *n, struct val_loc *rslt);
+static struct val_loc *genretval(struct node *n, struct node *expr,
+				   struct val_loc *dest);
+static struct val_loc *inv_prc	(nodeptr n, struct val_loc *rslt);
+static struct val_loc *inv_op	(nodeptr n, struct val_loc *rslt);
+static nodeptr max_lftm		(nodeptr	n1, nodeptr n2);
+static void mk_callop		(char *oper_nm, int ret_flag,
+				   struct val_loc *arg1rslt, int nargs,
+				   struct val_loc *rslt, int optim);
+static struct code *mk_cpyval	(struct val_loc *loc1, struct val_loc *loc2);
+static struct code *new_call	(void);
+static char *oper_name		(struct implement *impl);
+static void restr_env	(struct val_loc *sub_sav, struct val_loc *pos_sav);
+static void save_env	(struct val_loc *sub_sav, struct val_loc *pos_sav);
+static void setloc		(nodeptr	n);
+static struct val_loc *tmp_loc	(int n);
+static struct val_loc *var_ref	(struct lentry *sym);
+static struct val_loc *vararg_sz(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 */
+
+#ifdef OptimizePoll
+static struct code *lastpoll;
+#endif					/* OptimizePoll */
+
+#ifdef OptimizeLit
+static struct lit_tbl *tbl = NULL;
+static struct lit_tbl *free_lit_tbl = NULL;
+#endif					/* OptimizeLit */
+
+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 */
+
+#ifdef OptimizeLit
+static void print_tbl(struct lit_tbl *start)  {
+   struct lit_tbl *ptr;
+   
+   for (ptr=start; ptr != NULL ;ptr=ptr->next)  {
+      printf("mod (%2d) strchr (%2d) ",ptr->modified,ptr->index);
+      if (ptr->csym != NULL)  {
+         printf("image (%13s) ",ptr->csym->image);
+      }
+      if (ptr->vloc != NULL)  {
+         printf("val (%6d) type (%d)",ptr->vloc->u.tmp,ptr->vloc->loc_type); 
+      }
+      if (ptr->end == NULL)
+         printf(" END IS NULL");
+      printf("\n");
+   }
+}
+
+
+static void free_tbl()  {
+/*
+   struct lit_tbl *ptr, *next;
+*/
+   free_lit_tbl = tbl;
+   tbl = NULL;
+/*
+   ptr = tbl;
+   while (ptr != NULL)  {
+      next = ptr->next;
+      free(ptr);
+      ptr = next;
+   }
+   tbl = NULL;
+*/
+}
+
+
+static struct lit_tbl *alc_tbl()  {
+   struct lit_tbl *new; 
+   static int cnt=0;
+
+
+   if (free_lit_tbl != NULL)  {
+      new = free_lit_tbl;
+      free_lit_tbl = new->next;
+   }
+   else
+      new = (struct lit_tbl *)alloc(sizeof(struct lit_tbl));
+   new->modified = NO_LIMIT;
+   new->index = -1;
+   new->safe = 1;
+   new->initial = NULL;
+   new->end  = NULL;
+   new->vloc = NULL;
+   new->csym = NULL;
+   new->prev = NULL;
+   new->next = NULL;
+   return new;
+}
+#endif					/* OptimizeLit */
+
+/*
+ * proccode - generate code for a procedure.
+ */
+void 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;
+#ifdef OptimizeLit
+   struct code *procstart;
+#endif					/* OptimizeLit */
+
+   /*
+    * 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 */
+
+#ifdef OptimizePoll
+   lastpoll = NULL;
+#endif					/* OptimizePoll */
+
+   /*
+    * 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();
+
+#ifdef OptimizeLit
+   procstart = cur_fnc->cursor;
+#endif					/* OptimizeLit */
+
+   /*
+    * 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);
+
+#ifdef OptimizeLit
+    analyze_literals(procstart, NULL, 0);
+    propagate_literals();
+#endif					/* OptimizeLit */
+
+   /*
+    * 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);
+#ifdef OptimizeLit
+   free_tbl();
+#endif					/* OptimizeLit */
+}
+
+/*
+ * 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(EXIT_FAILURE);
+      }
+
+   /*
+    * 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 void 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 void 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 void 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 void 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 *)glbl_argp, (word *)(glbl_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.
+ */
+void 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.
+ */
+void 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.
+ */
+void 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;
+   }
+
+
+#ifdef OptimizeLit
+static int instr(const char *str, int chr)  {
+   int i, found, go;
+
+   found = 0; go = 1;
+   for(i=0; ((str[i] != '\0') && go) ;i++) {
+      if (str[i] == chr) {
+         go = 0;
+         found = 1;
+         if ((str[i+1] != '\0') && (chr == '='))
+            if (str[i+1] == '=')
+               found = 0;
+         if ((chr == '=') && (i > 0))  {
+            if (str[i-1] == '>')
+               found = 0;
+            else if (str[i-1] == '<')
+               found = 0;
+            else if (str[i-1] == '!')
+               found = 0;
+         }
+      }
+   }
+   return found;
+}
+
+static void tbl_add(struct lit_tbl *add)  {
+   struct lit_tbl *ins;
+   static struct lit_tbl *ptr = NULL;
+   int    go = 1;
+
+   if (tbl == NULL) {
+      tbl = add;
+      ptr = add;
+   }
+   else  {
+      ins = ptr;
+      while ((ins != NULL) && go)  {
+         if (add->index != ins->index)
+            ins = ins->prev;
+         else
+            go = 0;
+      }
+      if (ins != NULL) {
+         if (ins->end == NULL)
+            ins->end = add->initial;
+      }
+      ptr->next = add;
+      add->prev = ptr;
+      ptr = add;
+   }
+}
+
+
+static void invalidate(struct val_loc *val, struct code *end, int code)  {
+   struct lit_tbl  *ptr, *back;
+   int    index, go = 1;
+
+   if (val == NULL)
+      return;
+   if (val->loc_type == V_NamedVar) {
+      index = val->u.nvar->val.index;
+      return;
+   }
+   else if (val->loc_type == V_Temp)
+      index = val->u.tmp + cur_proc->tnd_loc;
+   else
+      return;
+   if (tbl == NULL)
+      return;
+   back = tbl;
+   while (back->next != NULL)
+      back = back->next;
+   go = 1;
+   for(ptr=back; ((ptr != NULL) && go) ; ptr=ptr->prev) {
+      if ((ptr->index == index) && (ptr->modified != NO_TOUCH)) {
+         ptr->modified = code; 
+         if ((code != LIMITED_TO_INT) && (ptr->safe)) {
+            ptr->end = end;
+            ptr->safe = 0;
+         }
+         go = 0;
+      }
+      else if ((ptr->index == index) && (ptr->modified == NO_TOUCH)) {
+         if ((code != LIMITED_TO_INT) && (ptr->safe)) {
+            ptr->end = end;
+            ptr->safe = 0;
+         }
+         go = 0;
+      }
+      else if (ptr->index == index)
+         go = 0;
+   }
+}
+
+
+static int eval_code(struct code *cd, struct lit_tbl *cur)  {
+   struct code *tmp;
+   struct lit_tbl *tmp_tbl;
+   int    i, j;
+   char  *str;
+
+   for (i=0; cd->ElemTyp(i) != A_End ;i++)  {
+      switch(cd->ElemTyp(i))  {
+         case A_ValLoc:
+            if (cd->ValLoc(i)->mod_access != M_CInt)
+               break;
+            if ((cd->ValLoc(i)->u.tmp + cur_proc->tnd_loc) == cur->index) {
+               switch (cd->ValLoc(i)->loc_type)  {
+                  case V_Temp:
+                     if (cur->csym->flag == F_StrLit)  {
+#if 0
+                        cd->ElemTyp(i) = A_Str;
+                        str = (char *)alloc(strlen(cur->csym->image)+8);
+			sprintf(str, "\"%s\"/*Z*/", cur->csym->image);
+                        cd->Str(i) = str;
+#endif
+                     }
+                     else if (cur->csym->flag == F_IntLit) {
+                        cd->ElemTyp(i) = A_Str;
+                        cd->Str(i) = cur->csym->image;
+                     }
+                     break;
+                  default:
+                     break;
+               }
+            }
+            break;
+         case A_Ary:
+            for(tmp=cd->Array(i); tmp != NULL ;tmp=tmp->next)
+               eval_code(tmp, cur);
+            break;
+         default:
+            break;
+      }
+   }
+}
+
+static void propagate_literals()  {
+   struct lit_tbl *ptr;
+   struct code    *cd, *arg;
+   int    ret;
+
+   for(ptr=tbl; ptr != NULL ;ptr=ptr->next)  {
+      if (ptr->modified != NO_TOUCH) {
+         for(cd=ptr->initial; cd != ptr->end ;cd=cd->next)  {
+            switch (cd->cd_id)  {
+               case C_If:
+                  for(arg=cd->Cond; arg != NULL ;arg=arg->next)
+                     ret = eval_code(arg, ptr);
+		  /*
+		   * Again, don't take the 'then' portion.
+		   * It might lead to infinite loops.
+		   *  for(arg=cd->ThenStmt; arg != NULL ;arg=arg->next)
+                   *      ret = eval_code(arg, ptr);
+		   */
+                  break; 
+               case C_CdAry:
+                  ret = eval_code(cd, ptr);
+                  break; 
+               case C_CallSig:
+                  for(arg=cd->ArgLst; arg != NULL ;arg=arg->next)
+                     ret = eval_code(arg, ptr);
+                  break; 
+               default:
+                  break; 
+            }
+         } 
+      }
+   }
+}
+
+/*
+ * analyze_literals - analyzes the generated code to replace
+ *                      complex record dereferences with  C
+ *                      literals.
+ */
+static void analyze_literals(struct code *start, struct code *top, int lvl)  {
+   struct code *ptr, *tmp, *not_null;
+   struct lit_tbl *new_tbl;
+   struct lbl_tbl *new_lbl;
+   struct val_loc *prev = NULL;
+   int i, inc=0, addr=0, assgn=0, equal = 0;
+
+   for (ptr = start; ptr != NULL ; ptr = ptr->next)  {
+      if (!lvl)
+         not_null = ptr;
+      else
+         not_null = top;
+      switch (ptr->cd_id)  {
+         case C_NamedVar:
+            break;
+         case C_CallSig:
+            analyze_literals(ptr->ArgLst, not_null, lvl+1);
+            break;
+         case C_Goto:
+            break;
+         case C_Label:
+            break;
+         case C_Lit:
+            new_tbl = alc_tbl();
+            new_tbl->initial = ptr;
+            new_tbl->vloc = ptr->Rslt;
+            new_tbl->csym = ptr->Literal;
+            switch (ptr->Rslt->loc_type) {
+               case V_NamedVar:
+                  new_tbl->index = ptr->Rslt->u.nvar->val.index;
+                  tbl_add(new_tbl);
+                  break;
+               case V_Temp:
+                  new_tbl->index = ptr->Rslt->u.tmp + cur_proc->tnd_loc;
+                  tbl_add(new_tbl);
+                  break;
+               default:
+                  new_tbl->index = -1;
+                  free(new_tbl);
+                  break;
+            }
+            break;
+         case C_If:
+            analyze_literals(ptr->Cond, not_null, lvl+1);
+	    /*
+	     *  Don't analyze the 'then' portion such as in:
+             *   analyze_literals(ptr->ThenStmt, not_null, lvl+1);
+	     *  Apparently, all the intermediate code does is maintain
+	     *   a pointer to where the flow of execution jumps to in
+	     *   case the 'then' is taken.  These are all goto statments
+	     *   and can result in infinite loops of analyzation.
+             */
+            break;
+         case C_CdAry:
+            for(i=0; ptr->ElemTyp(i) != A_End ;i++)  {
+               switch(ptr->ElemTyp(i))  {
+                  case A_Str:
+                     if (ptr->Str(i) != NULL) {
+			if ( (strstr(ptr->Str(i), "-=")) ||
+			     (strstr(ptr->Str(i), "+=")) ||
+			     (strstr(ptr->Str(i), "*=")) ||
+			     (strstr(ptr->Str(i), "/=")) )
+                           invalidate(prev, not_null, NO_TOUCH);
+                        else if (instr(ptr->Str(i), '=')) {
+                           invalidate(prev, not_null, LIMITED);
+                           assgn = 1;
+                        }
+                        else if ( (strstr(ptr->Str(i), "++")) ||
+				  (strstr(ptr->Str(i), "--")) )
+                           inc = 1;
+                        else if (instr(ptr->Str(i), '&'))
+                           addr = 1;
+                        else if (strstr(ptr->Str(i), "=="))
+                           equal = 1;
+                     }
+                     break;
+                  case A_ValLoc:
+                     if (inc) {
+                        invalidate(ptr->ValLoc(i), not_null, NO_TOUCH);
+                        inc = 0;
+                     }
+                     if (addr)  {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED);
+                        addr = 0;
+                     }
+                     if ((assgn) && (ptr->ValLoc(i)->mod_access == M_None)) {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED);
+                        assgn = 0;
+                     }
+                     else if (assgn)
+                        assgn = 0;
+                     if (equal) {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED_TO_INT);
+                        equal = 0;
+                     }
+                     prev = ptr->ValLoc(i);
+                     break;
+                  case A_Intgr:
+                     break;
+                  case A_SBuf:
+                     break;
+                  case A_Ary:
+                     for(tmp=ptr->Array(i); tmp != NULL ;tmp=tmp->next)
+                        analyze_literals(tmp, not_null, lvl+1);
+                     break;
+                  default:
+                     break;
+               }
+            }
+            break;
+         default:
+            break;
+      }
+   }
+}
+#endif					/* OptimizeLit */
+
+/*
+ * analyze_poll - analyzes the internal C code representation from
+ *                the position of the last Poll() function call to 
+ *                the current position in the code.
+ *                Returns a 0 if the last Poll() function should not
+ *                be removed.
+ */
+#ifdef OptimizePoll
+static int analyze_poll(void)  {
+   struct code *cursor, *ptr;
+   int          cont = 1;
+
+   ptr = lastpoll;
+   if (ptr == NULL)
+      return 0;
+   cursor = cur_fnc->cursor; 
+   while ((cursor != ptr) && (ptr != NULL) && (cont))  {
+      switch (ptr->cd_id)  {
+         case C_Null :
+         case C_NamedVar :
+         case C_Label    :
+         case C_Lit      :
+         case C_Resume   :
+         case C_Continue :
+         case C_FallThru :
+         case C_PFail    :
+         case C_Goto     :
+         case C_Create   :
+         case C_If       :
+         case C_SrcLoc   :
+         case C_CdAry    :
+                 break;
+         case C_CallSig  :
+         case C_RetSig   :
+         case C_LBrack   :
+         case C_RBrack   :
+         case C_PRet     :
+         case C_PSusp    :
+         case C_Break    :
+                 cont = 0;
+                 break;
+      }
+      ptr = ptr->next;
+   }
+   return cont;
+}
+
+/*
+ * remove_poll - removes the ccode structure that represents the last
+ *  call to the "Poll()" function by simply changing the code ID to
+ *  C_Null code.
+ */
+static void remove_poll(void)  {
+   
+   if (lastpoll == NULL)
+      return;
+   lastpoll->cd_id = C_Null;
+}
+#endif					/* OptimizePoll */
+
+/*
+ * 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 void setloc(n)
+nodeptr n;
+   {
+   struct code *cd;
+   static int   count=0;
+
+   if (n == NULL || File(n) == NULL || Line(n) == 0)
+      return;
+
+   if (File(n) != lastfiln || Line(n) != lastline) {
+#ifdef OptimizePoll
+      if (analyze_poll())
+         remove_poll();
+      cd = alc_ary(1);
+      lastpoll = cd;
+#else					/* OptimizePoll */
+      cd = alc_ary(1);
+#endif					/* OptimizePoll */
+      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;
+   static cnt=1;
+
+   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 void 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 void 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;
+      }
+   }
diff --git a/src/iconc/ccode.h b/src/iconc/ccode.h
new file mode 100644
index 0000000..2d0cb6f
--- /dev/null
+++ b/src/iconc/ccode.h
@@ -0,0 +1,252 @@
+/*
+ * ccode.h - definitions used in code generation.
+ */
+
+/*
+ * ChkPrefix - allocate a prefix to x if it has not already been done.
+ */
+#define ChkPrefix(x) if ((x)[0] == '\0') nxt_pre(x, pre, PrfxSz);
+
+/*
+ * sig_act - list of possible signals returned by a call and the action to be
+ *  to be taken when the signal is returned: in effect a switch statement.
+ */
+struct sig_act {
+   struct code *sig;         /* signal */
+   struct code *cd;          /* action to be taken: goto, return, break */
+   struct sig_act *shar_act; /* signals that share this action */
+   struct sig_act *next;
+   };
+
+/*
+ * val_loc - location of a value. Used for intermediate and final results
+ *   of expressions.
+ */
+#define V_NamedVar 1  /* Icon named variable indicated by nvar */
+#define V_Temp     2  /* temporary variable indicated by tmp */
+#define V_ITemp    3  /* C integer temporary variable indicated by tmp */
+#define V_DTemp    4  /* C double temporary variable indicated by tmp */
+#define V_PRslt    5  /* procedure result location */
+#define V_Const    6  /* integer constant - used for size of varargs */
+#define V_CVar     7  /* C named variable */
+#define V_Ignore   8  /* "trashcan" - a write-only location */
+
+#define M_None     0  /* access simply as descriptor */
+#define M_CharPtr  1  /* access v-word as "char *" */
+#define M_BlkPtr   2  /* access v-word as block pointer using blk_name */
+#define M_CInt     3  /* access v-word as C integer */
+#define M_Addr     4  /* address of descriptor for varargs */
+
+struct val_loc {
+   int loc_type;      /* manifest constants V_* */
+   int mod_access;    /* manifest constants M_* */
+   char *blk_name;    /* used with M_BlkPtr */
+   union {
+     struct lentry *nvar; /* Icon named variable */
+     int tmp;             /* index of temporary variable */
+     int int_const;       /* integer constant value */
+     char *name;          /* C named variable */
+     } u;
+   };
+
+/*
+ * "code" contains the information needed to print a piece of C code.
+ *  C_... manifest constants are cd_id's. These are followed by
+ *  corresponding field access expressions.
+ */
+#define Rslt        fld[0].vloc    /* place to put result of expression */
+#define Cont        fld[1].fnc	   /* continuation function or null */
+
+#define C_Null      0              /* no code */
+
+#define C_NamedVar  1		   /* reference to a named variable */
+/* uses Rslt */
+#define NamedVar    fld[1].nvar
+
+#define C_CallSig   2		   /* call and handling of returned signal */
+#define OperName    fld[0].oper_nm /* run-time routine name or null */
+/* uses Cont */
+#define Flags       fld[2].n       /* flag: NeedCont, ForeignSig */
+#define ArgLst      fld[3].cd	   /* argument list */
+#define ContFail    fld[4].cd	   /* label/signal to goto/return on failure */
+#define SigActs     fld[5].sa	   /* actions to take for returned signals */
+#define NextCall    fld[6].cd	   /* for chaining calls within a continuation*/
+#define NeedCont    1              /* pass NULL continuation if Cont == NULL */
+#define ForeignSig  2              /* may get foreign signal from a suspend */
+
+#define C_RetSig    3 		   /* return signal */
+#define SigRef      fld[0].sigref  /* pointer to func's reference to signal */
+
+#define C_Goto      4		   /* goto label */
+#define Lbl         fld[0].cd      /* label */
+
+#define C_Label     5		   /* statment label "Ln:" and signal "n" */
+#define Container   fld[0].fnc	   /* continuation containing label */
+#define SeqNum      fld[1].n	   /* sequence number, n */
+#define Desc        fld[2].s	   /* description of how label/signal is used */
+#define RefCnt      fld[3].n	   /* reference count for label */
+#define LabFlg      fld[4].n       /* flag: FncPtrd, BndSig */
+#define FncPrtd     1		   /*   function sig_n has been printed */
+#define Bounding    2		   /*   this is a bounding label */
+
+#define C_Lit      6 		   /* literal (integer, real, string, cset) */
+/* uses Rslt */
+#define Literal    fld[1].lit
+
+#define C_Resume   7		   /* resume signal */
+#define C_Continue 8 		   /* continue signal */
+#define C_FallThru 9		   /* fall through signal */
+#define C_PFail    10		   /* procedure failure */
+#define C_PRet     11		   /* procedure return (result already set) */
+#define C_PSusp    12		   /* procedure suspend */
+#define C_Break    13		   /* break out of signal handling switch */
+#define C_LBrack   14              /* '{' */
+#define C_RBrack   15              /* '}' */
+
+#define C_Create   16              /* call of create() for create expression */
+/* uses Rslt */
+/* uses Cont */
+#define NTemps      fld[2].n	   /* number of temporary descriptors needed */
+#define WrkSize     fld[3].n	   /* size of non-descriptor work area */
+#define NextCreat   fld[4].cd	   /* for chaining creates in a continuation */
+
+
+#define C_If       17		   /* conditional (goto or return) */
+#define Cond       fld[0].cd       /* condition */
+#define ThenStmt   fld[1].cd       /* what to do if condition is true */
+
+#define C_SrcLoc   18
+#define FileName    fld[0].s      /* name of source file */
+#define LineNum     fld[1].n      /* line number within source file */
+
+#define C_CdAry    19             /* array of code pieces, each with type code*/
+#define A_Str      0              /* code represented as a string */
+#define A_ValLoc   1              /* value location */
+#define A_Intgr    2              /* integer */
+#define A_ProcCont 3              /* procedure continuation */
+#define A_SBuf     4              /* string buffer (integer index) */
+#define A_CBuf     5              /* cset buffer (integer index) */
+#define A_Ary      6              /* pointer to subarray of code pieces */
+#define A_End      7              /* marker for end of array */
+#define ElemTyp(i) fld[2*i].n     /* type of element i (A_* codes) */
+#define Str(i)     fld[2*i+1].s   /* string in element i */
+#define ValLoc(i)  fld[2*i+1].vloc /* value location in element i */
+#define Intgr(i)   fld[2*i+1].n   /* integer in element i */
+#define Array(i)   fld[2*i+1].cd  /* pointer to subarray in element i */
+
+/*
+ * union cd_fld - fields within a code struct.
+ */
+union cd_fld {
+   int n;                  /* various integer values */
+   char *s;                /* various string values */
+   struct lentry *nvar;    /* symbol table entry for a named variable */
+   struct code *cd;        /* various pointers to other pieces of code */
+   struct c_fnc *fnc;      /* pointer to function information */
+   struct centry *lit;     /* symbol table entry for a literal */
+   struct sig_act *sa;     /* actions to take for a returned signal */
+   struct sig_lst *sigref; /* pointer to func's reference to signal */
+   struct val_loc *vloc;   /* value location */
+   char *oper_nm;          /* name of run-time operation or NULL */
+   };
+
+/*
+ * code - struct used to hold the internal representation of generated code.
+ */
+struct code {
+   int cd_id;           /* kind of code: C_* */
+   struct code *next;   /* next code fragment in list */
+   struct code *prev;   /* previous code fragment in list */
+   union cd_fld fld[1]; /* fields of code fragment, actual number varies */
+   };
+
+/*
+ * NewCode - allocate a code structure with "size" fields.
+ */
+#define NewCode(size) (struct code *)alloc((unsigned int)\
+    (sizeof(struct code) + (size-1) * sizeof(union cd_fld)))
+
+/*
+ * c_fnc contains information about a C function that implements a continuation.
+ */
+#define CF_SigOnly    1   /* this function only returns a signal */
+#define CF_ForeignSig 2   /* may return foreign signal from a suspend */
+#define CF_Mark       4   /* this function has been visited by fix_fncs() */
+#define CF_Coexpr     8   /* this function implements a co-expression */
+struct c_fnc {
+   char prefix[PrfxSz+1];   /* function prefix */
+   char frm_prfx[PrfxSz+1]; /* procedure frame prefix */
+   int flag;	            /* CF_* flags */
+   struct code cd;          /* start of code sequence */
+   struct code *cursor;     /* place to insert more code into sequence */
+   struct code *call_lst;   /* functions called by this function */
+   struct code *creatlst;   /* list of creates in this function */
+   struct sig_lst *sig_lst; /* signals returned by this function */
+   int ref_cnt;             /* reference count for this function */
+   struct c_fnc *next;
+   };
+
+
+/*
+ * sig_lst - a list of signals returned by a continuation along with a count
+ *  of the number of places each signal is returned.
+ */
+struct sig_lst {
+   struct code *sig;     /* signal */
+   int ref_cnt;          /* number of places returned */
+   struct sig_lst *next;
+   };
+
+/*
+ * op_symentry - entry in symbol table for an operation
+ */
+#define AdjNone  1   /* no adjustment to this argument */
+#define AdjDrf   2   /* deref in place */
+#define AdjNDrf  3   /* deref into a new temporary */
+#define AdjCpy   4   /* copy into a new temporary */
+struct op_symentry {
+    int n_refs;          /* number of non-modifying references */
+    int n_mods;          /* number of modifying referenced */
+    int n_rets;          /* number of times directly returned from operation */
+    int var_safe;        /* if arg is named var, it may be used directly */
+    int adjust;          /* AdjNone, AdjInplc, or AdjToNew */
+    int itmp_indx;       /* index of temporary C integer variable */
+    int dtmp_indx;       /* index of temporary C double variable */
+    struct val_loc *loc;
+    };
+
+extern int num_tmp;		/* number of temporary descriptor variables */
+extern int num_itmp;		/* number of temporary C integer variables */
+extern int num_dtmp;		/* number of temporary C double variables */
+extern int num_sbuf;		/* number of string buffers */
+extern int num_cbuf;		/* number of cset buffers */
+
+extern struct code *bound_sig;  /* bounding signal for current procedure */
+
+/*
+ * statically declared "signals".
+ */
+extern struct code resume;
+extern struct code contin;
+extern struct code fallthru;
+extern struct code next_fail;
+
+extern struct val_loc ignore;    /* no values, just something to point at */
+extern struct c_fnc *cur_fnc;    /* C function currently being built */
+extern struct code *on_failure;  /* place to go on failure */
+
+extern int lbl_seq_num;		/* next label sequence number */
+
+extern char pre[PrfxSz];        /* next unused prefix */
+
+extern struct op_symentry *cur_symtab; /* current operation symbol table */
+
+#define SepFnc  1   /* success continuation goes in separate function */
+#define SContIL 2   /* in line success continuation */
+#define EndOper 3   /* success continuation goes at end of operation */
+
+#define HasVal 1    /* type contains values */
+#define HasLcl 2    /* type contains local variables */
+#define HasPrm 4    /* type contains parameters */
+#define HasGlb 8    /* type contains globals (including statics and elements) */
+#define HasVar(x) ((x) & (HasLcl | HasPrm | HasGlb))
diff --git a/src/iconc/ccomp.c b/src/iconc/ccomp.c
new file mode 100644
index 0000000..5b86189
--- /dev/null
+++ b/src/iconc/ccomp.c
@@ -0,0 +1,130 @@
+/*
+ * ccomp.c - routines for compiling and linking the C program produced
+ *   by the translator.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "csym.h"
+#include "cproto.h"
+
+extern char *refpath;
+
+#define ExeFlag "-o"
+#define LinkLibs " -lm"
+ 
+/*
+ * Structure to hold the list of Icon run-time libraries that must be
+ *  linked in.
+ */
+struct lib {
+   char *libname;
+   int nm_sz;
+   struct lib *next;
+   };
+static struct lib *liblst;
+static int lib_sz = 0;
+
+/*
+ * addlib - add a new library to the list the must be linked.
+ */
+void addlib(libname)
+char *libname;
+   {
+   static struct lib **nxtlib = &liblst;
+   struct lib *l;
+
+   l = NewStruct(lib);
+   l->libname = libname;
+   l->nm_sz = strlen(libname);
+   l->next = NULL;
+   *nxtlib = l;
+   nxtlib = &l->next;
+   lib_sz += l->nm_sz + 1;
+   }
+
+/*
+ * ccomp - perform C compilation and linking.
+ */
+int ccomp(srcname, exename)
+char *srcname;
+char *exename;
+   {
+   struct lib *l;
+   char sbuf[MaxPath];			/* file name construction buffer */
+   char *buf;
+   char *s;
+   char *dlrgint;
+   int cmd_sz, opt_sz, flg_sz, exe_sz, src_sz;
+
+   /*
+    * Compute the sizes of the various parts of the command line
+    *  to do the compilation.
+    */
+   cmd_sz = strlen(c_comp);
+   opt_sz = strlen(c_opts);
+   flg_sz = strlen(ExeFlag);
+   exe_sz = strlen(exename);
+   src_sz = strlen(srcname);
+   lib_sz += strlen(LinkLibs);
+   if (!largeints) {
+      dlrgint = makename(sbuf, refpath, "dlrgint", ObjSuffix);
+      lib_sz += strlen(dlrgint) + 1;
+      }
+
+#ifdef Graphics
+   lib_sz += strlen(" -L") +
+             strlen(refpath) +
+	     strlen(" -lIgpx ");
+   lib_sz += strlen(ICONC_XLIB);
+#endif					/* Graphics */
+
+   buf = alloc((unsigned int)cmd_sz + opt_sz + flg_sz + exe_sz + src_sz +
+			     lib_sz + 5);
+   strcpy(buf, c_comp);
+   s = buf + cmd_sz;
+   *s++ = ' ';
+   strcpy(s, c_opts);
+   s += opt_sz;
+   *s++ = ' ';
+   strcpy(s, ExeFlag);
+   s += flg_sz;
+   *s++ = ' ';
+   strcpy(s, exename);
+   s += exe_sz;
+   *s++ = ' ';
+   strcpy(s, srcname);
+   s += src_sz;
+   if (!largeints) {
+      *s++ = ' ';
+      strcpy(s, dlrgint);
+      s += strlen(dlrgint);
+      }
+   for (l = liblst; l != NULL; l = l->next) {
+      *s++ = ' ';
+      strcpy(s, l->libname);
+      s += l->nm_sz;
+      }
+
+#ifdef Graphics
+   strcpy(s," -L");
+   strcat(s, refpath);
+   strcat(s," -lIgpx ");
+   strcat(s, ICONC_XLIB);
+   s += strlen(s);
+#endif					/* Graphics */
+
+   strcpy(s, LinkLibs);
+
+   if (system(buf) != 0)
+      return EXIT_FAILURE;
+   strcpy(buf, "strip ");
+   s = buf + 6;
+   strcpy(s, exename);
+   system(buf);
+
+
+   return EXIT_SUCCESS;
+   }
diff --git a/src/iconc/cglobals.h b/src/iconc/cglobals.h
new file mode 100644
index 0000000..301a602
--- /dev/null
+++ b/src/iconc/cglobals.h
@@ -0,0 +1,50 @@
+/*
+ *  Global variables.
+ */
+
+extern char *runtime;
+
+#ifndef Global
+#define Global extern
+#define Init(v)
+#endif					/* Global */
+
+/*
+ * Variables related to command processing.
+ */
+Global char *progname	Init("iconc");	/* program name for diagnostics */
+
+Global int debug_info	Init(0);	/* -fd, -t: generate debugging info */
+Global int err_conv     Init(0);	/* -fe: support error conversion */
+
+#ifdef LargeInts
+   Global int largeints	Init(1);	/* -fl: support large integers */
+#else					/* LargeInts */
+   Global int largeints	Init(0);	/* -fl: support large integers */
+#endif					/* LargeInts */
+
+Global int line_info	Init(0);	/* -fn, -fd, -t: generate line info */
+Global int m4pre	Init(0);	/* -m: use m4 preprocessor? */
+Global int str_inv	Init(0);	/* -fs: enable full string invocation */
+Global int trace	Init(0);	/* -t: initial &trace value */
+Global int uwarn	Init(0);	/* -u: warn about undefined ids? */
+Global int just_type_trace Init(0);	/* -T: suppress C code */
+Global int verbose      Init(1);	/* -s, -v: level of verbosity */
+Global int pponly       Init(0);	/* -E: preprocess only */
+
+Global char *c_comp     Init(CComp);    /* -C: C compiler */
+Global char *c_opts     Init(COpts);    /* -p: options for C compiler */
+
+/*
+ * Flags turned off by the -n option.
+ */
+Global int opt_cntrl	Init(1);	/* do control flow optimization */
+Global int opt_sgnl	Init(1);	/* do signal handling optimizations */
+Global int do_typinfer	Init(1);	/* do type inference */
+Global int allow_inline Init(1);	/* allow expanding operations in line */
+
+/*
+ * Files.
+ */
+Global FILE *codefile	Init(0);	/* C code output - primary file */
+Global FILE *inclfile	Init(0);	/* C code output - include file */
diff --git a/src/iconc/cgrammar.c b/src/iconc/cgrammar.c
new file mode 100644
index 0000000..a48e621
--- /dev/null
+++ b/src/iconc/cgrammar.c
@@ -0,0 +1,221 @@
+/*
+ * cgrammar.c - includes and macros for building the parse tree.
+ */
+#include "../h/define.h"
+#include "../common/yacctok.h"
+
+%{
+/*
+ * These commented directives are passed through the first application
+ * of cpp, then turned into real directives in cgram.g by fixgram.icn.
+ */
+/*#include "../h/gsupport.h"*/
+/*#include "../h/lexdef.h"*/
+/*#include "ctrans.h"*/
+/*#include "csym.h"*/
+/*#include "ctree.h"*/
+/*#include "ccode.h" */
+/*#include "cproto.h"*/
+/*#undef YYSTYPE*/
+/*#define YYSTYPE nodeptr*/
+/*#define YYMAXDEPTH 500*/
+
+int idflag;
+
+#define EmptyNode tree1(N_Empty) 
+
+#define Alt(x1,x2,x3)		$$ = tree4(N_Alt,x2,x1,x3) 
+#define Apply(x1,x2,x3)		$$ = tree4(N_Apply,x2,x1,x3) 
+#define Arglist1()		/* empty */
+#define Arglist2(x)		/* empty */
+#define Arglist3(x1,x2,x3)	proc_lst->nargs = -proc_lst->nargs
+#define Bact(x1,x2,x3)		$$ = tree5(N_Activat,x2,x2,x1,x3) 
+#define Bamper(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Bassgn(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Baugact(x1,x2,x3)	$$ = tree5(N_Activat,x2,x2,x1,x3) 
+#define Baugamper(x1,x2,x3)	$$ = aug_nd(x2,x1,x3) 
+#define Baugcat(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugeq(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugeqv(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugge(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauggt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauglcat(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugle(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauglt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugne(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugneqv(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugques(x1,x2,x3)	$$ = tree5(N_Scan,x2,x2,x1,x3) 
+#define Baugseq(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsge(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsgt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsle(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugslt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsne(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bcaret(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Bcareta(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bcat(x1,x2,x3)		$$ = binary_nd(x2,x1,x3) 
+#define Bdiff(x1,x2,x3)		$$ = binary_nd(x2,x1,x3) 
+#define Bdiffa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Beq(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Beqv(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bge(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bgt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Binter(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bintera(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Blcat(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Ble(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Blim(x1,x2,x3)		$$ = tree4(N_Limit,x2,x1,x3) 
+#define Blt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bminus(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bminusa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bmod(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bmoda(x1,x2,x3)		$$ = aug_nd(x2,x1,x3)
+#define Bne(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bneqv(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bplus(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bplusa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bques(x1,x2,x3)		$$ = tree5(N_Scan,x2,x2,x1,x3) 
+#define Brace(x1,x2,x3)		$$ = x2
+#define Brack(x1,x2,x3)		$$ = list_nd(x1,x2) 
+#define Brassgn(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Break(x1,x2)		$$ = tree3(N_Break,x1,x2) 
+#define Brswap(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bseq(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsge(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsgt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bslash(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bslasha(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bsle(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bslt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsne(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bstar(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bstara(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bswap(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bunion(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Buniona(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Case(x1,x2,x3,x4,x5,x6) $$ = case_nd(x1,x2,x5) 
+#define Caselist(x1,x2,x3)	$$ = tree4(N_Clist,x2,x1,x3) 
+#define Cclause0(x1,x2,x3)	$$ = tree4(N_Ccls,x2,x1,x3) 
+#define Cclause1(x1,x2,x3)	$$ = tree4(N_Ccls,x2,x1,x3) 
+#define Cliter(x)		CSym0(x) = putlit(Str0(x),F_CsetLit,(int)Val1(x))
+#define Colon(x)		$$ = x
+#define Compound(x1,x2,x3)	$$ = tree4(N_Slist,x2,x1,x3) 
+#define Create(x1,x2)		$$ = tree3(N_Create,x1,x2);\
+				 proc_lst->has_coexpr = 1;
+#define Elst0(x)                $$ = x;
+#define Elst1(x1,x2,x3)	        $$ = tree4(N_Elist,x2,x1,x3);
+#define Every0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Every1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define Fail(x)			$$ = tree4(N_Ret,x,x,EmptyNode) 
+#define Field(x1,x2,x3)		$$ = tree4(N_Field,x2,x1,x3) 
+#define Global0(x)		idflag = F_Global
+#define Global1(x1,x2,x3)	/* empty */
+#define Globdcl(x)		/* empty */
+#define Ident(x)		install(Str0(x),idflag)
+#define Idlist(x1,x2,x3)	install(Str0(x3),idflag)
+#define If0(x1,x2,x3,x4)	$$ = tree5(N_If,x1,x2,x4,EmptyNode) 
+#define If1(x1,x2,x3,x4,x5,x6)	$$ = tree5(N_If,x1,x2,x4,x6) 
+#define Iliter(x)		CSym0(x) = putlit(Str0(x),F_IntLit,0)
+#define Initial1()		$$ = EmptyNode
+#define Initial2(x1,x2,x3)	$$ = x2
+#define Invocdcl(x)             /* empty */
+#define Invocable(x1,x2)        /* empty */
+#define Invoclist(x1,x2, x3)    /* empty */
+#define Invocop1(x)             invoc_grp(Str0(x));
+#define Invocop2(x)             invocbl(x, -1);
+#define Invocop3(x1,x2,x3)      invocbl(x1, atoi(Str0(x3)));
+#define Invoke(x1,x2,x3,x4)	$$ = invk_nd(x2,x1,x3)
+#define Keyword(x1,x2)		$$ = key_leaf(x1,Str0(x2))
+#define Kfail(x1,x2)		$$ = key_leaf(x1,spec_str("fail")) 
+#define Link(x1,x2)		/* empty */
+#define Linkdcl(x)		/* empty */
+#define Lnkfile1(x)		lnkdcl(Str0(x));
+#define Lnkfile2(x)		lnkdcl(Str0(x));
+#define Lnklist(x1,x2,x3)	/* empty */
+#define Local(x)		idflag = F_Dynamic
+#define Locals1()		/* empty */
+#define Locals2(x1,x2,x3,x4)	/* empty */
+#define Mcolon(x)		$$ = x
+#define Nexpr()			$$ = EmptyNode
+#define Next(x)			$$ = tree2(N_Next,x) 
+#define Paren(x1,x2,x3)		if ((x2)->n_type == N_Elist)\
+                                   $$ = invk_nd(x1,EmptyNode,x2);\
+ 				else\
+ 				   $$ = x2
+#define Pcolon(x)		$$ = x
+#define Pdco0(x1,x2,x3)		$$ = invk_nd(x2,x1,list_nd(x2,EmptyNode))
+#define Pdco1(x1,x2,x3,x4)	$$ = invk_nd(x2,x1,list_nd(x2,x3)) 
+#define Pdcolist0(x)		$$ = tree3(N_Create,x,x);\
+				 proc_lst->has_coexpr = 1;
+#define Pdcolist1(x1,x2,x3)	$$ =tree4(N_Elist,x2,x1,tree3(N_Create,x2,x3));\
+				 proc_lst->has_coexpr = 1;
+#define Proc1(x1,x2,x3,x4,x5,x6) $$ = tree6(N_Proc,x1,x1,x4,x5,x6)
+#define Procbody1()		$$ = EmptyNode
+#define Procbody2(x1,x2,x3)	$$ = tree4(N_Slist,x2,x1,x3) 
+#define Procdcl(x)		proc_lst->tree = x
+#define Prochead1(x1,x2)	init_proc(Str0(x2));\
+				idflag = F_Argument
+#define Prochead2(x1,x2,x3,x4,x5,x6) /* empty */
+#define Progend(x1,x2)		/* empty */
+#define Recdcl(x)		/* empty */
+#define Record1(x1, x2)		init_rec(Str0(x2));\
+                                idflag = F_Field
+#define Record2(x1,x2,x3,x4,x5,x6) /* empty */
+#define Repeat(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Return(x1,x2)		$$ = tree4(N_Ret,x1,x1,x2) 
+#define Rliter(x)		CSym0(x) = putlit(Str0(x),F_RealLit,0)
+#define Section(x1,x2,x3,x4,x5,x6) $$ = sect_nd(x4,x1,x3,x5) 
+#define Sliter(x)		CSym0(x) = putlit(Str0(x),F_StrLit,(int)Val1(x))
+#define Static(x)		idflag = F_Static
+#define Subscript(x1,x2,x3,x4)	$$ = buildarray(x1,x2,x3)
+#define Suspend0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Suspend1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define To0(x1,x2,x3)		$$ = to_nd(x2,x1,x3) 
+#define To1(x1,x2,x3,x4,x5)	$$ = toby_nd(x2,x1,x3,x5) 
+#define Uat(x1,x2)		$$ = tree5(N_Activat,x1,x1,EmptyNode,x2) 
+#define Ubackslash(x1,x2)	$$ = unary_nd(x1,x2)
+#define Ubang(x1,x2)		$$ = unary_nd(x1,x2)
+#define Ubar(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Ucaret(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Udiff(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Udot(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uequiv(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uinter(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Ulconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Ulexeq(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Ulexne(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uminus(x1,x2)		$$ = unary_nd(x1,x2)
+#define Unot(x1,x2)		$$ = tree3(N_Not,x2,x2) 
+#define Unotequiv(x1,x2)	$$ = MultiUnary(x1,x2)
+#define Until0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Until1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define Unumeq(x1,x2)		$$ = unary_nd(x1,x2)
+#define Unumne(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uplus(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uqmark(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uslash(x1,x2)		$$ = unary_nd(x1,x2)
+#define Ustar(x1,x2)		$$ = unary_nd(x1,x2)
+#define Utilde(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uunion(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Var(x)			LSym0(x) = putloc(Str0(x),0)
+#define While0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode)
+#define While1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+%}
+
+%%
+#include "../h/grammar.h"
+%%
+
+/*
+ * xfree(p) -- used with free(p) macro to avoid compiler errors from
+ *  miscast free calls generated by Yacc.
+ */
+#undef free
+static void xfree(p)
+char *p;
+{
+   free(p);
+}
+
+/*#define free(p) xfree((char*)p)*/
diff --git a/src/iconc/chkinv.c b/src/iconc/chkinv.c
new file mode 100644
index 0000000..af4298f
--- /dev/null
+++ b/src/iconc/chkinv.c
@@ -0,0 +1,545 @@
+/*
+ * chkinv.c - routines to determine which global names are only
+ *   used as immediate operand to invocation and to directly invoke
+ *   the corresponding operations. In addition, simple assignments to
+ *   names variables are recognized and it is determined whether
+ *   procedures return, suspend, or fail.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * prototypes for static functions.
+ */
+static int     chg_ret  (int flag);
+static void chksmpl  (struct node *n, int smpl_invk);
+static int     seq_exec (int exec_flg1, int exec_flg2);
+static int     spcl_inv (struct node *n, struct node *asgn);
+
+static ret_flag;
+
+/*
+ * chkinv - check for invocation and assignment optimizations.
+ */
+void chkinv()
+   {
+   struct gentry *gp;
+   struct pentry *proc;
+   int exec_flg;
+   int i;
+
+   if (debug_info)
+       return;  /* The following analysis is not valid */
+
+   /*
+    * start off assuming that global variables for procedure, etc. are
+    *  only used as immediate operands to invocations then mark any 
+    *  which are not. Any variables retaining the property are never
+    *  changed. Go through the code and change invocations to such
+    *  variables to invocations directly to the operation.
+    */
+   for (i = 0; i < GHSize; i++)
+      for (gp = ghash[i]; gp != NULL; gp = gp->blink) {
+         if (gp->flag & (F_Proc | F_Builtin | F_Record) &&
+            !(gp->flag & F_StrInv))
+               gp->flag |= F_SmplInv;
+         /*
+          * However, only optimize normal cases for main.
+          */
+         if (strcmp(gp->name, "main") == 0 && (gp->flag & F_Proc) &&
+            (gp->val.proc->nargs < 0 || gp->val.proc->nargs > 1))
+               gp->flag &= ~(uword)F_SmplInv;
+         /*
+          * Work-around to problem that a co-expression block needs
+          *  block for enclosing procedure: just keep procedure in
+          *  a variable to force outputting the block. Note, this
+          *  inhibits tailored calling conventions for the procedure.
+          */
+         if ((gp->flag & F_Proc) && gp->val.proc->has_coexpr)
+            gp->flag &= ~(uword)F_SmplInv;
+         }
+
+   /*
+    * Analyze code in each procedure.
+    */
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      chksmpl(Tree1(proc->tree), 0);  /* initial expression */
+      chksmpl(Tree2(proc->tree), 0);  /* procedure body */
+      }
+
+   /*
+    * Go through each procedure performing "naive" optimizations on
+    *  invocations and assignments. Also determine whether the procedure
+    *  returns, suspends, or fails (possibly by falling through to
+    *  the end).
+    */
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      ret_flag = 0;
+      spcl_inv(Tree1(proc->tree), NULL);
+      exec_flg = spcl_inv(Tree2(proc->tree), NULL);
+      if (exec_flg & DoesFThru)
+        ret_flag |= DoesFail;
+      proc->ret_flag = ret_flag;
+      }
+   }
+
+/*
+ * smpl_invk - find any global variable uses that are not a simple
+ *  invocation and mark the variables.
+ */
+static void chksmpl(n, smpl_invk)
+struct node *n;
+int smpl_invk;
+   {
+   struct node *cases;
+   struct node *clause;
+   struct lentry *var;
+   int i;
+   int lst_arg;
+
+   switch (n->n_type) {
+      case N_Alt:
+      case N_Apply:
+      case N_Limit:
+      case N_Slist:
+         chksmpl(Tree0(n), 0);
+         chksmpl(Tree1(n), 0);
+         break;
+
+      case N_Activat:
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Augop:
+         chksmpl(Tree2(n), 0);
+         chksmpl(Tree3(n), 0);
+         break;
+
+      case N_Bar:
+      case N_Break:
+      case N_Create:
+      case N_Field:
+      case N_Not:
+         chksmpl(Tree0(n), 0);
+         break;
+
+      case N_Case:
+         chksmpl(Tree0(n), 0);  /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+      
+            chksmpl(Tree0(clause), 0);   /* value of clause */
+            chksmpl(Tree1(clause), 0);   /* body of clause */
+            }
+         if (Tree2(n) != NULL)
+            chksmpl(Tree2(n), 0);  /* default */
+         break;
+
+      case N_Cset:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+      case N_Empty:
+      case N_Next:
+         break;
+
+      case N_Id:
+         if (!smpl_invk) {
+            /*
+             * The variable is being used somewhere other than in a simple
+             *  invocation.
+             */
+            var = LSym0(n);
+            if (var->flag & F_Global)
+               var->val.global->flag &= ~F_SmplInv;
+            }
+         break;
+
+      case N_If:
+         chksmpl(Tree0(n), 0);
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Invok:
+         lst_arg =  1 + Val0(n);
+         /*
+          * Check the thing being invoked, noting that it is in fact being
+          *  invoked.
+          */
+         chksmpl(Tree1(n), 1);
+         for (i = 2; i <= lst_arg; ++i)
+            chksmpl(n->n_field[i].n_ptr, 0);  /* arg i - 1 */
+         break;
+
+      case N_InvOp:
+         lst_arg = 1 + Val0(n);
+         for (i = 2; i <= lst_arg; ++i)
+            chksmpl(n->n_field[i].n_ptr, 0);       /* arg i */
+         break;
+
+      case N_Loop: {
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+            case WHILE:
+            case UNTIL:
+               chksmpl(Tree1(n), 0);   /* control clause */
+               chksmpl(Tree2(n), 0);   /* do clause */
+               break;
+
+            case REPEAT:
+               chksmpl(Tree1(n), 0);   /* clause */
+               break;
+            }
+         }
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)
+            chksmpl(Tree1(n), 0);
+         break;
+
+      case N_Scan:
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Sect:
+         chksmpl(Tree2(n), 0);
+         chksmpl(Tree3(n), 0);
+         chksmpl(Tree4(n), 0);
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * spcl_inv - look for general invocations that can be replaced by
+ *   special invocations. Simple assignment to a named variable is
+ *   is a particularly special case. Also, determine whether execution
+ *   might "fall through" this code and whether the code might fail.
+ */
+static int spcl_inv(n, asgn)
+struct node *n;
+struct node *asgn;  /* the result goes into this special-cased assignment */
+   {
+   struct node *cases;
+   struct node *clause;
+   struct node *invokee;
+   struct gentry *gvar;
+   struct loop {
+      int exec_flg;
+      struct node *asgn;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   int exec_flg;
+   int i;
+   int lst_arg;
+   static struct loop *cur_loop = NULL;
+
+   switch (n->n_type) {
+      case N_Activat:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* assume worst case */
+         return seq_exec(spcl_inv(Tree1(n), NULL), spcl_inv(Tree2(n), NULL));
+
+      case N_Alt:
+         exec_flg = spcl_inv(Tree0(n), asgn) & DoesFThru;
+         return exec_flg | spcl_inv(Tree1(n), asgn);
+
+      case N_Apply:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         return seq_exec(spcl_inv(Tree0(n), NULL), spcl_inv(Tree1(n), NULL));
+
+      case N_Augop:
+         exec_flg = chg_ret(Impl1(n)->ret_flag);
+         if (Tree2(n)->n_type == N_Id) {
+            /*
+             * This is an augmented assignment to a named variable.
+             *  An optimized version of assignment can be used.
+             */
+            n->n_type = N_SmplAug;
+            if (Impl1(n)->use_rslt)
+               Val0(n) = AsgnCopy;
+            else
+               Val0(n) = AsgnDirect;
+            }
+         else {
+            if (asgn != NULL)
+               Val0(asgn) = AsgnDeref; /* this operation produces a variable */
+            exec_flg = seq_exec(exec_flg, spcl_inv(Tree2(n), NULL));
+            exec_flg = seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
+            }
+         return seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
+
+      case N_Bar:
+         return spcl_inv(Tree0(n), asgn);
+
+      case N_Break:
+         if (cur_loop == NULL) {
+	    nfatal(n, "invalid context for break", NULL);
+            return 0;
+            }
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         loop_sav->exec_flg |= spcl_inv(Tree0(n), loop_sav->asgn);
+         cur_loop = loop_sav;
+         return 0;
+
+      case N_Create:
+         spcl_inv(Tree0(n), NULL);
+         return DoesFThru;
+
+      case N_Case:
+         exec_flg = spcl_inv(Tree0(n), NULL) & DoesFail; /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+      
+            spcl_inv(Tree0(clause), NULL);
+            exec_flg |= spcl_inv(Tree1(clause), asgn);
+            }
+         if (Tree2(n) != NULL)
+            exec_flg |= spcl_inv(Tree2(n), asgn);  /* default */
+         else
+            exec_flg |= DoesFail;
+         return exec_flg;
+
+      case N_Cset:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+      case N_Empty:
+         return DoesFThru;
+
+      case N_Field:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* operation produces variable */
+         return spcl_inv(Tree0(n), NULL);
+
+      case N_Id:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* variable */
+         return DoesFThru;
+
+      case N_If:
+         spcl_inv(Tree0(n), NULL);
+         exec_flg = spcl_inv(Tree1(n), asgn);
+         if (Tree2(n)->n_type == N_Empty)
+            exec_flg |= DoesFail;
+         else
+            exec_flg |= spcl_inv(Tree2(n), asgn);
+         return exec_flg;
+
+      case N_Invok:
+         lst_arg = 1 + Val0(n);
+         invokee = Tree1(n);
+         exec_flg = DoesFThru;
+         for (i = 2; i <= lst_arg; ++i)
+            exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, NULL));
+         if (invokee->n_type == N_Id && LSym0(invokee)->flag & F_Global) {
+            /*
+             * This is an invocation of a global variable. If we can
+             *  convert this to a direct invocation, determine whether
+             *  it is an invocation of a procedure, built-in function,
+             *  or record constructor; each has a difference kind of
+             *  direct invocation node.
+             */
+            gvar = LSym0(invokee)->val.global;
+            if (gvar->flag & F_SmplInv) {
+               switch (gvar->flag & (F_Proc | F_Builtin | F_Record)) {
+                  case F_Proc:
+                     n->n_type = N_InvProc;
+                     Proc1(n) = gvar->val.proc;
+                     return DoesFThru | DoesFail; /* assume worst case */
+                  case F_Builtin:
+                     n->n_type = N_InvOp;
+                     Impl1(n) = gvar->val.builtin;
+                     if (asgn != NULL && Impl1(n)->use_rslt)
+                        Val0(asgn) = AsgnCopy;
+                     return seq_exec(exec_flg, chg_ret(
+                        gvar->val.builtin->ret_flag));
+                  case F_Record:
+                     n->n_type = N_InvRec;
+                     Rec1(n) = gvar->val.rec;
+                     return seq_exec(exec_flg, DoesFThru |
+                        (err_conv ? DoesFail : 0));
+                  }
+               }
+            }
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         spcl_inv(invokee, NULL);
+         return DoesFThru | DoesFail; /* assume worst case */
+
+      case N_InvOp:
+         if (Impl1(n)->op != NULL && strcmp(Impl1(n)->op, ":=") == 0 &&
+            Tree2(n)->n_type == N_Id) {
+            /*
+             * This is a simple assignment to a named variable.
+             *  An optimized version of assignment can be used.
+             */
+            n->n_type = N_SmplAsgn;
+
+            /* 
+             * For now, assume rhs of := can compute directly into a 
+             *  variable. This may be changed when the rhs is examined
+             *  in the recursive call to spcl_inv().
+             */
+            Val0(n) = AsgnDirect;
+            return spcl_inv(Tree3(n), n);
+            }
+         else {
+            /*
+             * No special cases.
+             */
+            lst_arg = 1 + Val0(n);
+            exec_flg = chg_ret(Impl1(n)->ret_flag);
+            for (i = 2; i <= lst_arg; ++i)
+               exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, 
+                  NULL)); /* arg i */
+            if (asgn != NULL && Impl1(n)->use_rslt)
+               Val0(asgn) = AsgnCopy;
+            return exec_flg;
+            }
+
+      case N_Limit:
+         return seq_exec(spcl_inv(Tree0(n), asgn),
+            spcl_inv(Tree1(n), NULL)) | DoesFail;
+
+      case N_Loop: {
+         loop_info.prev = cur_loop;
+         loop_info.exec_flg = 0;
+         loop_info.asgn = asgn;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case WHILE:
+            case UNTIL:
+               spcl_inv(Tree1(n), NULL);   /* control clause */
+               spcl_inv(Tree2(n), NULL);   /* do clause */
+               exec_flg = DoesFail;
+               break;
+
+            case SUSPEND:
+               spcl_inv(Tree1(n), NULL);   /* control clause */
+               spcl_inv(Tree2(n), NULL);   /* do clause */
+               ret_flag |= DoesSusp;
+               exec_flg = DoesFail;
+               break;
+
+            case REPEAT:
+               spcl_inv(Tree1(n), NULL);   /* clause */
+               exec_flg = 0;
+               break;
+            }
+         exec_flg |= cur_loop->exec_flg;
+         cur_loop = cur_loop->prev;
+         return exec_flg;
+         }
+
+      case N_Next:
+         return 0;
+
+      case N_Not:
+         exec_flg = spcl_inv(Tree0(n), NULL);
+         return ((exec_flg & DoesFail) ? DoesFThru : 0) |
+            ((exec_flg & DoesFThru) ? DoesFail: 0);
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN) {
+            exec_flg = spcl_inv(Tree1(n), NULL);
+            ret_flag |= DoesRet;
+            if (exec_flg & DoesFail)
+               ret_flag |= DoesFail;
+            }
+         else
+            ret_flag |= DoesFail;
+         return 0;
+
+      case N_Scan:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         return seq_exec(spcl_inv(Tree1(n), NULL),
+            spcl_inv(Tree2(n), NULL));
+
+      case N_Sect:
+         if (asgn != NULL && Impl0(n)->use_rslt)
+            Val0(asgn) = AsgnCopy;
+         exec_flg = spcl_inv(Tree2(n), NULL);
+         exec_flg = seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
+         exec_flg = seq_exec(exec_flg, spcl_inv(Tree4(n), NULL));
+         return seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
+
+      case N_Slist:
+         exec_flg = spcl_inv(Tree0(n), NULL);
+         if (exec_flg & (DoesFThru | DoesFail))
+            exec_flg = DoesFThru;
+         return seq_exec(exec_flg, spcl_inv(Tree1(n), asgn));
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * seq_exec - take the execution flags for sequential pieces of code
+ *  and compute the flags for the combined code.
+ */
+static int seq_exec(exec_flg1, exec_flg2)
+int exec_flg1;
+int exec_flg2;
+   {
+   return (exec_flg1 & exec_flg2 & DoesFThru) |
+      ((exec_flg1 | exec_flg2) & DoesFail);
+   }
+
+/*
+ * chg_ret - take a return flag and change suspend and return to
+ *  "fall through". If error conversion is supported, change error
+ *  failure to failure.
+ *  
+ */
+static int chg_ret(flag)
+int flag;
+   {
+   int flg1;
+
+   flg1 = flag & DoesFail;
+   if (flag & (DoesRet | DoesSusp))
+      flg1 |= DoesFThru;
+   if (err_conv && (flag & DoesEFail))
+      flg1 |= DoesFail;
+   return flg1;
+   }
+
+
diff --git a/src/iconc/clex.c b/src/iconc/clex.c
new file mode 100644
index 0000000..8e7d657
--- /dev/null
+++ b/src/iconc/clex.c
@@ -0,0 +1,18 @@
+/*
+ * clex.c -- the lexical analyzer for iconc.
+ */
+#define Iconc
+
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "ctoken.h"
+#include "ctree.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+#include "../h/parserr.h"
+#include "../common/lextab.h"
+#include "../common/yylex.h"
+#include "../common/error.h"
diff --git a/src/iconc/cmain.c b/src/iconc/cmain.c
new file mode 100644
index 0000000..6daf5c4
--- /dev/null
+++ b/src/iconc/cmain.c
@@ -0,0 +1,424 @@
+/*
+ * cmain.c - main program icon compiler.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "csym.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+static void execute (char *ofile, char **args);
+static FILE  *open_out (char *fname);
+static void rmfile  (char *fname);
+static void report  (char *s);
+static void usage   (void);
+
+char *refpath;
+
+char patchpath[MaxPath+18] = "%PatchStringHere->";
+
+/*
+ *  Define global variables.
+ */
+
+#define Global
+#define Init(v) = v
+#include "cglobals.h"
+
+/*
+ * getopt() variables
+ */
+extern int optind;		/* index into parent argv vector */
+extern int optopt;		/* character checked for validity */
+extern char *optarg;		/* argument associated with option */
+
+/*
+ *  main program
+ */
+int main(argc,argv)
+int argc;
+char **argv;
+   {
+   int no_c_comp = 0;			/* suppress C compile and link? */
+   int errors = 0;			/* compilation errors */
+   char *cfile = NULL;			/* name of C file - primary */
+   char *hfile = NULL;			/* name of C file - include */
+   char *ofile = NULL;			/* name of executable result */
+
+   char *db_name = "rt.db";		/* data base name */
+   char *incl_file = "rt.h";		/* header file name */
+
+   char *db_path;			/* path to data base */
+   char *db_lst;			/* list of private data bases */
+   char *incl_path;			/* path to header file */
+   char *s, c1;
+   char buf[MaxPath];			/* file name construction buffer */
+   int c;
+   int ret_code;
+   struct fileparts *fp;
+
+   if ((int)strlen(patchpath) > 18)
+      refpath = patchpath+18;
+   else
+      refpath = relfile(argv[0], "/../");
+
+   /*
+    * Process options.
+    */
+   while ((c = getopt(argc,argv,"+C:ELS:Tcf:mn:o:p:r:stuv:x")) != EOF)
+      switch (c) {
+         case 'C':			/* -C C-comp: C compiler*/
+            c_comp = optarg;
+            break;
+         case 'E':			/* -E: preprocess only */
+            pponly = 1;
+            no_c_comp = 1;
+            break;
+         case 'L':			/* Ignore: interpreter only */
+            break;
+         case 'S':			/* Ignore: interpreter only */
+            break;
+	 case 'T':
+	    just_type_trace = 1;
+	    break;
+         case 'c':			/* -c: produce C file only */
+            no_c_comp = 1;
+            break;
+         case 'f':			/* -f: enable features */
+            for (s = optarg; *s != '\0'; ++s) {
+               switch (*s) {
+                  case 'a':             /* -fa: enable all features */
+                     line_info = 1;
+                     debug_info = 1;
+                     err_conv = 1;
+                     largeints = 1;
+                     str_inv = 1;
+                     break;
+                  case 'd':             /* -fd: enable debugging features */
+                     line_info = 1;
+                     debug_info = 1;
+                     break;
+                  case 'e':             /* -fe: enable error conversion */
+                     err_conv = 1;
+                     break;
+                  case 'l':             /* -fl: support large integers */
+                     largeints = 1;
+                     break;
+                  case 'n':             /* -fn: enable line numbers */
+                     line_info = 1;
+                     break;
+                  case 's':		/* -fs: enable full string invocation */
+                     str_inv = 1;
+                     break;
+                  default:
+                     quitf("-f option must be a, d, e, l, n, or s. found: %s",
+                        optarg);
+                  }
+               }
+            break;
+         case 'm':			/* -m: preprocess using m4(1) */
+            m4pre = 1;
+            break;
+         case 'n':			/* -n: disable optimizations */
+            for (s = optarg; *s != '\0'; ++s) {
+               switch (*s) {
+                  case 'a':		/* -na: disable all optimizations */
+                     opt_cntrl = 0;
+                     allow_inline = 0;
+                     opt_sgnl = 0;
+                     do_typinfer = 0;
+                     break;
+                  case 'c':		/* -nc: disable control flow opts */
+                     opt_cntrl = 0;
+                     break;
+                  case 'e':		/* -ne: disable expanding in-line */
+                     allow_inline = 0;
+                     break;
+                  case 's':		/* -ns: disable switch optimizations */
+                     opt_sgnl = 0;
+                     break;
+                  case 't':		/* -nt: disable type inference */
+                     do_typinfer = 0;
+                     break;
+                  default:
+                     usage();
+                  }
+               }
+            break;
+         case 'o':			/* -o file: name output file */
+            ofile = optarg;
+            break;
+         case 'p':			/* -p C-opts: options for C comp */
+            if (*optarg == '\0')	/* if empty string, clear options */
+               c_opts = optarg;
+            else {			/* else append to current set */
+               s = (char *)alloc(strlen(c_opts) + 1 + strlen(optarg) + 1);
+               sprintf(s, "%s %s", c_opts, optarg);
+               c_opts = s;
+               }
+            break;
+         case 'r':			/* -r path: primary runtime system */
+            refpath = optarg;
+            break;
+         case 's':			/* -s: suppress informative messages */
+            verbose = 0;
+            break;
+         case 't':                      /* -t: &trace = -1 */
+            line_info = 1;
+            debug_info = 1;
+            trace = 1;
+            break;
+         case 'u':			/* -u: warn about undeclared ids */
+            uwarn = 1;
+            break;
+         case 'v':			/* -v: set level of verbosity */
+            if (sscanf(optarg, "%d%c", &verbose, &c1) != 1)
+               quitf("bad operand to -v option: %s",optarg);
+            break;
+         default:
+         case 'x':                      /* -x illegal until after file list */
+            usage();
+         }
+
+   init();			/* initialize memory for translation */
+
+   /*
+    * Load the data bases of information about run-time routines and
+    *  determine what libraries are needed for linking (these libraries
+    *  go before any specified on the command line).
+    */
+   db_lst = getenv("DBLIST");
+   if (db_lst != NULL)
+      db_lst = salloc(db_lst);
+   s = db_lst;
+   while (s != NULL) {
+      db_lst = s;
+      while (isspace(*db_lst))
+         ++db_lst;
+      if (*db_lst == '\0')
+         break;
+      for (s = db_lst; !isspace(*s) && *s != '\0'; ++s)
+         ;
+      if (*s == '\0')
+         s = NULL;
+      else
+         *s++ = '\0';
+      readdb(db_lst);
+      addlib(salloc(makename(buf,SourceDir, db_lst, LibSuffix)));
+      }
+   db_path = (char *)alloc((unsigned int)strlen(refpath) + strlen(db_name) + 1);
+   strcpy(db_path, refpath);
+   strcat(db_path, db_name);
+   readdb(db_path);
+   addlib(salloc(makename(buf,SourceDir, db_path, LibSuffix)));
+
+   /*
+    * Scan the rest of the command line for file name arguments.
+    */
+   while (optind < argc)  {
+      if (strcmp(argv[optind],"-x") == 0)	/* stop at -x */
+         break;
+      else if (strcmp(argv[optind],"-") == 0)
+         src_file("-");				/* "-" means standard input */
+      else if (argv[optind][0] == '-')
+         addlib(argv[optind]);			/* assume linker option */
+      else {
+         fp = fparse(argv[optind]);		/* parse file name */
+         if (*fp->ext == '\0' || smatch(fp->ext, SourceSuffix)) {
+            makename(buf,SourceDir,argv[optind], SourceSuffix);
+            src_file(buf);
+            }
+         else
+            /*
+             * Assume all files that are not Icon source go to linker.
+             */
+            addlib(argv[optind]);
+         }
+      optind++;
+      }
+ 
+   if (srclst == NULL)
+      usage();				/* error -- no files named */
+
+   if (pponly) {
+      if (trans() == 0)
+	 exit (EXIT_FAILURE);
+      else
+	 exit (EXIT_SUCCESS);
+      }
+
+   if (ofile == NULL)  {		/* if no -o file, synthesize a name */
+      if (strcmp(srclst->name,"-") == 0)
+         ofile = salloc(makename(buf,TargetDir,"stdin",ExecSuffix));
+      else
+         ofile = salloc(makename(buf,TargetDir,srclst->name,ExecSuffix));
+   } else {				/* add extension if necessary */
+      fp = fparse(ofile);
+      if (*fp->ext == '\0' && *ExecSuffix != '\0')
+         ofile = salloc(makename(buf,NULL,ofile,ExecSuffix));
+   }
+
+   /*
+    * Make name of intermediate C files.
+    */
+   cfile = salloc(makename(buf,TargetDir,ofile,CSuffix));
+   hfile = salloc(makename(buf,TargetDir,ofile,HSuffix));
+
+   codefile = open_out(cfile);
+   fprintf(codefile, "#include \"%s\"\n", hfile);
+
+   inclfile = open_out(hfile);
+   fprintf(inclfile, "#define COMPILER 1\n");
+
+   incl_path = (char *)alloc((unsigned int)(strlen(refpath) +
+       strlen(incl_file) + 1));
+   strcpy(incl_path, refpath);
+   strcat(incl_path, incl_file);
+   fprintf(inclfile,"#include \"%s\"\n", incl_path);
+
+   /*
+    * Translate .icn files to make C file.
+    */
+   if ((verbose > 0) && !just_type_trace)
+      report("Translating to C");
+
+   errors = trans();
+   if ((errors > 0) || just_type_trace) {	/* exit if errors seen */
+      rmfile(cfile);
+      rmfile(hfile);
+      if (errors > 0)
+	 exit(EXIT_FAILURE);
+      else exit(EXIT_SUCCESS);
+      }
+
+   fclose(codefile);
+   fclose(inclfile);
+
+   /*
+    * Compile and link C file.
+    */
+   if (no_c_comp)			/* exit if no C compile wanted */
+      exit(EXIT_SUCCESS);
+
+   if (verbose > 0)
+      report("Compiling and linking C code");
+
+   ret_code = ccomp(cfile, ofile);
+   if (ret_code == EXIT_FAILURE) {
+      fprintf(stderr, "*** C compile and link failed ***\n");
+      rmfile(ofile);
+      }
+
+   /*
+    * Finish by removing C files.
+    */
+   rmfile(cfile);
+   rmfile(hfile);
+   rmfile(makename(buf,TargetDir,cfile,ObjSuffix));
+
+   if (ret_code == EXIT_SUCCESS && optind < argc)  {
+      if (verbose > 0)
+         report("Executing");
+      execute (ofile, argv+optind+1);
+      }
+
+   return ret_code;
+   }
+
+/*
+ * execute - execute compiled Icon program
+ */
+static void execute(ofile,args)
+char *ofile, **args;
+   {
+
+   int n;
+   char **argv, **p;
+   char buf[MaxPath];			/* file name construction buffer */
+
+   ofile = salloc(makename(buf,"./",ofile,ExecSuffix));
+
+   for (n = 0; args[n] != NULL; n++)	/* count arguments */
+      ;
+   p = argv = (char **)alloc((unsigned int)((n + 2) * sizeof(char *)));
+
+   *p++ = ofile;			/* set executable file */
+
+   while (*p++ = *args++)		/* copy args into argument vector */
+      ;
+   *p = NULL;
+
+   execvp(ofile,argv);
+   quitf("could not run %s",ofile);
+   }
+
+/*
+ * Report phase.
+ */
+static void report(s)
+char *s;
+   {
+   fprintf(stderr,"%s:\n",s);
+   }
+
+/*
+ * rmfile - remove a file
+ */
+
+static void rmfile(fname)
+char *fname;
+   {
+   remove(fname);
+   }
+
+/*
+ * open_out - open a C output file and write identifying information
+ *  to the front.
+ */
+static FILE *open_out(fname)
+char *fname;
+   {
+   FILE *f;
+   static char *ident = "/*ICONC*/";
+   int c;
+   int i;
+
+   /*
+    * If the file already exists, make sure it is old output from iconc
+    *   before overwriting it. Note, this test doesn't work if the file
+    *   is writable but not readable.
+    */
+   f = fopen(fname, "r");
+   if (f != NULL) {
+      for (i = 0; i < (int)strlen(ident); ++i) {
+         c = getc(f);
+         if (c == EOF)
+             break;
+         if ((char)c != ident[i])
+            quitf("%s not in iconc format; rename or delete, and rerun", fname);
+         }
+      fclose(f);
+      }
+
+   f = fopen(fname, "w");
+   if (f == NULL)
+      quitf("cannot create %s", fname);
+   fprintf(f, "%s\n", ident); /* write "belongs to iconc" comment */
+   id_comment(f);             /* write detailed comment for human readers */
+   fflush(f);
+   return f;
+   }
+
+/*
+ * Print an error message if called incorrectly.  The message depends
+ *  on the legal options for this system.
+ */
+static void usage()
+   {
+   fprintf(stderr,"usage: %s %s file ... [-x args]\n", progname, CUsage);
+   exit(EXIT_FAILURE);
+   }
diff --git a/src/iconc/cmem.c b/src/iconc/cmem.c
new file mode 100644
index 0000000..720a495
--- /dev/null
+++ b/src/iconc/cmem.c
@@ -0,0 +1,114 @@
+/*
+ * cmem.c -- memory initialization and allocation for the translator.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+
+struct centry *chash[CHSize];		/* hash area for constant table */
+struct fentry *fhash[FHSize];		/* hash area for field table */
+struct gentry *ghash[GHSize];		/* hash area for global table */
+
+struct implement *bhash[IHSize];	/* hash area for built-in functions */
+struct implement *khash[IHSize];	/* hash area for keywords */
+struct implement *ohash[IHSize];	/* hash area for operators */
+
+struct implement *spec_op[NumSpecOp];	/* table of ops with special syntax */
+
+char pre[PrfxSz] = {'0', '0', '0'};     /* initial function name prefix */
+
+extern struct str_buf lex_sbuf;
+
+
+/*
+ * init - initialize memory for the translator
+ */
+
+void init()
+{
+   int i;
+
+   init_str();
+   init_sbuf(&lex_sbuf);
+
+   /*
+    * Zero out the hash tables.
+    */
+   for (i = 0; i < CHSize; i++)
+      chash[i] = NULL;
+   for (i = 0; i < FHSize; i++)
+      fhash[i] = NULL;
+   for (i = 0; i < GHSize; i++)
+      ghash[i] = NULL;
+   for (i = 0; i < IHSize; i++) {
+      bhash[i] = NULL;
+      khash[i] = NULL;
+      ohash[i] = NULL;
+      }
+
+   /*
+    * Clear table of operators with non-standard operator syntax.
+    */
+   for (i = 0; i < NumSpecOp; ++i)
+      spec_op[i] = NULL;
+   }
+
+/*
+ * init_proc - add a new entry on front of procedure list.
+ */
+void init_proc(name)
+char *name;
+   {
+   register struct pentry *p;
+   int i;
+   struct gentry *sym_ent;
+
+   p = NewStruct(pentry);
+   p->name = name;
+   nxt_pre(p->prefix, pre, PrfxSz);
+   p->prefix[PrfxSz] = '\0';
+   p->nargs = 0;
+   p->args = NULL;
+   p->ndynam = 0;
+   p->dynams = NULL;
+   p->nstatic = 0;
+   p->has_coexpr = 0;
+   p->statics = NULL;
+   p->ret_flag = DoesRet | DoesFail | DoesSusp; /* start out pessimistic */
+   p->arg_lst = 0;
+   p->lhash = 
+     (struct lentry **)alloc((unsigned int)((LHSize)*sizeof(struct lentry *)));
+   for (i = 0; i < LHSize; i++)
+      p->lhash[i] = NULL;
+   p->next = proc_lst;
+   proc_lst = p;
+   sym_ent = instl_p(name, F_Proc);
+   sym_ent->val.proc = proc_lst;
+   }
+
+/*
+ * init_rec - add a new entry on the front of the record list.
+ */
+void init_rec(name)
+char *name;
+   {
+   register struct rentry *r;
+   struct gentry *sym_ent;
+   static int rec_num = 0;
+
+   r = NewStruct(rentry);
+   r->name = name;
+   nxt_pre(r->prefix, pre, PrfxSz);
+   r->prefix[PrfxSz] = '\0';
+   r->rec_num = rec_num++;
+   r->nfields = 0;
+   r->fields = NULL;
+   r->next = rec_lst;
+   rec_lst = r;
+   sym_ent= instl_p(name, F_Record);
+   sym_ent->val.rec = r;
+   }
diff --git a/src/iconc/codegen.c b/src/iconc/codegen.c
new file mode 100644
index 0000000..8ca5bd1
--- /dev/null
+++ b/src/iconc/codegen.c
@@ -0,0 +1,1918 @@
+/*
+ * codegen.c - routines to write out C code.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "csym.h"
+#include "ccode.h"
+#include "ctree.h"
+#include "cproto.h"
+
+#ifndef LoopThreshold
+#define LoopThreshold 7
+#endif					/* LoopThreshold */
+
+/*
+ * MinOne - arrays sizes must be at least 1.
+ */
+#define MinOne(n) ((n) > 0 ? (n) : 1)
+
+/*
+ * ChkSeqNum - make sure a label has been given a sequence number.
+ */
+#define ChkSeqNum(x) if ((x)->SeqNum == 0) (x)->SeqNum = ++lbl_seq_num
+
+/*
+ * ChkBound - for a given procedure, signals that transfer control to a
+ *  bounding label all use the same signal number.
+ */
+#define ChkBound(x) (((x)->LabFlg & Bounding) ? bound_sig : (x))
+
+/*
+ * When a switch statement for signal handling is optimized, there
+ *  are three possible forms of default clauses.
+ */
+#define DfltNone    0   /* no default clause */
+#define DfltBrk     1   /* default is just a break */
+#define DfltRetSig  2   /* default is to return the signal from the call */
+
+/*
+ * Prototypes for static functions.
+ */
+static int     arg_nms   (struct lentry *lptr, int prt);
+static void bi_proc   (char *name, struct implement *ip);
+static void chkforgn  (int outer);
+static int     dyn_nms   (struct lentry *lptr, int prt);
+static void fldnames  (struct fldname *fields);
+static void fnc_blk   (struct gentry *gptr);
+static void frame     (int outer);
+static void good_clsg (struct code *call, int outer);
+static void initpblk  (FILE *f, int c, char *prefix, char *name,
+                           int nquals, int nparam, int ndynam, int nstatic,
+                           int frststat);
+static char  *is_builtin (struct gentry *gptr);
+static void proc_blk  (struct gentry *gptr, int init_glbl);
+static void prt_ary   (struct code *cd, int outer);
+static void prt_cond  (struct code *cond);
+static void prt_cont  (struct c_fnc *cont);
+static void prt_var   (struct lentry *var, int outer);
+static void prtcall   (struct code *call, int outer);
+static void prtcode   (struct code *cd, int outer);
+static void prtpccall (int outer);
+static void rec_blk   (struct gentry *gptr, int init_glbl);
+static void smpl_clsg (struct code *call, int outer);
+static void stat_nms  (struct lentry *lptr, int prt);
+static void val_loc   (struct val_loc *rslt, int outer);
+
+static int n_stat = -1;		/* number of static variables */
+
+/*
+ * var_dcls - produce declarations necessary to implement variables
+ *  and to initialize globals and statics: procedure blocks, procedure
+ *  frames, record blocks, declarations for globals and statics, the
+ *  C main program.
+ */
+void var_dcls()
+   {
+   register int i;
+   register struct gentry *gptr;
+   struct gentry *gbl_main;
+   struct pentry *prc_main;
+   int n_glob = 0;
+   int flag;
+   int init_glbl;
+   int first;
+   char *pfx;
+
+   /*
+    * Output initialized array of descriptors for globals.
+    */
+   fprintf(codefile, "\nstatic struct {word dword; union block *vword;}");
+   fprintf(codefile, " init_globals[NGlobals] = {\n");
+   prc_main = NULL;
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag & ~(F_Global | F_StrInv);
+         if (strcmp(gptr->name, "main") == 0 && (gptr->flag & F_Proc)) {
+            /*
+             * Remember main procedure.
+             */
+            gbl_main = gptr;
+            prc_main = gbl_main->val.proc;
+            }
+         if (flag == 0) {
+            /*
+             * Ordinary variable.
+             */
+            gptr->index = n_glob++;
+            fprintf(codefile, "   {D_Null},\n");
+            }
+         else {
+            /*
+             * Procedure, function, or record constructor. If the variable
+             *  has not been optimized away, initialize the it to reference
+             *  the procedure block.
+             */
+            if (flag & F_SmplInv) {
+               init_glbl = 0;
+               flag &= ~(uword)F_SmplInv;
+               }
+            else {
+               init_glbl = 1;
+               gptr->index = n_glob++;
+               fprintf(codefile, "   {D_Proc, ");
+               }
+            switch (flag) {
+               case F_Proc:
+                  proc_blk(gptr, init_glbl);
+                  break;
+               case F_Builtin:
+                  if (init_glbl)
+                     fnc_blk(gptr);
+                  break;
+               case F_Record:
+                  rec_blk(gptr, init_glbl);
+               }
+            }
+         }
+   if (n_glob == 0)
+      fprintf(codefile, "   {D_Null} /* place holder */\n");
+   fprintf(codefile, "   };\n");
+
+   if (prc_main == NULL) {
+      nfatal(NULL, "main procedure missing", NULL);
+      return;
+      }
+
+   /*
+    * Output array of descriptors initialized to the names of the
+    *  global variables that have not been optimized away.
+    */
+   if (n_glob == 0)
+      fprintf(codefile, "\nstruct sdescrip init_gnames[1];\n");
+   else {
+      fprintf(codefile, "\nstruct sdescrip init_gnames[NGlobals] = {\n");
+      for (i = 0; i < GHSize; i++)
+         for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink)
+            if (!(gptr->flag & F_SmplInv))
+               fprintf(codefile, "   {%d, \"%s\"},\n", strlen(gptr->name),
+                  gptr->name);
+         fprintf(codefile, "   };\n");
+      }
+
+   /*
+    * Output array of pointers to builtin functions that correspond to
+    *  names of the global variables.
+    */
+   if (n_glob == 0)
+      fprintf(codefile, "\nstruct b_proc *builtins[1];\n");
+   else {
+      fprintf(codefile, "\nstruct b_proc *builtins[NGlobals] = {\n");
+      for (i = 0; i < GHSize; i++)
+         for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink)
+            if (!(gptr->flag & F_SmplInv)) {  
+               /*
+                * Need to output *something* to stay in step with other arrays.
+                */
+               if (pfx = is_builtin(gptr)) {
+                  fprintf(codefile, "   (struct b_proc *)&BF%c%c_%s,\n",
+                     pfx[0], pfx[1], gptr->name);
+                  }
+               else
+                  fprintf(codefile, "   0,\n");
+               }
+         fprintf(codefile, "   };\n");
+      }
+
+   /*
+    * Output C main function that initializes the run-time system and
+    *  calls the main procedure.
+    */
+   fprintf(codefile, "\n");
+   fprintf(codefile, "int main(argc, argv)\n");
+   fprintf(codefile, "int argc;\n");
+   fprintf(codefile, "char **argv;\n");
+   fprintf(codefile, "   {\n");
+
+   /*
+    *  If the main procedure requires a command-line argument list, we
+    *  need a place to construct the Icon argument list.
+    */
+   if (prc_main->nargs != 0 || !(gbl_main->flag & F_SmplInv)) {
+      fprintf(codefile, "   struct {\n");
+      fprintf(codefile, "      struct tend_desc *previous;\n");
+      fprintf(codefile, "      int num;\n");
+      fprintf(codefile, "      struct descrip arg_lst;\n");
+      fprintf(codefile, "      } t;\n");
+      fprintf(codefile, "\n");
+      }
+
+   /*
+    * Produce code to initialize run-time system variables. Some depend
+    *  on compiler options.
+    */
+   fprintf(codefile, "   op_tbl = (struct b_proc *)init_op_tbl;\n");
+   fprintf(codefile, "   globals = (dptr)init_globals;\n");
+   fprintf(codefile, "   eglobals = &globals[%d];\n", n_glob);
+   fprintf(codefile, "   gnames = (dptr)init_gnames;\n");
+   fprintf(codefile, "   egnames = &gnames[%d];\n", n_glob);
+   fprintf(codefile, "   estatics = &statics[%d];\n", n_stat + 1);
+   if (debug_info)
+      fprintf(codefile, "   debug_info = 1;\n");
+   else
+      fprintf(codefile, "   debug_info = 0;\n");
+   if (line_info) {
+      fprintf(codefile, "   line_info = 1;\n");
+      fprintf(codefile, "   file_name = \"\";\n");
+      fprintf(codefile, "   line_num = 0;\n");
+      }
+   else
+      fprintf(codefile, "   line_info = 0;\n");
+   if (err_conv)
+      fprintf(codefile, "   err_conv = 1;\n");
+   else
+      fprintf(codefile, "   err_conv = 0;\n");
+   if (largeints)
+      fprintf(codefile, "   largeints = 1;\n");
+   else
+      fprintf(codefile, "   largeints = 0;\n");
+
+   /*
+    * Produce code to call the routine to initialize the runtime system.
+    */
+   if (trace)
+      fprintf(codefile, "   init(*argv, &argc, argv, -1);\n");
+   else
+      fprintf(codefile, "   init(*argv, &argc, argv, 0);\n");
+   fprintf(codefile, "\n");
+
+   /*
+    * If the main procedure requires an argument list (perhaps because
+    *  it uses standard, rather than tailored calling conventions),
+    *  set up the argument list.
+    */
+   if (prc_main->nargs != 0 || !(gbl_main->flag & F_SmplInv)) {
+      fprintf(codefile, "   t.arg_lst = nulldesc;\n");
+      fprintf(codefile, "   t.num = 1;\n");
+      fprintf(codefile, "   t.previous = NULL;\n");
+      fprintf(codefile, "   tend = (struct tend_desc *)&t;\n");
+      if (prc_main->nargs == 0)
+         fprintf(codefile,
+            "   /* main() takes no arguments: construct no list */\n"); 
+      else
+         fprintf(codefile, "   cmd_line(argc, argv, &t.arg_lst);\n");
+      fprintf(codefile, "\n");
+      }
+   else
+      fprintf(codefile, "   tend = NULL;\n");
+
+   if (gbl_main->flag & F_SmplInv) {
+      /*
+       * procedure main only has a simplified implementation if it
+       *  takes either 0 or 1 argument.
+       */
+      first = 1;
+      if (prc_main->nargs == 0)
+         fprintf(codefile, "   P%s_main(", prc_main->prefix);
+      else {
+         fprintf(codefile, "   P%s_main(&t.arg_lst", prc_main->prefix);
+         first = 0;
+         }
+      if (prc_main->ret_flag & (DoesRet | DoesSusp)) {
+         if (!first)
+            fprintf(codefile, ", ");
+         fprintf(codefile, "&trashcan");
+         first = 0;
+         }
+      if (prc_main->ret_flag & DoesSusp)
+         fprintf(codefile, ", (continuation)NULL");
+      fprintf(codefile, ");\n");
+      }
+   else /* the main procedure uses standard calling conventions */
+      fprintf(codefile,
+         "   P%s_main(1, &t.arg_lst, &trashcan, (continuation)NULL);\n",
+         prc_main->prefix);
+   fprintf(codefile, "   \n");
+   fprintf(codefile, "   c_exit(EXIT_SUCCESS);\n");
+   fprintf(codefile, "   }\n");
+
+   /*
+    * Output to header file definitions related to global and static
+    *  variables.
+    */
+   fprintf(inclfile, "\n");
+   if (n_glob == 0) {
+      fprintf(inclfile, "#define NGlobals 1\n");
+      fprintf(inclfile, "int n_globals = 0;\n");
+      }
+   else {
+      fprintf(inclfile, "#define NGlobals %d\n", n_glob);
+      fprintf(inclfile, "int n_globals = NGlobals;\n");
+      }
+   ++n_stat;
+   fprintf(inclfile, "\n");
+   fprintf(inclfile, "int n_statics = %d;\n", n_stat);
+   fprintf(inclfile, "struct descrip statics[%d]", MinOne(n_stat));
+   if (n_stat > 0)  {
+      fprintf(inclfile, " = {\n");
+      for (i = 0; i < n_stat; ++i)
+         fprintf(inclfile, "   {D_Null},\n");
+      fprintf(inclfile, "   };\n");
+      }
+   else
+      fprintf(inclfile, ";\n");
+   }
+
+/*
+ * proc_blk - create procedure block and initialize global variable, also
+ *   compute offsets for local procedure variables.
+ */
+static void proc_blk(gptr, init_glbl)
+struct gentry *gptr;
+int init_glbl;
+   {
+   struct pentry *p;
+   register char *name;
+   int nquals;
+
+   name = gptr->name;
+   p = gptr->val.proc;
+
+   /*
+    * If we don't initialize a global variable for this procedure, we
+    *  need only compute offsets for variables.
+    */
+   if (init_glbl) {
+      fprintf(codefile, "(union block *)&BP%s_%s},\n", p->prefix, name);
+      nquals = 1 + Abs(p->nargs) + p->ndynam + p->nstatic;
+      fprintf(inclfile, "\n");
+      fprintf(inclfile, "static int P%s_%s (int r_nargs, dptr r_args,",
+         p->prefix, name);
+      fprintf(inclfile, "dptr r_rslt, continuation r_s_cont);\n");
+      initpblk(inclfile, 'P', p->prefix, name, nquals, p->nargs, p->ndynam,
+         p->nstatic, n_stat + 1);
+      fprintf(inclfile, "\n   {%d, \"%s\"},\n", strlen(name), name);
+      }
+   arg_nms(p->args, init_glbl);
+   p->tnd_loc = dyn_nms(p->dynams, init_glbl);
+   stat_nms(p->statics, init_glbl);
+   if (init_glbl)
+      fprintf(inclfile, "   }};\n");
+   }
+
+/*
+ * arg_nms - compute offsets of arguments and, if needed, output the
+ *  initializer for a descriptor for the argument name.
+ */
+static int arg_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   register int n;
+
+   if (lptr == NULL)
+      return 0;
+   n = arg_nms(lptr->next, prt);
+   lptr->val.index = n;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   return n + 1;
+   }
+
+/*
+ * dyn_nms - compute offsets of dynamic locals and, if needed, output the
+ *  initializer for a descriptor for the variable name.
+ */
+static int dyn_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   register int n;
+
+   if (lptr == NULL)
+      return 0;
+   n = dyn_nms(lptr->next, prt);
+   lptr->val.index = n;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   return n + 1;
+   }
+
+/*
+ * stat_nams - compute offsets of static locals and, if needed, output the
+ *  initializer for a descriptor for the variable name.
+ */
+static void stat_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   if (lptr == NULL)
+      return;
+   stat_nms(lptr->next, prt);
+   lptr->val.index = ++n_stat;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   }
+
+/*
+ * is_builtin - check if a global names or hides a builtin, returning prefix.
+ *  If it hides one, we must also generate the prototype and block here.
+ */
+static char *is_builtin(gptr)
+struct gentry *gptr;
+   {
+   struct implement *iptr;
+
+   if (!(gptr->flag & F_StrInv))	/* if not eligible for string invoc */
+      return 0;
+   if (gptr->flag & F_Builtin)		/* if global *is* a builtin */
+      return gptr->val.builtin->prefix;
+   iptr = db_ilkup(gptr->name, bhash);
+   if (iptr == NULL)			/* if no builtin by this name */
+      return NULL;
+   bi_proc(gptr->name, iptr);		/* output prototype and proc block */
+   return iptr->prefix;
+   }
+
+/*
+ * fnc_blk - output vword of descriptor for a built-in function and its
+ *   procedure block.
+ */
+static void fnc_blk(gptr)
+struct gentry *gptr;
+   {
+   struct implement *iptr;
+   char *name, *pfx;
+   
+   name = gptr->name;
+   iptr = gptr->val.builtin;
+   pfx = iptr->prefix;
+   /*
+    * output prototype and procedure block to inclfile.
+    */
+   bi_proc(name, iptr);
+   /*
+    * vword of descriptor references the procedure block.
+    */
+   fprintf(codefile, "(union block *)&BF%c%c_%s}, \n", pfx[0], pfx[1], name);
+   }
+
+/*
+ * bi_proc - output prototype and procedure block for builtin function.
+ */
+static void bi_proc(name, ip)
+char *name;
+   struct implement *ip;
+   {
+   int nargs;
+   char prefix[3];
+
+   prefix[0] = ip->prefix[0];
+   prefix[1] = ip->prefix[1];
+   prefix[2] = '\0';
+   nargs = ip->nargs;
+   if (nargs > 0 && ip->arg_flgs[nargs - 1] & VarPrm)
+      nargs = -nargs;
+   fprintf(inclfile, "\n");
+   implproto(ip);
+   initpblk(inclfile, 'F', prefix, name, 1, nargs, -1, 0, 0);
+   fprintf(inclfile, "{%d, \"%s\"}}};\n", strlen(name), name);
+   }
+
+/*
+ * rec_blk - if needed, output vword of descriptor for a record
+ *   constructor and output its procedure block.
+ */
+static void rec_blk(gptr, init_glbl)
+struct gentry *gptr;
+int init_glbl;
+   {
+   struct rentry *r;
+   register char *name;
+   int nfields;
+
+   name = gptr->name;
+   r = gptr->val.rec;
+   nfields = r->nfields;
+
+   /*
+    * If the variable is not optimized away, output vword of descriptor.
+    */
+   if (init_glbl)
+      fprintf(codefile, "(union block *)&BR%s_%s},\n", r->prefix, name);
+
+   fprintf(inclfile, "\n");
+   /*
+    * Prototype for C function implementing constructor. If no optimizations
+    *   have been performed on the variable, the standard calling conventions
+    *   are used and we need a continuation parameter.
+    */
+   fprintf(inclfile,
+      "static int R%s_%s (int r_nargs, dptr r_args, dptr r_rslt",
+      r->prefix, name);
+   if (init_glbl)
+      fprintf(inclfile, ", continuation r_s_cont");
+   fprintf(inclfile, ");\n");
+
+   /*
+    * Procedure block, including record name and field names.
+    */
+   initpblk(inclfile, 'R', r->prefix, name, nfields + 1, nfields, -2,
+      r->rec_num, 1);
+   fprintf(inclfile, "\n   {%d, \"%s\"},\n", strlen(name), name);
+   fldnames(r->fields);
+   fprintf(inclfile, "   }};\n");
+   }
+
+
+/*
+ * fldnames - output the initializer for a descriptor for the field name.
+ */
+static void fldnames(fields)
+struct fldname *fields;
+   {
+   register char *name;
+
+   if (fields == NULL)
+      return;
+   fldnames(fields->next);
+   name = fields->name;
+   fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(name), name);
+   }
+
+/*
+ * implproto - print prototype for function implementing a run-time operation.
+ */
+void implproto(ip)
+struct implement *ip;
+   {
+   if (ip->iconc_flgs & ProtoPrint)
+      return;    /* only print prototype once */
+   fprintf(inclfile, "int %c%c%c_%s ", ip->oper_typ, ip->prefix[0],
+       ip->prefix[1], ip->name);
+   fprintf(inclfile, "(int r_nargs, dptr r_args, dptr r_rslt, ");
+   fprintf(inclfile,"continuation r_s_cont);\n");
+   ip->iconc_flgs |= ProtoPrint;
+   }
+
+/*
+ * const_blks - output blocks for cset and real constants.
+ */
+void const_blks()
+   {
+   register int i;
+   register struct centry *cptr;
+
+   fprintf(inclfile, "\n");
+   for (i = 0; i < CHSize; i++)
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr->blink) {
+         switch (cptr->flag) {
+            case F_CsetLit:
+               nxt_pre(cptr->prefix, pre, PrfxSz);
+               cptr->prefix[PrfxSz] = '\0';
+               fprintf(inclfile, "struct b_cset BDC%s = ", cptr->prefix);
+               cset_init(inclfile, cptr->u.cset);
+               break;
+            case F_RealLit:
+               nxt_pre(cptr->prefix, pre, PrfxSz);
+               cptr->prefix[PrfxSz] = '\0';
+               fprintf(inclfile, "struct b_real BDR%s = {T_Real, %s};\n",
+                   cptr->prefix, cptr->image);
+               break;
+            }
+         }
+   }
+
+/*
+ * reccnstr - output record constructors.
+ */
+void recconstr(r)
+struct rentry *r;
+   {
+   register char *name;
+   int optim;
+   int nfields;
+
+   if (r == NULL)
+      return;
+   recconstr(r->next);
+
+   name = r->name;
+   nfields = r->nfields;
+
+   /*
+    * Does this record constructor use optimized calling conventions?
+    */
+   optim = glookup(name)->flag & F_SmplInv;
+
+   fprintf(codefile, "\n");
+   fprintf(codefile, "static int R%s_%s(r_nargs, r_args, r_rslt", r->prefix,
+      name);
+   if (!optim)
+      fprintf(codefile, ", r_s_cont");  /* continuation is passed */
+   fprintf(codefile, ")\n");
+   fprintf(codefile, "int r_nargs;\n");
+   fprintf(codefile, "dptr r_args;\n");
+   fprintf(codefile, "dptr r_rslt;\n");
+   if (!optim)
+      fprintf(codefile, "continuation r_s_cont;\n");
+   fprintf(codefile, "   {\n");
+   fprintf(codefile, "   register int i;\n");
+   fprintf(codefile, "   register struct b_record *rp;\n");
+   fprintf(codefile, "\n");
+   fprintf(codefile, "   rp = alcrecd(%d, (union block *)&BR%s_%s);\n",
+      nfields, r->prefix, name);
+   fprintf(codefile, "   if (rp == NULL) {\n");
+   fprintf(codefile, "      err_msg(307, NULL);\n");
+   if (err_conv)
+      fprintf(codefile, "      return A_Resume;\n");
+   fprintf(codefile, "      }\n");
+   fprintf(codefile, "   for (i = %d; i >= 0; i--)\n", nfields - 1);
+   fprintf(codefile, "      if (i < r_nargs)\n");
+   fprintf(codefile, "         deref(&r_args[i], &rp->fields[i]);\n");
+   fprintf(codefile, "      else\n");
+   fprintf(codefile, "         rp->fields[i] = nulldesc;\n");
+   fprintf(codefile, "   r_rslt->vword.bptr = (union block *)rp;\n");
+   fprintf(codefile, "   r_rslt->dword = D_Record;\n");
+   fprintf(codefile, "   return A_Continue;\n");
+   fprintf(codefile, "   }\n");
+   }
+
+/*
+ * outerfnc - output code for the outer function implementing a procedure.
+ */
+void outerfnc(fnc)
+struct c_fnc *fnc;
+   {
+   char *prefix;
+   char *name;
+   char *cnt_var;
+   char *sep;
+   int ntend;
+   int first_arg;
+   int nparms;
+   int optim; /* optimized interface: no arg list adjustment */
+   int ret_flag;
+#ifdef OptimizeLoop
+   int i;
+#endif					/* OptimizeLoop */
+
+   prefix = cur_proc->prefix;
+   name = cur_proc->name;
+   ntend = cur_proc->tnd_loc + num_tmp;
+   ChkPrefix(fnc->prefix);
+   optim = glookup(name)->flag & F_SmplInv;
+   nparms = Abs(cur_proc->nargs);
+   ret_flag = cur_proc->ret_flag;
+
+   fprintf(codefile, "\n");
+   if (optim) {
+      /*
+       * Arg list adjustment and dereferencing are done at call site.
+       *  Use simplified interface. Output both function header and
+       *  prototype.
+       */
+      sep = "";
+      fprintf(inclfile, "static int P%s_%s (", prefix, name);
+      fprintf(codefile, "static int P%s_%s(", prefix, name);
+      if (nparms != 0) {
+         fprintf(inclfile, "dptr r_args");
+         fprintf(codefile, "r_args");
+         sep = ", ";
+         }
+      if (ret_flag & (DoesRet | DoesSusp)) {
+         fprintf(inclfile, "%sdptr r_rslt", sep);
+         fprintf(codefile, "%sr_rslt", sep);
+         sep = ", ";
+         }
+      if (ret_flag & DoesSusp) {
+         fprintf(inclfile, "%scontinuation r_s_cont", sep);
+         fprintf(codefile, "%sr_s_cont", sep);
+         sep = ", ";
+         }
+      if (*sep == '\0')
+         fprintf(inclfile, "void");
+      fprintf(inclfile, ");\n");
+      fprintf(codefile, ")\n");
+      if (nparms != 0)
+         fprintf(codefile, "dptr r_args;\n");
+      if (ret_flag & (DoesRet | DoesSusp))
+         fprintf(codefile, "dptr r_rslt;\n");
+      if (ret_flag & DoesSusp)
+         fprintf(codefile, "continuation r_s_cont;\n");
+      }
+   else {
+      /*
+       * General invocation interface. Output function header; prototype has
+       *  already been produced.
+       */
+      fprintf(codefile,
+         "static int P%s_%s(r_nargs, r_args, r_rslt, r_s_cont)\n", prefix,
+         name);
+      fprintf(codefile, "int r_nargs;\n");
+      fprintf(codefile, "dptr r_args;\n");
+      fprintf(codefile, "dptr r_rslt;\n");
+      fprintf(codefile, "continuation r_s_cont;\n");
+      }
+
+   fprintf(codefile, "{\n");
+   fprintf(codefile, "   struct PF%s_%s r_frame;\n", prefix, name);
+   fprintf(codefile, "   register int r_signal;\n");
+   fprintf(codefile, "   int i;\n");
+   if (Type(Tree1(cur_proc->tree)) != N_Empty)
+      fprintf(codefile, "   static int first_time = 1;");
+   fprintf(codefile, "\n");
+   fprintf(codefile, "   r_frame.old_pfp = pfp;\n");
+   fprintf(codefile, "   pfp = (struct p_frame *)&r_frame;\n");
+   fprintf(codefile, "   r_frame.old_argp = glbl_argp;\n");
+   if (!optim || ret_flag & (DoesRet | DoesSusp))
+      fprintf(codefile, "   r_frame.rslt = r_rslt;\n");
+   else
+      fprintf(codefile, "   r_frame.rslt = NULL;\n");
+   if (!optim || ret_flag & DoesSusp)
+      fprintf(codefile, "   r_frame.succ_cont = r_s_cont;\n");
+   else
+      fprintf(codefile, "   r_frame.succ_cont = NULL;\n");
+   fprintf(codefile, "\n");
+#ifdef OptimizeLoop
+   if (ntend > 0)  {
+      if (ntend < LoopThreshold)
+         for (i=0; i < ntend ;i++)  
+            fprintf(codefile, "   r_frame.tend.d[%d] = nulldesc;\n", i);
+      else {
+         fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", ntend);
+         fprintf(codefile, "      r_frame.tend.d[i] = nulldesc;\n");
+      }
+   }
+#else					/* OptimizeLoop */
+   fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", ntend);
+   fprintf(codefile, "      r_frame.tend.d[i] = nulldesc;\n");
+#endif					/* OptimizeLoop */
+   if (optim) {
+      /*
+       * Dereferencing and argument list adjustment is done at the call
+       *  site. There is not much to do here.
+       */
+      if (nparms == 0)
+         fprintf(codefile, "   glbl_argp = NULL;\n");
+      else
+         fprintf(codefile, "   glbl_argp = r_args;\n");
+      }
+   else {
+      /*
+       * Dereferencing and argument list adjustment must be done by
+       *  the procedure itself.
+       */
+      first_arg = ntend;
+      ntend += nparms;
+      if (cur_proc->nargs < 0) {
+         /*
+          * varargs - construct a list into the last argument.
+          */
+         nparms -= 1;
+         if (nparms == 0)
+            cnt_var = "r_nargs";
+         else {
+            fprintf(codefile, "   i = r_nargs - %d;\n", nparms);
+            cnt_var = "i";
+            }
+         fprintf(codefile,"   if (%s <= 0)\n", cnt_var);
+         fprintf(codefile,"       varargs(NULL, 0, &r_frame.tend.d[%d]);\n",
+            first_arg + nparms);
+         fprintf(codefile,"   else\n");
+         fprintf(codefile,
+            "       varargs(&r_args[%d], %s, &r_frame.tend.d[%d]);\n", nparms,
+            cnt_var, first_arg + nparms);
+         }
+      if (nparms > 0) {
+         /*
+          * Output code to dereference argument or supply default null
+          *  value.
+          */
+#ifdef OptimizeLoop
+         fprintf(codefile, "   for (i = 0; i < r_nargs ; ++i)\n");
+         fprintf(codefile, "      deref(&r_args[i], &r_frame.tend.d[i + %d]);\n",  first_arg);
+         fprintf(codefile, "   for(i = r_nargs; i < %d ; ++i)\n", nparms);
+         fprintf(codefile, "      r_frame.tend.d[i + %d] = nulldesc;\n",
+            first_arg);
+#else					/* OptimizeLoop */
+         fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", nparms);
+         fprintf(codefile, "      if (i < r_nargs)\n");
+         fprintf(codefile,
+            "         deref(&r_args[i], &r_frame.tend.d[i + %d]);\n",
+            first_arg);
+         fprintf(codefile, "      else\n");
+         fprintf(codefile, "         r_frame.tend.d[i + %d] = nulldesc;\n",
+            first_arg);
+#endif					/* OptimizeLoop */
+         }
+      fprintf(codefile, "   glbl_argp = &r_frame.tend.d[%d];\n", first_arg);
+      }
+   fprintf(codefile, "   r_frame.tend.num = %d;\n", ntend);
+   fprintf(codefile, "   r_frame.tend.previous = tend;\n");
+   fprintf(codefile, "   tend = (struct tend_desc *)&r_frame.tend;\n");
+   if (line_info) {
+      fprintf(codefile, "   r_frame.debug.old_line = line_num;\n");
+      fprintf(codefile, "   r_frame.debug.old_fname = file_name;\n");
+      }
+   if (debug_info) {
+      fprintf(codefile, "   r_frame.debug.proc = (struct b_proc *)&BP%s_%s;\n",
+         prefix, name);
+      fprintf(codefile, "   if (k_trace) ctrace();\n");
+      fprintf(codefile, "   ++k_level;\n\n");
+      }
+   fprintf(codefile, "\n");
+
+   /*
+    * Output definition for procedure frame.
+    */
+   prt_frame(prefix, ntend, num_itmp, num_dtmp, num_sbuf, num_cbuf);
+
+   /*
+    * Output code to implement procedure body.
+    */
+   prtcode(&(fnc->cd), 1);
+   fprintf(codefile, "   }\n");
+   }
+
+/*
+ * prt_fnc - output C function that implements a continuation.
+ */
+void prt_fnc(fnc)
+struct c_fnc *fnc;
+   {
+   struct code *sig;
+   char *name;
+   char *prefix;
+
+   if (fnc->flag & CF_SigOnly) {
+      /*
+       * This function only returns a signal. A shared function is used in
+       *  its place. Make sure that function has been printed.
+       */
+      sig = fnc->cd.next->SigRef->sig;
+      if (sig->cd_id != C_Resume) {
+         sig = ChkBound(sig);
+         if (!(sig->LabFlg & FncPrtd)) {
+            ChkSeqNum(sig);
+            fprintf(inclfile, "static int sig_%d (void);\n",
+               sig->SeqNum);
+   
+            fprintf(codefile, "\n");
+            fprintf(codefile, "static int sig_%d()\n", sig->SeqNum);
+            fprintf(codefile, "   {\n");
+            fprintf(codefile, "   return %d; /* %s */\n", sig->SeqNum,
+               sig->Desc);
+            fprintf(codefile, "   }\n");
+            sig->LabFlg |= FncPrtd;
+            }
+         }
+      }
+   else {
+      ChkPrefix(fnc->prefix);
+      prefix = fnc->prefix;
+      name = cur_proc->name;
+   
+      fprintf(inclfile, "static int P%s_%s (void);\n", prefix, name);
+   
+      fprintf(codefile, "\n");
+      fprintf(codefile, "static int P%s_%s()\n", prefix, name);
+      fprintf(codefile, "   {\n");
+      if (fnc->flag & CF_Coexpr)
+         fprintf(codefile, "#ifdef Coexpr\n");
+   
+      prefix = fnc->frm_prfx;
+   
+      fprintf(codefile, "   register int r_signal;\n");
+      fprintf(codefile, "   register struct PF%s_%s *r_pfp;\n", prefix, name);
+      fprintf(codefile, "\n");
+      fprintf(codefile, "   r_pfp  = (struct PF%s_%s *)pfp;\n", prefix, name);
+      prtcode(&(fnc->cd), 0);
+      if (fnc->flag & CF_Coexpr) {
+         fprintf(codefile, "#else\t\t\t\t\t/* Coexpr */\n");
+         fprintf(codefile, "   fatalerr(401, NULL);\n");
+         fprintf(codefile, "#endif\t\t\t\t\t/* Coexpr */\n");
+         }
+      fprintf(codefile, "   }\n");
+      }
+   }
+
+/*
+ * prt_frame - output the definition for a procedure frame.
+ */
+void prt_frame(prefix, ntend, n_itmp, n_dtmp, n_sbuf, n_cbuf)
+char *prefix;
+int ntend;
+int n_itmp;
+int n_dtmp;
+int n_sbuf;
+int n_cbuf;
+   {
+   int i;
+
+   /*
+    * Output standard part of procedure frame including tended
+    *  descriptors.
+     */
+   fprintf(inclfile, "\n");
+   fprintf(inclfile, "struct PF%s_%s {\n", prefix, cur_proc->name);
+   fprintf(inclfile, "   struct p_frame *old_pfp;\n");
+   fprintf(inclfile, "   dptr old_argp;\n");
+   fprintf(inclfile, "   dptr rslt;\n");
+   fprintf(inclfile, "   continuation succ_cont;\n");
+   fprintf(inclfile, "   struct {\n");
+   fprintf(inclfile, "      struct tend_desc *previous;\n");
+   fprintf(inclfile, "      int num;\n");
+   fprintf(inclfile, "      struct descrip d[%d];\n", MinOne(ntend));
+   fprintf(inclfile, "      } tend;\n");
+
+   if (line_info) {       /* must be true if debug_info is true */
+      fprintf(inclfile, "   struct debug debug;\n");
+      }
+
+   /*
+    * Output declarations for the integer, double, string buffer,
+    *  and cset buffer work areas of the frame.
+    */
+   for (i = 0; i < n_itmp; ++i)
+      fprintf(inclfile, "   word i%d;\n", i);
+   for (i = 0; i < n_dtmp; ++i)
+      fprintf(inclfile, "   double d%d;\n", i);
+   if (n_sbuf > 0)
+      fprintf(inclfile, "   char sbuf[%d][MaxCvtLen];", n_sbuf);
+   if (n_cbuf > 0)
+      fprintf(inclfile, "   struct b_cset cbuf[%d];", n_cbuf);
+   fprintf(inclfile, "   };\n");
+   }
+
+/*
+ * prtcode - print a list of C code.
+ */
+static void prtcode(cd, outer)
+struct code *cd;
+int outer;
+   {
+   struct lentry *var;
+   struct centry *lit;
+   struct code *sig;
+   int n;
+
+   for ( ; cd != NULL; cd = cd->next) {
+      switch (cd->cd_id) {
+         case C_Null:
+            break;
+
+         case C_NamedVar:
+            /*
+             * Construct a reference to a named variable in a result
+             *  location.
+             */
+            var = cd->NamedVar;
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".dword = D_Var;\n");
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".vword.descptr = &");
+            prt_var(var, outer);
+            fprintf(codefile, ";\n");
+            break;
+
+         case C_CallSig:
+            /*
+             * Call to C function that returns a signal along with signal
+             *   handling code.
+             */
+            if (opt_sgnl)
+               good_clsg(cd, outer);
+            else
+               smpl_clsg(cd, outer);
+            break;
+
+         case C_RetSig:
+            /*
+             * Return a signal.
+             */
+            sig = cd->SigRef->sig;
+            if (sig->cd_id == C_Resume)
+               fprintf(codefile, "   return A_Resume;\n");
+            else {
+               sig = ChkBound(sig);
+               ChkSeqNum(sig);
+               fprintf(codefile, "   return %d; /* %s */\n", sig->SeqNum,
+                  sig->Desc);
+               }
+            break;
+
+         case C_Goto:
+            /*
+             * goto label.
+             */
+            ChkSeqNum(cd->Lbl);
+            fprintf(codefile, "   goto L%d /* %s */;\n", cd->Lbl->SeqNum, 
+               cd->Lbl->Desc);
+            break;
+
+         case C_Label:
+            /*
+             * numbered label.
+             */
+            if (cd->RefCnt > 0) {
+               ChkSeqNum(cd);
+               fprintf(codefile, "L%d: ; /* %s */\n", cd->SeqNum, cd->Desc);
+               }
+            break;
+
+         case C_Lit:
+            /*
+             * Assign literal value to a result location.
+             */
+            lit = cd->Literal;
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            switch (lit->flag) {
+               case F_CsetLit:
+                  fprintf(codefile, ".dword = D_Cset;\n");
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".vword.bptr = (union block *)&BDC%s;\n",
+                     lit->prefix);
+                  break;
+               case F_IntLit:
+                  if (lit->u.intgr == -1) {
+                     /*
+                      * Large integer literal - output string and convert
+                      *  to integer.
+                      */
+                     fprintf(codefile, ".vword.sptr = \"%s\";\n", lit->image);
+                     fprintf(codefile, "   ");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ".dword = %d;\n", strlen(lit->image));
+                     fprintf(codefile, "   cnv_int(&");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ", &");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ");\n");
+                     }
+                  else {
+                     /*
+                      * Ordinary integer literal.
+                      */
+                     fprintf(codefile, ".dword = D_Integer;\n");
+                     fprintf(codefile, "   ");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ".vword.integr = %ld;\n", lit->u.intgr);
+                     }
+                  break;
+               case F_RealLit:
+                  fprintf(codefile, ".dword = D_Real;\n");
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".vword.bptr = (union block *)&BDR%s;\n",
+                     lit->prefix);
+                  break;
+               case F_StrLit:
+                  fprintf(codefile, ".vword.sptr = ");
+                  if (lit->length ==  0) {
+                     /*
+                      * Placing an empty string at the end of the string region
+                      *  allows some concatenation optimizations at run time.
+                      */
+                     fprintf(codefile, "strfree;\n");
+                     n = 0;
+                     }
+                  else {
+                     fprintf(codefile, "\"");
+                     n = prt_i_str(codefile, lit->image, lit->length);
+                     fprintf(codefile, "\";\n");
+                     }
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".dword = %d;\n", n);
+                  break;
+               }
+            break;
+
+         case C_PFail:
+            /*
+             * Procedure failure - this code occurs once near the end of
+             *  the procedure.
+             */
+            if (debug_info) {
+               fprintf(codefile, "   --k_level;\n");
+               fprintf(codefile, "   if (k_trace) failtrace();\n");
+               }
+            fprintf(codefile, "   tend = r_frame.tend.previous;\n");
+            fprintf(codefile, "   pfp = r_frame.old_pfp;\n");
+            fprintf(codefile, "   glbl_argp = r_frame.old_argp;\n");
+            if (line_info) {
+               fprintf(codefile, "   line_num = r_frame.debug.old_line;\n");
+               fprintf(codefile, "   file_name = r_frame.debug.old_fname;\n");
+               }
+            fprintf(codefile, "   return A_Resume;\n");
+            break;
+
+         case C_PRet:
+            /*
+             * Procedure return - this code occurs once near the end of
+             *  the procedure.
+             */
+            if (debug_info) {
+               fprintf(codefile, "   --k_level;\n");
+               fprintf(codefile, "   if (k_trace) rtrace();\n");
+               }
+            fprintf(codefile, "   tend = r_frame.tend.previous;\n");
+            fprintf(codefile, "   pfp = r_frame.old_pfp;\n");
+            fprintf(codefile, "   glbl_argp = r_frame.old_argp;\n");
+            if (line_info) {
+               fprintf(codefile, "   line_num = r_frame.debug.old_line;\n");
+               fprintf(codefile, "   file_name = r_frame.debug.old_fname;\n");
+               }
+            fprintf(codefile, "   return A_Continue;\n");
+            break;
+
+         case C_PSusp:
+            /*
+             * Procedure suspend - call success continuation.
+             */
+            prtpccall(outer);
+            break;
+
+         case C_Break:
+            fprintf(codefile, "   break;\n");
+            break;
+
+         case C_If:
+            /*
+             * C if statement.
+             */
+            fprintf(codefile, "   if (");
+            prt_ary(cd->Cond, outer);
+            fprintf(codefile, ")\n   ");
+            prtcode(cd->ThenStmt, outer);
+            break;
+
+         case C_CdAry:
+            /*
+             * Array of code fragments.
+             */
+            fprintf(codefile, "   ");
+            prt_ary(cd, outer);
+            fprintf(codefile, "\n");
+            break;
+
+         case C_LBrack:
+            fprintf(codefile, "   {\n");
+            break;
+
+         case C_RBrack:
+            fprintf(codefile, "   }\n");
+            break;
+
+         case C_Create:
+            /*
+             * Code to create a co-expression and assign it to a result
+             *  location.
+             */
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile , ".vword.bptr = (union block *)create(");
+            prt_cont(cd->Cont);
+            fprintf(codefile,
+               ", (struct b_proc *)&BP%s_%s, %d, sizeof(word) * %d);\n",
+               cur_proc->prefix, cur_proc->name, cd->NTemps, cd->WrkSize);
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".dword = D_Coexpr;\n");
+            break;
+
+         case C_SrcLoc:
+            /*
+             * Update file name and line number information.
+             */
+            if (cd->FileName != NULL) {
+               fprintf(codefile, "   file_name = \"");
+               prt_i_str(codefile, cd->FileName, strlen(cd->FileName));
+               fprintf(codefile, "\";\n");
+               }
+            if (cd->LineNum != 0)
+               fprintf(codefile, "   line_num = %d;\n", cd->LineNum);
+            break;
+         }
+      }
+   }
+
+/*
+ * prt_var - output C code to reference an Icon named variable.
+ */
+static void prt_var(var, outer)
+struct lentry *var;
+int outer;
+   {
+   switch (var->flag) {
+      case F_Global:
+         fprintf(codefile, "globals[%d]", var->val.global->index);
+         break;
+      case F_Static:
+         fprintf(codefile, "statics[%d]", var->val.index);
+         break;
+      case F_Dynamic:
+         frame(outer);
+         fprintf(codefile, ".tend.d[%d]", var->val.index);
+         break;
+      case F_Argument:
+         fprintf(codefile, "glbl_argp[%d]", var->val.index);
+         }
+
+   /*
+    * Include an identifying comment.
+    */
+   fprintf(codefile, " /* %s */", var->name);
+   }
+
+/*
+ * prt_ary - print an array of code fragments.
+ */
+static void prt_ary(cd, outer)
+struct code *cd;
+int outer;
+   {
+   int i;
+
+   for (i = 0; cd->ElemTyp(i) != A_End; ++i)
+      switch (cd->ElemTyp(i)) {
+         case A_Str:
+            /*
+             * Simple C code in a string.
+             */
+            fprintf(codefile, "%s", cd->Str(i));
+            break;
+         case A_ValLoc:
+            /*
+             * Value location (usually variable of some sort).
+             */
+            val_loc(cd->ValLoc(i), outer);
+            break;
+         case A_Intgr:
+            /*
+             * Integer.
+             */
+            fprintf(codefile, "%d", cd->Intgr(i));
+            break;
+         case A_ProcCont:
+            /*
+             * Current procedure call's success continuation.
+             */
+            if (outer)
+               fprintf(codefile, "r_s_cont");
+            else
+               fprintf(codefile, "r_pfp->succ_cont");
+            break;
+         case A_SBuf:
+            /*
+             * One of the string buffers.
+             */
+            frame(outer);
+            fprintf(codefile, ".sbuf[%d]", cd->Intgr(i));
+            break;
+         case A_CBuf:
+            /*
+             * One of the cset buffers.
+             */
+            fprintf(codefile, "&(");
+            frame(outer);
+            fprintf(codefile, ".cbuf[%d])", cd->Intgr(i));
+            break;
+         case A_Ary:
+            /*
+             * A subarray of code fragments.
+             */
+            prt_ary(cd->Array(i), outer);
+            break;
+         }
+   }
+
+/*
+ * frame - access to the procedure frame. Access directly from outer function,
+ *   but access through r_pfp from a continuation.
+ */
+static void frame(outer)
+int outer;
+   {
+   if (outer)
+      fprintf(codefile, "r_frame");
+   else
+      fprintf(codefile, "(*r_pfp)");
+   }
+
+/*
+ * prtpccall - print procedure continuation call.
+ */
+static void prtpccall(outer)
+int outer;
+   {
+   int first_arg;
+   int optim; /* optimized interface: no arg list adjustment */
+
+   first_arg = cur_proc->tnd_loc + num_tmp;
+   optim = glookup(cur_proc->name)->flag & F_SmplInv;
+
+   /*
+    * The only signal to be handled in this procedure is
+    *  resumption, the rest must be passed on.
+    */
+   if (cur_proc->nargs != 0 && optim && !outer) {
+      fprintf(codefile, "   {\n");
+      fprintf(codefile, "   dptr r_argp_sav;\n");
+      fprintf(codefile, "\n");
+      fprintf(codefile, "   r_argp_sav = glbl_argp;\n");
+      }
+   if (debug_info) {
+      fprintf(codefile, "   --k_level;\n");
+      fprintf(codefile, "   if (k_trace) strace();\n");
+      }
+   fprintf(codefile, "   pfp = ");
+   frame(outer);
+   fprintf(codefile, ".old_pfp;\n");
+   fprintf(codefile, "   glbl_argp = ");
+   frame(outer);
+   fprintf(codefile, ".old_argp;\n");
+   if (line_info) {
+      fprintf(codefile, "   line_num = ");
+      frame(outer);
+      fprintf(codefile, ".debug.old_line;\n");
+      fprintf(codefile, "   file_name = ");
+      frame(outer);
+      fprintf(codefile , ".debug.old_fname;\n");
+      }
+   fprintf(codefile, "   r_signal = (*");
+   if (outer)
+      fprintf(codefile, "r_s_cont)();\n");
+   else
+      fprintf(codefile, "r_pfp->succ_cont)();\n");
+   fprintf(codefile, "   if (r_signal != A_Resume) {\n");
+   if (outer)
+      fprintf(codefile, "      tend = r_frame.tend.previous;\n");
+   fprintf(codefile, "      return r_signal;\n");
+   fprintf(codefile, "      }\n");
+   fprintf(codefile, "   pfp = (struct p_frame *)&");
+   frame(outer);
+   fprintf(codefile, ";\n");
+   if (cur_proc->nargs == 0)
+      fprintf(codefile, "   glbl_argp = NULL;\n");
+   else {
+      if (optim) {
+         if (outer)
+            fprintf(codefile, "   glbl_argp = r_args;\n");
+         else
+            fprintf(codefile, "   glbl_argp = r_argp_sav;\n");
+         }
+      else {
+         fprintf(codefile, "   glbl_argp = &");
+         if (outer)
+            fprintf(codefile, "r_frame.");
+         else
+            fprintf(codefile, "r_pfp->");
+         fprintf(codefile, "tend.d[%d];\n", first_arg);
+         }
+      }
+   if (debug_info) {
+      fprintf(codefile, "   if (k_trace) atrace();\n");
+      fprintf(codefile, "   ++k_level;\n");
+      }
+   if (cur_proc->nargs != 0 && optim && !outer)
+      fprintf(codefile, "   }\n");
+   }
+
+/*
+ * smpl_clsg - print call and signal handling code, but nothing fancy.
+ */
+static void smpl_clsg(call, outer)
+struct code *call;
+int outer;
+   {
+   struct sig_act *sa;
+
+   fprintf(codefile, "   r_signal = ");
+   prtcall(call, outer);
+   fprintf(codefile, ";\n");
+   if (call->Flags & ForeignSig)
+       chkforgn(outer);
+   fprintf(codefile, "   switch (r_signal) {\n");
+   for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+      fprintf(codefile, "      case ");
+      prt_cond(sa->sig);
+      fprintf(codefile, ":\n      ");
+      prtcode(sa->cd, outer);
+      }
+   fprintf(codefile, "      }\n");
+   }
+
+/*
+ * chkforgn - produce code to see if the current signal belongs to a
+ *   procedure higher up the call chain and pass it along if it does.
+ */
+static void chkforgn(outer)
+int outer;
+   {
+   fprintf(codefile, "   if (pfp != (struct p_frame *)");
+   if (outer) {
+      fprintf(codefile, "&r_frame) {\n");
+      fprintf(codefile, "      tend = r_frame.tend.previous;\n");
+      }
+   else
+      fprintf(codefile, "r_pfp) {\n");
+   fprintf(codefile, "      return r_signal;\n");
+   fprintf(codefile, "      }\n");
+   }
+
+/*
+ * good_clsg - print call and signal handling code and do a good job.
+ */
+static void good_clsg(call, outer)
+struct code *call;
+int outer;
+   {
+   struct sig_act *sa, *sa1, *nxt_sa;
+   int ncases;   /* the number of cases - each may have multiple case labels */
+   int ncaselbl; /* the number of case labels */
+   int nbreak;   /* the number of cases that just break out of the switch */
+   int nretsig;  /* the number of cases that just pass along signal */
+   int sig_var;
+   int dflt;
+   struct code *cond;
+   struct code *then_cd;
+   
+   /*
+    * Decide whether to use "break;", "return r_signal;", or nothing as
+    *  the default case.
+    */
+   nretsig = 0;
+   nbreak = 0;
+   for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+      if (sa->cd->cd_id == C_RetSig && sa->sig == sa->cd->SigRef->sig) {
+         /*
+          * The action returns the same signal detected by this case.
+          */
+         ++nretsig;
+         }
+      else if (sa->cd->cd_id == C_Break) {
+         cond = sa->sig;   /* if there is only one break, we may want this */
+         ++nbreak;
+         }
+      }
+   dflt = DfltNone;
+   ncases = 0;
+   if (nbreak > 0 && nbreak >= nretsig)  {
+      /*
+       * There are at least as many "break;"s as "return r_signal;"s, so
+       *  use "break;" for default clause.
+       */
+      dflt = DfltBrk;
+      ncases = 1;
+      }
+   else if (nretsig > 1) {
+      /*
+       * There is more than one case that returns the same signal it
+       *  detects and there are more of them than "break;"s, to make
+       *  "return r_signal;" the default clause.
+       */
+      dflt = DfltRetSig;
+      ncases = 1;
+      }
+
+   /*
+    * Gather case labels together for each case, ignoring cases that
+    *  fall under the default. This involves constructing a new
+    *  improved call->SigActs list.
+    */
+   ncaselbl = ncases;
+   sa = call->SigActs;
+   call->SigActs = NULL;
+   for ( ; sa != NULL; sa = nxt_sa) {
+      nxt_sa = sa->next;
+      /*
+       * See if we have already found a case with the same action.
+       */
+      sa1 = call->SigActs;
+      switch (sa->cd->cd_id) {
+         case C_Break:
+            if (dflt == DfltBrk)
+               continue;
+            while (sa1 != NULL && sa1->cd->cd_id != C_Break)
+               sa1 = sa1->next;
+            break;
+         case C_RetSig:
+            if (dflt == DfltRetSig && sa->cd->SigRef->sig == sa->sig)
+               continue;
+            while (sa1 != NULL && (sa1->cd->cd_id != C_RetSig ||
+                sa1->cd->SigRef->sig != sa->cd->SigRef->sig))
+               sa1 = sa1->next;
+            break;
+         default: /* C_Goto */
+            while (sa1 != NULL && (sa1->cd->cd_id != C_Goto ||
+                sa1->cd->Lbl != sa->cd->Lbl))
+               sa1 = sa1->next;
+            break;
+            }
+      ++ncaselbl;
+      if (sa1 == NULL) {
+         /*
+          * First time we have seen this action, create a new case.
+          */
+         ++ncases;
+         sa->next = call->SigActs;
+         call->SigActs = sa;
+         }
+      else {
+         /*
+          * We can share the action of another case label.
+          */
+         sa->shar_act = sa1->shar_act;
+         sa1->shar_act = sa;
+         }
+      }
+
+   /*
+    * If we might receive a "foreign" signal that belongs to a procedure
+    *  further down the call chain, put the signal in "r_signal" then
+    *  check for this condition.
+    */
+   sig_var = 0;
+   if (call->Flags & ForeignSig) {
+      fprintf(codefile, "   r_signal = ");
+      prtcall(call, outer);
+      fprintf(codefile, ";\n");
+      chkforgn(outer);
+      sig_var = 1;
+      }
+
+   /*
+    * Determine the best way to handle the signal returned from the call.
+    */
+   if (ncases == 0) {
+      /*
+       * Any further signal checking has been optimized away. Execution
+       *  just falls through to subsequent code. If the call has not
+       *  been done, do it.
+       */
+      if (!sig_var) {
+         fprintf(codefile, "   ");
+         prtcall(call, outer);
+         fprintf(codefile, ";\n");
+         }
+      }
+   else if (ncases == 1) {
+      if (dflt == DfltRetSig || ncaselbl == nretsig) {
+         /*
+          * All this call does is pass the signal on. See if we have
+          *  done the call yet.
+          */
+         if (sig_var)
+            fprintf(codefile, "   return r_signal;");
+         else {
+            fprintf(codefile, "   return ");
+            prtcall(call, outer);
+            fprintf(codefile, ";\n");
+            }
+         }
+      else {
+         /*
+          * We know what to do without looking at the signal. Make sure
+          *  we have done the call. If the action is not simply  "break"
+          *  out signal checking, execute it. 
+          */
+         if (!sig_var) {
+            fprintf(codefile, "   ");
+            prtcall(call, outer);
+            fprintf(codefile, ";\n");
+            }
+         if (dflt != DfltBrk)
+            prtcode(call->SigActs->cd, outer);
+         }
+      }
+   else {
+      /*
+       * We have at least two cases. If we have a default action of returning
+       *  the signal without looking at it, make sure it is in "r_signal".
+       */
+      if (!sig_var && dflt == DfltRetSig) {
+         fprintf(codefile, "   r_signal = ");
+         prtcall(call, outer);
+         fprintf(codefile, ";\n");
+         sig_var = 1;
+         }
+      
+      if (ncaselbl == 2) {
+         /*
+          * We can use an if statement. If we need the signal in "r_signal",
+          *  it is already there.
+          */
+         fprintf(codefile, "   if (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+   
+         cond = call->SigActs->sig;
+         then_cd = call->SigActs->cd;
+            
+         /*
+          * If the "then" clause is a no-op ("break;" from a switch),
+          *  prepare to eliminate it by reversing the test in the
+          *  condition.
+          */
+         if (then_cd->cd_id == C_Break)
+            fprintf(codefile, " != ");
+         else
+            fprintf(codefile, " == ");
+   
+         prt_cond(cond);
+         fprintf(codefile, ")\n   ");
+   
+         if (then_cd->cd_id == C_Break) {
+            /*
+             * We have reversed the test, so we need to use the default
+             *  code. However, because a "break;" exists and it is not
+             *  default, "return r_signal;" must be the default.
+             */
+            fprintf(codefile, "   return r_signal;\n");
+            }
+         else {
+            /*
+             * Print the "then" clause and determine what the "else" clause
+             *  is.
+             */
+            prtcode(then_cd, outer);
+            if (call->SigActs->next != NULL) {
+               fprintf(codefile, "   else\n   ");
+               prtcode(call->SigActs->next->cd, outer);
+               }
+            else if (dflt == DfltRetSig) {
+               fprintf(codefile, "   else\n");
+               fprintf(codefile, "       return r_signal;\n");
+               }
+            }
+         }
+      else if (ncases == 2 && nbreak == 1) {
+         /*
+          * We can use an if-then statement with a negated test. Note,
+          *  the non-break case is not "return r_signal" or we would have
+          *  ncaselbl = 2, making the last test true. This also means that
+          *  break is the default (the break condition was saved).
+          */
+         fprintf(codefile, "   if (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+         fprintf(codefile, " != ");
+         prt_cond(cond);
+         fprintf(codefile, ") {\n   ");
+         prtcode(call->SigActs->cd, outer);
+         fprintf(codefile, "      }\n");
+         }
+      else {
+         /*
+          * We must use a full case statement. If we need the signal in
+          *  "r_signal", it is already there.
+          */
+         fprintf(codefile, "   switch (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+         fprintf(codefile, ") {\n");
+   
+         /*
+          * Print the cases
+          */
+         for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+            for (sa1 = sa; sa1 != NULL; sa1 = sa1->shar_act) {
+               fprintf(codefile, "      case ");
+               prt_cond(sa1->sig);
+               fprintf(codefile, ":\n");
+               }
+            fprintf(codefile, "      ");
+            prtcode(sa->cd, outer);
+            }
+      
+         /*
+          * If we have a default action and it is not break, print it.
+          */
+         if (dflt == DfltRetSig) {
+            fprintf(codefile, "      default:\n");
+            fprintf(codefile, "         return r_signal;\n");
+            }
+      
+         fprintf(codefile, "      }\n");
+         }
+      }
+   }
+
+/*
+ * prtcall - print call.
+ */
+static void prtcall(call, outer)
+struct code *call;
+int outer;
+   {
+   /*
+    * Either the operation or the continuation may be missing, but not
+    *  both.
+    */
+   if (call->OperName == NULL) {
+      prt_cont(call->Cont);
+      fprintf(codefile, "()");
+      }
+   else {
+      fprintf(codefile, "%s(", call->OperName);
+      if (call->ArgLst != NULL)
+         prt_ary(call->ArgLst, outer);
+      if (call->Cont == NULL) {
+         if (call->Flags & NeedCont) {
+            /*
+             * The operation requires a continuation argument even though
+             *  this call does not include one, pass the NULL pointer.
+             */
+            if (call->ArgLst != NULL)
+               fprintf(codefile, ", ");
+            fprintf(codefile, "(continuation)NULL");
+            }
+         }
+      else {
+         /*
+          * Pass the success continuation.
+          */
+         if (call->ArgLst != NULL)
+            fprintf(codefile, ", ");
+         prt_cont(call->Cont);
+         }
+      fprintf(codefile, ")");
+      }
+   }
+
+/*
+ * prt_cont - print the name of a continuation.
+ */
+static void prt_cont(cont)
+struct c_fnc *cont;
+   {
+   struct code *sig;
+
+   if (cont->flag & CF_SigOnly) {
+      /*
+       * This continuation only returns a signal. All continuations
+       *  returning the same signal are implemented by the same C function.
+       */
+      sig = cont->cd.next->SigRef->sig;
+      if (sig->cd_id == C_Resume)
+         fprintf(codefile, "sig_rsm");
+      else {
+         sig = ChkBound(sig);
+         ChkSeqNum(sig);
+         fprintf(codefile, "sig_%d", sig->SeqNum);
+         }
+      }
+   else {
+      /*
+       * Regular continuation.
+       */
+      ChkPrefix(cont->prefix);
+      fprintf(codefile, "P%s_%s", cont->prefix, cur_proc->name);
+      }
+   }
+
+/*
+ * val_loc - output code referencing a value location (usually variable of
+ *  some sort).
+ */
+static void val_loc(loc, outer)
+struct val_loc *loc;
+int outer;
+   {
+   /*
+    * See if we need to cast a block pointer to a specific block type
+    *  or if we need to take the address of a location.
+    */
+   if (loc->mod_access == M_BlkPtr && loc->blk_name != NULL)
+      fprintf(codefile, "(*(struct %s **)&", loc->blk_name);
+   if (loc->mod_access == M_Addr)
+      fprintf(codefile, "(&");
+
+   switch (loc->loc_type) {
+      case V_Ignore:
+         fprintf(codefile, "trashcan");
+         break;
+      case V_Temp:
+         /*
+          * Temporary descriptor variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".tend.d[%d]", cur_proc->tnd_loc + loc->u.tmp);
+         break;
+      case V_ITemp:
+         /*
+          * Temporary C integer variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".i%d", loc->u.tmp);
+         break;
+      case V_DTemp:
+         /*
+          * Temporary C double variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".d%d", loc->u.tmp);
+         break;
+      case V_Const:
+         /*
+          * Integer constant (used for size of variable part of arg list).
+          */
+         fprintf(codefile, "%d", loc->u.int_const);
+         break;
+      case V_NamedVar:
+         /*
+          * Icon named variable.
+          */
+         prt_var(loc->u.nvar, outer);
+         break;
+      case V_CVar:
+         /*
+          * C variable from in-line code.
+          */
+         fprintf(codefile, "%s", loc->u.name);
+         break;
+      case V_PRslt:
+         /*
+          * Procedure result location.
+          */
+         if (!outer)
+            fprintf(codefile, "(*r_pfp->rslt)");
+         else
+            fprintf(codefile, "(*r_rslt)");
+         break;
+       }
+
+   /*
+    * See if we are accessing the vword of a descriptor.
+    */
+   switch (loc->mod_access) {
+      case M_CharPtr:
+         fprintf(codefile, ".vword.sptr");
+         break;
+      case M_BlkPtr:
+         fprintf(codefile, ".vword.bptr");
+         if (loc->blk_name != NULL)
+            fprintf(codefile, ")");
+         break;
+      case M_CInt:
+         fprintf(codefile, ".vword.integr");
+         break;
+      case M_Addr:
+         fprintf(codefile, ")");
+         break;
+      }
+   }
+
+/*
+ * prt_cond - print a condition (signal number).
+ */
+static void prt_cond(cond)
+struct code *cond;
+   {
+   if (cond == &resume)
+      fprintf(codefile, "A_Resume");
+   else if (cond == &contin)
+      fprintf(codefile, "A_Continue");
+   else if (cond == &fallthru)
+      fprintf(codefile, "A_FallThru");
+   else {
+      cond = ChkBound(cond);
+      ChkSeqNum(cond);
+      fprintf(codefile, "%d /* %s */", cond->SeqNum, cond->Desc);
+      }
+   }
+
+/*
+ * initpblk - write a procedure block along with initialization up to the
+ *   the array of qualifiers.
+ */
+static void initpblk(f, c, prefix, name, nquals, nparam, ndynam, nstatic,
+   frststat)
+FILE *f;      /* output file */
+int c;        /* distinguishes procedures, functions, record constructors */
+char* prefix; /* prefix for name */
+char *name;   /* name of routine */
+int nquals;   /* number of qualifiers at end of block */
+int nparam;   /* number of parameters */
+int ndynam;   /* number of dynamic locals or function/record indicator */
+int nstatic;  /* number of static locals or record number */
+int frststat; /* index into static array of first static local */
+   {
+   fprintf(f, "B_IProc(%d) B%c%s_%s = ", nquals, c, prefix, name);
+   fprintf(f, "{T_Proc, %d, %c%s_%s, %d, %d, %d, %d, {", 9 + 2 * nquals, c,
+      prefix, name, nparam, ndynam, nstatic, frststat);
+   }
+
diff --git a/src/iconc/cparse.c b/src/iconc/cparse.c
new file mode 100644
index 0000000..b29986d
--- /dev/null
+++ b/src/iconc/cparse.c
@@ -0,0 +1,1940 @@
+# define IDENT 257
+# define INTLIT 258
+# define REALLIT 259
+# define STRINGLIT 260
+# define CSETLIT 261
+# define EOFX 262
+# define BREAK 263
+# define BY 264
+# define CASE 265
+# define CREATE 266
+# define DEFAULT 267
+# define DO 268
+# define ELSE 269
+# define END 270
+# define EVERY 271
+# define FAIL 272
+# define GLOBAL 273
+# define IF 274
+# define INITIAL 275
+# define INVOCABLE 276
+# define LINK 277
+# define LOCAL 278
+# define NEXT 279
+# define NOT 280
+# define OF 281
+# define PROCEDURE 282
+# define RECORD 283
+# define REPEAT 284
+# define RETURN 285
+# define STATIC 286
+# define SUSPEND 287
+# define THEN 288
+# define TO 289
+# define UNTIL 290
+# define WHILE 291
+# define BANG 292
+# define MOD 293
+# define AUGMOD 294
+# define AND 295
+# define AUGAND 296
+# define STAR 297
+# define AUGSTAR 298
+# define INTER 299
+# define AUGINTER 300
+# define PLUS 301
+# define AUGPLUS 302
+# define UNION 303
+# define AUGUNION 304
+# define MINUS 305
+# define AUGMINUS 306
+# define DIFF 307
+# define AUGDIFF 308
+# define DOT 309
+# define SLASH 310
+# define AUGSLASH 311
+# define ASSIGN 312
+# define SWAP 313
+# define NMLT 314
+# define AUGNMLT 315
+# define REVASSIGN 316
+# define REVSWAP 317
+# define SLT 318
+# define AUGSLT 319
+# define SLE 320
+# define AUGSLE 321
+# define NMLE 322
+# define AUGNMLE 323
+# define NMEQ 324
+# define AUGNMEQ 325
+# define SEQ 326
+# define AUGSEQ 327
+# define EQUIV 328
+# define AUGEQUIV 329
+# define NMGT 330
+# define AUGNMGT 331
+# define NMGE 332
+# define AUGNMGE 333
+# define SGT 334
+# define AUGSGT 335
+# define SGE 336
+# define AUGSGE 337
+# define QMARK 338
+# define AUGQMARK 339
+# define AT 340
+# define AUGAT 341
+# define BACKSLASH 342
+# define CARET 343
+# define AUGCARET 344
+# define BAR 345
+# define CONCAT 346
+# define AUGCONCAT 347
+# define LCONCAT 348
+# define AUGLCONCAT 349
+# define TILDE 350
+# define NMNE 351
+# define AUGNMNE 352
+# define SNE 353
+# define AUGSNE 354
+# define NEQUIV 355
+# define AUGNEQUIV 356
+# define LPAREN 357
+# define RPAREN 358
+# define PCOLON 359
+# define COMMA 360
+# define MCOLON 361
+# define COLON 362
+# define SEMICOL 363
+# define LBRACK 364
+# define RBRACK 365
+# define LBRACE 366
+# define RBRACE 367
+
+# line 145 "cgram.g"
+/*
+ * These commented directives are passed through the first application
+ * of cpp, then turned into real directives in cgram.g by fixgram.icn.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h" 
+#include "cproto.h"
+#undef YYSTYPE
+#define YYSTYPE nodeptr
+#define YYMAXDEPTH 500
+
+int idflag;
+
+
+
+#define yyclearin yychar = -1
+#define yyerrok yyerrflag = 0
+extern int yychar;
+extern int yyerrflag;
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 150
+#endif
+#ifndef YYSTYPE
+#define YYSTYPE int
+#endif
+YYSTYPE yylval, yyval;
+# define YYERRCODE 256
+
+# line 441 "cgram.g"
+
+
+/*
+ * xfree(p) -- used with free(p) macro to avoid compiler errors from
+ *  miscast free calls generated by Yacc.
+ */
+
+static void xfree(p)
+char *p;
+{
+   free(p);
+}
+
+#define free(p) xfree((char*)p)
+int yyexca[] ={
+-1, 0,
+	262, 2,
+	273, 2,
+	276, 2,
+	277, 2,
+	282, 2,
+	283, 2,
+	-2, 0,
+-1, 1,
+	0, -1,
+	-2, 0,
+-1, 20,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 86,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 87,
+	358, 42,
+	360, 42,
+	-2, 0,
+-1, 88,
+	363, 42,
+	367, 42,
+	-2, 0,
+-1, 89,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 96,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 97,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 111,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 117,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 182,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 183,
+	360, 42,
+	-2, 0,
+-1, 184,
+	358, 42,
+	360, 42,
+	-2, 0,
+-1, 311,
+	358, 42,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 313,
+	363, 42,
+	367, 42,
+	-2, 0,
+-1, 335,
+	360, 42,
+	367, 42,
+	-2, 0,
+	};
+# define YYNPROD 203
+# define YYLAST 728
+int yyact[]={
+
+    38,    84,    91,    92,    93,    94,   312,    86,   185,    99,
+    83,   118,   335,   359,   341,   102,    95,   358,    98,   334,
+   311,   311,   355,    85,    51,   329,   314,    20,   103,    96,
+   118,    97,   313,   228,   101,   100,    56,   346,   118,    90,
+   118,    59,   117,    62,   360,    58,   108,    70,   336,    64,
+   311,    57,   228,    55,    60,   326,   184,   228,   310,   119,
+   311,   107,   106,   182,   345,   183,   324,   232,    65,   110,
+    67,   168,    69,   169,   352,   214,   118,   350,   328,   177,
+    41,   356,    71,   174,    50,   175,    73,    61,   325,    52,
+    53,   320,    54,   316,    63,    66,   176,    68,   327,    72,
+   118,    87,   332,   118,   333,   331,   319,   361,    89,   116,
+    88,   305,    38,    84,    91,    92,    93,    94,   118,    86,
+   181,    99,    83,   353,   317,   231,     3,   102,    95,   218,
+    98,   318,   105,   118,    19,    85,    51,   315,   118,    28,
+   103,    96,    29,    97,   217,   321,   101,   100,    56,   309,
+   170,    90,   172,    59,   173,    62,   171,    58,   118,    70,
+    30,    64,    18,    57,   118,    55,    60,    44,   180,    37,
+   179,   178,   113,    24,   104,   114,    25,   330,   351,   306,
+    65,   212,    67,   115,    69,    82,     2,    81,    80,    27,
+    17,    36,    23,    79,    71,    78,    50,    77,    73,    61,
+    76,    52,    53,    75,    54,    74,    63,    66,    49,    68,
+    47,    72,    42,    87,    38,    84,    91,    92,    93,    94,
+    89,    86,    88,    99,    83,    40,   112,   322,   109,   102,
+    95,    34,    98,   273,   274,   111,    33,    85,    51,    12,
+   233,    32,   103,    96,    21,    97,    22,    26,   101,   100,
+    56,    10,     9,    90,     8,    59,     7,    62,    31,    58,
+     6,    70,     5,    64,     1,    57,     0,    55,    60,    13,
+     0,   216,    15,    14,     0,   210,     0,     0,    16,    11,
+     0,     0,    65,     0,    67,   234,    69,   236,   239,   221,
+   222,   223,   224,   225,   226,   227,    71,   230,    50,   229,
+    73,    61,     0,    52,    53,   237,    54,     0,    63,    66,
+     0,    68,     0,    72,     0,    87,    46,    84,    91,    92,
+    93,    94,    89,    86,    88,    99,    83,    45,     0,     0,
+     0,   102,    95,     0,    98,     0,   289,   290,     0,    85,
+    51,     0,     0,   235,   103,    96,     0,    97,     0,   238,
+   101,   100,    56,     0,     0,    90,     0,    59,     0,    62,
+     0,    58,     4,    70,   303,    64,   308,    57,     0,    55,
+    60,     0,     0,    13,   304,     0,    15,    14,     0,     0,
+     0,     0,    16,    11,    65,     0,    67,     0,    69,   338,
+     0,   213,     0,     0,     0,     0,     0,     0,    71,    43,
+    50,     0,    73,    61,     0,    52,    53,   323,    54,   347,
+    63,    66,    35,    68,   152,    72,     0,    87,     0,   133,
+     0,   150,     0,   130,    89,   131,    88,   128,     0,   127,
+     0,   129,     0,   126,   362,     0,   132,   121,   120,     0,
+   140,   123,   122,     0,   147,   164,   146,     0,   139,   158,
+   135,   157,   143,   163,   136,   160,   138,   154,   137,   166,
+   145,   162,   144,   161,   149,   156,   151,   155,     0,   134,
+     0,     0,   124,     0,   125,     0,   153,   141,   211,   148,
+   215,   142,   165,    39,   159,     0,   167,     0,   219,   220,
+     0,   295,   296,   297,   298,   299,     0,     0,   291,   292,
+   293,   294,     0,    35,     0,     0,     0,   339,   340,    35,
+   342,   343,   344,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,   348,     0,     0,     0,    48,     0,     0,     0,
+     0,     0,     0,   354,     0,     0,     0,     0,     0,     0,
+     0,     0,   357,     0,     0,     0,     0,     0,     0,     0,
+     0,   354,   363,   364,   275,   276,   277,   278,   279,   280,
+   281,   282,   283,   284,   285,   286,   287,   288,     0,     0,
+     0,     0,     0,     0,     0,   307,     0,   186,   187,   188,
+   189,   190,   191,   192,   193,   194,   195,   196,   197,   198,
+   199,   200,   201,   202,   203,   204,   205,   206,   207,   208,
+   209,     0,     0,   240,   241,   242,   243,   244,   245,   246,
+   247,   248,   249,   250,   251,   252,   253,   254,   255,   256,
+   257,   258,   259,   260,   261,   262,   263,   264,   265,   266,
+   267,   268,   269,   270,   271,   272,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,   337,     0,   215,   300,   301,   302,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,   349 };
+int yypact[]={
+
+  -130, -1000,   100, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000,   -95,  -229, -1000,   -84,  -118,   -97,    -4, -1000, -1000,
+   -42,  -125,  -298, -1000, -1000, -1000,  -299, -1000, -1000,  -316,
+ -1000, -1000,  -288,  -103,  -161,  -321,  -219,  -279, -1000, -1000,
+   125, -1000,   131,  -275,  -151,  -214, -1000,  -172, -1000,  -301,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,   -42, -1000, -1000,   -42,   -42,   -42,   -42,
+  -128, -1000, -1000, -1000, -1000, -1000,   -42,   -42,   -42,   -42,
+   -42,   -42,   -42,   -42,  -303, -1000,   -84,  -118,  -133,  -290,
+  -125,   -42,  -125,   -42, -1000, -1000, -1000,   -42,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,   -42,  -256,   -42,  -108, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+  -219, -1000,  -300, -1000,  -361,  -331,  -339, -1000, -1000, -1000,
+ -1000,  -131,  -195,  -157,  -137,  -162,  -177,  -219,  -112, -1000,
+ -1000, -1000,  -125,  -292,  -303,  -182,  -308,  -265, -1000,  -279,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,  -186, -1000,  -275,  -275,  -275,  -275,  -275,
+  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -151,
+  -151,  -214,  -214,  -214,  -214, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,  -340,  -257, -1000,  -348, -1000,  -310, -1000,
+ -1000,   -42, -1000,   -42, -1000,   -42,   -42,  -352,   -42,   -42,
+   -42, -1000,  -294,  -327, -1000, -1000, -1000, -1000,    60, -1000,
+   -42, -1000, -1000, -1000, -1000,   -42, -1000, -1000, -1000,  -219,
+  -192,  -144,  -219,  -219,  -219, -1000,  -343, -1000,  -284, -1000,
+   -42,  -350, -1000,  -318,  -255, -1000, -1000,  -219, -1000,  -144,
+   -42,   -42, -1000,  -219,  -219 };
+int yypgo[]={
+
+     0,   264,   186,   262,   260,   256,   254,   252,   251,   247,
+   189,   246,   192,   244,   174,   241,   240,   239,   236,   235,
+   231,   228,   227,   226,   191,   391,   169,   483,   225,    80,
+   212,   399,   167,   327,   316,   210,   526,   208,   205,   203,
+   200,   197,   195,   193,   188,   187,   185,   181,    75,   179,
+   178,    74,   177 };
+int yyr1[]={
+
+     0,     1,     2,     2,     3,     3,     3,     3,     3,     8,
+     9,     9,    10,    10,    10,     7,    11,    11,    12,    12,
+    13,     6,    15,     4,    16,    16,     5,    21,    17,    22,
+    22,    22,    14,    14,    18,    18,    23,    23,    19,    19,
+    20,    20,    25,    25,    24,    24,    26,    26,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    28,    28,    28,    29,    29,    30,    30,    30,    30,
+    30,    30,    30,    30,    30,    30,    30,    30,    30,    30,
+    30,    31,    31,    31,    32,    32,    32,    32,    32,    33,
+    33,    33,    33,    33,    34,    34,    35,    35,    35,    35,
+    36,    36,    36,    36,    36,    36,    36,    36,    36,    36,
+    36,    36,    36,    36,    36,    36,    36,    36,    36,    36,
+    36,    36,    36,    36,    36,    37,    37,    37,    37,    37,
+    37,    37,    37,    37,    37,    37,    37,    37,    37,    37,
+    37,    37,    37,    37,    37,    37,    37,    37,    43,    43,
+    44,    44,    45,    45,    46,    40,    40,    40,    40,    41,
+    41,    42,    50,    50,    51,    51,    47,    47,    49,    49,
+    38,    38,    38,    38,    39,    52,    52,    52,    48,    48,
+     1,     5,    24 };
+int yyr2[]={
+
+     0,     5,     0,     4,     3,     3,     3,     3,     3,     5,
+     2,     7,     3,     3,     7,     5,     2,     7,     3,     3,
+     1,     7,     1,    13,     1,     3,    13,     1,    13,     1,
+     3,     7,     3,     7,     1,     9,     3,     3,     1,     7,
+     1,     7,     1,     2,     2,     7,     2,     7,     2,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     2,     7,    11,     2,     7,     2,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     2,     7,     7,     2,     7,     7,     7,     7,     2,
+     7,     7,     7,     7,     2,     7,     2,     7,     7,     7,
+     2,     5,     5,     5,     5,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     5,     3,     3,     5,     7,     7,
+     7,     9,     7,     9,     9,     7,     5,     5,     5,     9,
+     5,     9,     5,     9,     5,     3,     5,     5,     9,     9,
+    13,    13,     2,     7,     7,     7,     3,     7,     3,     7,
+     3,     3,     3,     3,    13,     3,     3,     3,     2,     7,
+     6,     8,     2 };
+int yychk[]={
+
+ -1000,    -1,    -2,   256,   262,    -3,    -4,    -5,    -6,    -7,
+    -8,   283,   -17,   273,   277,   276,   282,    -2,   257,   363,
+   256,   -13,   -11,   -12,   257,   260,    -9,   -10,   257,   260,
+   257,   262,   -15,   -18,   -20,   -25,   -24,   -26,   256,   -27,
+   -28,   -29,   -30,   -31,   -32,   -33,   -34,   -35,   -36,   -37,
+   340,   280,   345,   346,   348,   309,   292,   307,   301,   297,
+   310,   343,   299,   350,   305,   324,   351,   326,   353,   328,
+   303,   338,   355,   342,   -38,   -39,   -40,   -41,   -42,   -43,
+   -44,   -45,   -46,   266,   257,   279,   263,   357,   366,   364,
+   295,   258,   259,   260,   261,   272,   285,   287,   274,   265,
+   291,   290,   271,   284,   -14,   257,   360,   360,   362,   -21,
+   357,   -19,   -23,   275,   278,   286,   270,   363,   295,   338,
+   313,   312,   317,   316,   347,   349,   308,   304,   302,   306,
+   298,   300,   311,   294,   344,   325,   329,   333,   331,   323,
+   315,   352,   356,   327,   337,   335,   321,   319,   354,   339,
+   296,   341,   289,   345,   326,   336,   334,   320,   318,   353,
+   324,   332,   330,   322,   314,   351,   328,   355,   346,   348,
+   301,   307,   303,   305,   297,   299,   310,   293,   343,   342,
+   340,   292,   364,   366,   357,   309,   -36,   -36,   -36,   -36,
+   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,
+   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,
+   -24,   -25,   -47,   -25,   -48,   -25,   -47,   272,   257,   -25,
+   -25,   -24,   -24,   -24,   -24,   -24,   -24,   -24,   360,   -12,
+   -10,   258,   357,   -16,   -14,   -20,   -14,   -24,   -20,   -26,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -29,   -29,   -31,   -31,   -31,   -31,   -31,
+   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -32,
+   -32,   -33,   -33,   -33,   -33,   -34,   -34,   -34,   -34,   -34,
+   -36,   -36,   -36,   -47,   -24,   367,   -49,   -25,   -47,   257,
+   358,   360,   367,   363,   365,   268,   288,   281,   268,   268,
+   268,   257,   -22,   -14,   358,   270,   363,   363,   264,   365,
+   -52,   362,   359,   361,   367,   360,   358,   -25,   -48,   -24,
+   -24,   366,   -24,   -24,   -24,   358,   364,   -29,   -24,   -25,
+   269,   -50,   -51,   267,   -24,   365,   365,   -24,   367,   363,
+   362,   362,   -51,   -24,   -24 };
+int yydef[]={
+
+    -2,    -2,     0,     2,     1,     3,     4,     5,     6,     7,
+     8,     0,     0,    20,     0,     0,     0,     0,    22,    34,
+    -2,     0,    15,    16,    18,    19,     9,    10,    12,    13,
+    27,   200,     0,    38,     0,     0,    43,    44,   202,    46,
+    48,    81,    84,    86,   101,   104,   109,   114,   116,   120,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,   145,   146,   147,   148,   149,   150,
+   151,   152,   153,     0,   155,   156,    -2,    -2,    -2,    -2,
+     0,   190,   191,   192,   193,   175,    -2,    -2,     0,     0,
+     0,     0,     0,     0,    21,    32,     0,     0,     0,     0,
+    24,    -2,     0,     0,    36,    37,   201,    -2,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,    -2,    -2,    -2,     0,   121,   122,   123,   124,
+   125,   126,   127,   128,   129,   130,   131,   132,   133,   134,
+   135,   136,   137,   138,   139,   140,   141,   142,   143,   144,
+   154,   157,     0,   186,     0,   198,     0,   166,   167,   176,
+   177,    43,     0,     0,   168,   170,   172,   174,     0,    17,
+    11,    14,    29,     0,    25,     0,     0,     0,    41,    45,
+    47,    49,    50,    51,    52,    53,    54,    55,    56,    57,
+    58,    59,    60,    61,    62,    63,    64,    65,    66,    67,
+    68,    69,    70,    71,    72,    73,    74,    75,    76,    77,
+    78,    79,    80,    82,    85,    87,    88,    89,    90,    91,
+    92,    93,    94,    95,    96,    97,    98,    99,   100,   102,
+   103,   105,   106,   107,   108,   110,   111,   112,   113,   115,
+   117,   118,   119,     0,    43,   162,     0,   188,     0,   165,
+   158,    -2,   159,    -2,   160,     0,     0,     0,     0,     0,
+     0,    33,     0,    30,    23,    26,    35,    39,     0,   161,
+     0,   195,   196,   197,   163,    -2,   164,   187,   199,   178,
+   179,     0,   169,   171,   173,    28,     0,    83,     0,   189,
+     0,     0,   182,     0,     0,    31,   194,   180,   181,     0,
+     0,     0,   183,   184,   185 };
+typedef struct { char *t_name; int t_val; } yytoktype;
+#ifndef YYDEBUG
+#	define YYDEBUG	0	/* don't allow debugging */
+#endif
+
+#if YYDEBUG
+
+yytoktype yytoks[] =
+{
+	"IDENT",	257,
+	"INTLIT",	258,
+	"REALLIT",	259,
+	"STRINGLIT",	260,
+	"CSETLIT",	261,
+	"EOFX",	262,
+	"BREAK",	263,
+	"BY",	264,
+	"CASE",	265,
+	"CREATE",	266,
+	"DEFAULT",	267,
+	"DO",	268,
+	"ELSE",	269,
+	"END",	270,
+	"EVERY",	271,
+	"FAIL",	272,
+	"GLOBAL",	273,
+	"IF",	274,
+	"INITIAL",	275,
+	"INVOCABLE",	276,
+	"LINK",	277,
+	"LOCAL",	278,
+	"NEXT",	279,
+	"NOT",	280,
+	"OF",	281,
+	"PROCEDURE",	282,
+	"RECORD",	283,
+	"REPEAT",	284,
+	"RETURN",	285,
+	"STATIC",	286,
+	"SUSPEND",	287,
+	"THEN",	288,
+	"TO",	289,
+	"UNTIL",	290,
+	"WHILE",	291,
+	"BANG",	292,
+	"MOD",	293,
+	"AUGMOD",	294,
+	"AND",	295,
+	"AUGAND",	296,
+	"STAR",	297,
+	"AUGSTAR",	298,
+	"INTER",	299,
+	"AUGINTER",	300,
+	"PLUS",	301,
+	"AUGPLUS",	302,
+	"UNION",	303,
+	"AUGUNION",	304,
+	"MINUS",	305,
+	"AUGMINUS",	306,
+	"DIFF",	307,
+	"AUGDIFF",	308,
+	"DOT",	309,
+	"SLASH",	310,
+	"AUGSLASH",	311,
+	"ASSIGN",	312,
+	"SWAP",	313,
+	"NMLT",	314,
+	"AUGNMLT",	315,
+	"REVASSIGN",	316,
+	"REVSWAP",	317,
+	"SLT",	318,
+	"AUGSLT",	319,
+	"SLE",	320,
+	"AUGSLE",	321,
+	"NMLE",	322,
+	"AUGNMLE",	323,
+	"NMEQ",	324,
+	"AUGNMEQ",	325,
+	"SEQ",	326,
+	"AUGSEQ",	327,
+	"EQUIV",	328,
+	"AUGEQUIV",	329,
+	"NMGT",	330,
+	"AUGNMGT",	331,
+	"NMGE",	332,
+	"AUGNMGE",	333,
+	"SGT",	334,
+	"AUGSGT",	335,
+	"SGE",	336,
+	"AUGSGE",	337,
+	"QMARK",	338,
+	"AUGQMARK",	339,
+	"AT",	340,
+	"AUGAT",	341,
+	"BACKSLASH",	342,
+	"CARET",	343,
+	"AUGCARET",	344,
+	"BAR",	345,
+	"CONCAT",	346,
+	"AUGCONCAT",	347,
+	"LCONCAT",	348,
+	"AUGLCONCAT",	349,
+	"TILDE",	350,
+	"NMNE",	351,
+	"AUGNMNE",	352,
+	"SNE",	353,
+	"AUGSNE",	354,
+	"NEQUIV",	355,
+	"AUGNEQUIV",	356,
+	"LPAREN",	357,
+	"RPAREN",	358,
+	"PCOLON",	359,
+	"COMMA",	360,
+	"MCOLON",	361,
+	"COLON",	362,
+	"SEMICOL",	363,
+	"LBRACK",	364,
+	"RBRACK",	365,
+	"LBRACE",	366,
+	"RBRACE",	367,
+	"-unknown-",	-1	/* ends search */
+};
+
+char * yyreds[] =
+{
+	"-no such reduction-",
+	"program : decls EOFX",
+	"decls : /* empty */",
+	"decls : decls decl",
+	"decl : record",
+	"decl : proc",
+	"decl : global",
+	"decl : link",
+	"decl : invocable",
+	"invocable : INVOCABLE invoclist",
+	"invoclist : invocop",
+	"invoclist : invoclist COMMA invocop",
+	"invocop : IDENT",
+	"invocop : STRINGLIT",
+	"invocop : STRINGLIT COLON INTLIT",
+	"link : LINK lnklist",
+	"lnklist : lnkfile",
+	"lnklist : lnklist COMMA lnkfile",
+	"lnkfile : IDENT",
+	"lnkfile : STRINGLIT",
+	"global : GLOBAL",
+	"global : GLOBAL idlist",
+	"record : RECORD IDENT",
+	"record : RECORD IDENT LPAREN fldlist RPAREN",
+	"fldlist : /* empty */",
+	"fldlist : idlist",
+	"proc : prochead SEMICOL locals initial procbody END",
+	"prochead : PROCEDURE IDENT",
+	"prochead : PROCEDURE IDENT LPAREN arglist RPAREN",
+	"arglist : /* empty */",
+	"arglist : idlist",
+	"arglist : idlist LBRACK RBRACK",
+	"idlist : IDENT",
+	"idlist : idlist COMMA IDENT",
+	"locals : /* empty */",
+	"locals : locals retention idlist SEMICOL",
+	"retention : LOCAL",
+	"retention : STATIC",
+	"initial : /* empty */",
+	"initial : INITIAL expr SEMICOL",
+	"procbody : /* empty */",
+	"procbody : nexpr SEMICOL procbody",
+	"nexpr : /* empty */",
+	"nexpr : expr",
+	"expr : expr1a",
+	"expr : expr AND expr1a",
+	"expr1a : expr1",
+	"expr1a : expr1a QMARK expr1",
+	"expr1 : expr2",
+	"expr1 : expr2 SWAP expr1",
+	"expr1 : expr2 ASSIGN expr1",
+	"expr1 : expr2 REVSWAP expr1",
+	"expr1 : expr2 REVASSIGN expr1",
+	"expr1 : expr2 AUGCONCAT expr1",
+	"expr1 : expr2 AUGLCONCAT expr1",
+	"expr1 : expr2 AUGDIFF expr1",
+	"expr1 : expr2 AUGUNION expr1",
+	"expr1 : expr2 AUGPLUS expr1",
+	"expr1 : expr2 AUGMINUS expr1",
+	"expr1 : expr2 AUGSTAR expr1",
+	"expr1 : expr2 AUGINTER expr1",
+	"expr1 : expr2 AUGSLASH expr1",
+	"expr1 : expr2 AUGMOD expr1",
+	"expr1 : expr2 AUGCARET expr1",
+	"expr1 : expr2 AUGNMEQ expr1",
+	"expr1 : expr2 AUGEQUIV expr1",
+	"expr1 : expr2 AUGNMGE expr1",
+	"expr1 : expr2 AUGNMGT expr1",
+	"expr1 : expr2 AUGNMLE expr1",
+	"expr1 : expr2 AUGNMLT expr1",
+	"expr1 : expr2 AUGNMNE expr1",
+	"expr1 : expr2 AUGNEQUIV expr1",
+	"expr1 : expr2 AUGSEQ expr1",
+	"expr1 : expr2 AUGSGE expr1",
+	"expr1 : expr2 AUGSGT expr1",
+	"expr1 : expr2 AUGSLE expr1",
+	"expr1 : expr2 AUGSLT expr1",
+	"expr1 : expr2 AUGSNE expr1",
+	"expr1 : expr2 AUGQMARK expr1",
+	"expr1 : expr2 AUGAND expr1",
+	"expr1 : expr2 AUGAT expr1",
+	"expr2 : expr3",
+	"expr2 : expr2 TO expr3",
+	"expr2 : expr2 TO expr3 BY expr3",
+	"expr3 : expr4",
+	"expr3 : expr4 BAR expr3",
+	"expr4 : expr5",
+	"expr4 : expr4 SEQ expr5",
+	"expr4 : expr4 SGE expr5",
+	"expr4 : expr4 SGT expr5",
+	"expr4 : expr4 SLE expr5",
+	"expr4 : expr4 SLT expr5",
+	"expr4 : expr4 SNE expr5",
+	"expr4 : expr4 NMEQ expr5",
+	"expr4 : expr4 NMGE expr5",
+	"expr4 : expr4 NMGT expr5",
+	"expr4 : expr4 NMLE expr5",
+	"expr4 : expr4 NMLT expr5",
+	"expr4 : expr4 NMNE expr5",
+	"expr4 : expr4 EQUIV expr5",
+	"expr4 : expr4 NEQUIV expr5",
+	"expr5 : expr6",
+	"expr5 : expr5 CONCAT expr6",
+	"expr5 : expr5 LCONCAT expr6",
+	"expr6 : expr7",
+	"expr6 : expr6 PLUS expr7",
+	"expr6 : expr6 DIFF expr7",
+	"expr6 : expr6 UNION expr7",
+	"expr6 : expr6 MINUS expr7",
+	"expr7 : expr8",
+	"expr7 : expr7 STAR expr8",
+	"expr7 : expr7 INTER expr8",
+	"expr7 : expr7 SLASH expr8",
+	"expr7 : expr7 MOD expr8",
+	"expr8 : expr9",
+	"expr8 : expr9 CARET expr8",
+	"expr9 : expr10",
+	"expr9 : expr9 BACKSLASH expr10",
+	"expr9 : expr9 AT expr10",
+	"expr9 : expr9 BANG expr10",
+	"expr10 : expr11",
+	"expr10 : AT expr10",
+	"expr10 : NOT expr10",
+	"expr10 : BAR expr10",
+	"expr10 : CONCAT expr10",
+	"expr10 : LCONCAT expr10",
+	"expr10 : DOT expr10",
+	"expr10 : BANG expr10",
+	"expr10 : DIFF expr10",
+	"expr10 : PLUS expr10",
+	"expr10 : STAR expr10",
+	"expr10 : SLASH expr10",
+	"expr10 : CARET expr10",
+	"expr10 : INTER expr10",
+	"expr10 : TILDE expr10",
+	"expr10 : MINUS expr10",
+	"expr10 : NMEQ expr10",
+	"expr10 : NMNE expr10",
+	"expr10 : SEQ expr10",
+	"expr10 : SNE expr10",
+	"expr10 : EQUIV expr10",
+	"expr10 : UNION expr10",
+	"expr10 : QMARK expr10",
+	"expr10 : NEQUIV expr10",
+	"expr10 : BACKSLASH expr10",
+	"expr11 : literal",
+	"expr11 : section",
+	"expr11 : return",
+	"expr11 : if",
+	"expr11 : case",
+	"expr11 : while",
+	"expr11 : until",
+	"expr11 : every",
+	"expr11 : repeat",
+	"expr11 : CREATE expr",
+	"expr11 : IDENT",
+	"expr11 : NEXT",
+	"expr11 : BREAK nexpr",
+	"expr11 : LPAREN exprlist RPAREN",
+	"expr11 : LBRACE compound RBRACE",
+	"expr11 : LBRACK exprlist RBRACK",
+	"expr11 : expr11 LBRACK exprlist RBRACK",
+	"expr11 : expr11 LBRACE RBRACE",
+	"expr11 : expr11 LBRACE pdcolist RBRACE",
+	"expr11 : expr11 LPAREN exprlist RPAREN",
+	"expr11 : expr11 DOT IDENT",
+	"expr11 : AND FAIL",
+	"expr11 : AND IDENT",
+	"while : WHILE expr",
+	"while : WHILE expr DO expr",
+	"until : UNTIL expr",
+	"until : UNTIL expr DO expr",
+	"every : EVERY expr",
+	"every : EVERY expr DO expr",
+	"repeat : REPEAT expr",
+	"return : FAIL",
+	"return : RETURN nexpr",
+	"return : SUSPEND nexpr",
+	"return : SUSPEND expr DO expr",
+	"if : IF expr THEN expr",
+	"if : IF expr THEN expr ELSE expr",
+	"case : CASE expr OF LBRACE caselist RBRACE",
+	"caselist : cclause",
+	"caselist : caselist SEMICOL cclause",
+	"cclause : DEFAULT COLON expr",
+	"cclause : expr COLON expr",
+	"exprlist : nexpr",
+	"exprlist : exprlist COMMA nexpr",
+	"pdcolist : nexpr",
+	"pdcolist : pdcolist COMMA nexpr",
+	"literal : INTLIT",
+	"literal : REALLIT",
+	"literal : STRINGLIT",
+	"literal : CSETLIT",
+	"section : expr11 LBRACK expr sectop expr RBRACK",
+	"sectop : COLON",
+	"sectop : PCOLON",
+	"sectop : MCOLON",
+	"compound : nexpr",
+	"compound : nexpr SEMICOL compound",
+	"program : error decls EOFX",
+	"proc : prochead error procbody END",
+	"expr : error",
+};
+#endif
+#line 1 "/usr/lib/yaccpar"
+/*	@(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10	*/
+
+/*
+** Skeleton parser driver for yacc output
+*/
+
+/*
+** yacc user known macros and defines
+*/
+#define YYERROR		goto yyerrlab
+#define YYACCEPT	{ free(yys); free(yyv); return(0); }
+#define YYABORT		{ free(yys); free(yyv); return(1); }
+#define YYBACKUP( newtoken, newvalue )\
+{\
+	if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
+	{\
+		tsyserr("parser: syntax error - cannot backup" );\
+		goto yyerrlab;\
+	}\
+	yychar = newtoken;\
+	yystate = *yyps;\
+	yylval = newvalue;\
+	goto yynewstate;\
+}
+#define YYRECOVERING()	(!!yyerrflag)
+#ifndef YYDEBUG
+#	define YYDEBUG	1	/* make debugging available */
+#endif
+
+/*
+** user known globals
+*/
+int yydebug;			/* set to 1 to get debugging */
+
+/*
+** driver internal defines
+*/
+#define YYFLAG		(-1000)
+
+/*
+** static variables used by the parser
+*/
+static YYSTYPE *yyv;			/* value stack */
+static int *yys;			/* state stack */
+
+static YYSTYPE *yypv;			/* top of value stack */
+static int *yyps;			/* top of state stack */
+
+static int yystate;			/* current state */
+static int yytmp;			/* extra var (lasts between blocks) */
+
+int yynerrs;			/* number of errors */
+
+int yyerrflag;			/* error recovery flag */
+int yychar;			/* current input token number */
+
+
+/*
+** yyparse - return 0 if worked, 1 if syntax error not recovered from
+*/
+int
+yyparse()
+{
+	register YYSTYPE *yypvt;	/* top of value stack for $vars */
+	unsigned yymaxdepth = YYMAXDEPTH;
+
+	/*
+	** Initialize externals - yyparse may be called more than once
+	*/
+	yyv = (YYSTYPE*)malloc(yymaxdepth*sizeof(YYSTYPE));
+	yys = (int*)malloc(yymaxdepth*sizeof(int));
+	if (!yyv || !yys)
+	{
+		tsyserr("parser: out of memory" );
+		return(1);
+	}
+	yypv = &yyv[-1];
+	yyps = &yys[-1];
+	yystate = 0;
+	yytmp = 0;
+	yynerrs = 0;
+	yyerrflag = 0;
+	yychar = -1;
+
+	goto yystack;
+	{
+		register YYSTYPE *yy_pv;	/* top of value stack */
+		register int *yy_ps;		/* top of state stack */
+		register int yy_state;		/* current state */
+		register int  yy_n;		/* internal state number info */
+
+		/*
+		** get globals into registers.
+		** branch to here only if YYBACKUP was called.
+		*/
+	yynewstate:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+		goto yy_newstate;
+
+		/*
+		** get globals into registers.
+		** either we just started, or we just finished a reduction
+		*/
+	yystack:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+
+		/*
+		** top of for (;;) loop while no reductions done
+		*/
+	yy_stack:
+		/*
+		** put a state and value onto the stacks
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, look up token value in list of value vs.
+		** name pairs.  0 and negative (-1) are special values.
+		** Note: linear search is used since time is not a real
+		** consideration while debugging.
+		*/
+		if ( yydebug )
+		{
+			register int yy_i;
+
+			(void)printf( "State %d, token ", yy_state );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif
+		if ( ++yy_ps >= &yys[ yymaxdepth ] )	/* room on stack? */
+		{
+			/*
+			** reallocate and recover.  Note that pointers
+			** have to be reset, or bad things will happen
+			*/
+			int yyps_index = (yy_ps - yys);
+			int yypv_index = (yy_pv - yyv);
+			int yypvt_index = (yypvt - yyv);
+			yymaxdepth += YYMAXDEPTH;
+			yyv = (YYSTYPE*)realloc((char*)yyv,
+				yymaxdepth * sizeof(YYSTYPE));
+			yys = (int*)realloc((char*)yys,
+				yymaxdepth * sizeof(int));
+			if (!yyv || !yys)
+			{
+				tsyserr("parse stack overflow" );
+				return(1);
+			}
+			yy_ps = yys + yyps_index;
+			yy_pv = yyv + yypv_index;
+			yypvt = yyv + yypvt_index;
+		}
+		*yy_ps = yy_state;
+		*++yy_pv = yyval;
+
+		/*
+		** we have a new state - find out what to do
+		*/
+	yy_newstate:
+		if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
+			goto yydefault;		/* simple state */
+#if YYDEBUG
+		/*
+		** if debugging, need to mark whether new token grabbed
+		*/
+		yytmp = yychar < 0;
+#endif
+		if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+			yychar = 0;		/* reached EOF */
+#if YYDEBUG
+		if ( yydebug && yytmp )
+		{
+			register int yy_i;
+
+			(void)printf( "Received token " );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif
+		if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
+			goto yydefault;
+		if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar )	/*valid shift*/
+		{
+			yychar = -1;
+			yyval = yylval;
+			yy_state = yy_n;
+			if ( yyerrflag > 0 )
+				yyerrflag--;
+			goto yy_stack;
+		}
+
+	yydefault:
+		if ( ( yy_n = yydef[ yy_state ] ) == -2 )
+		{
+#if YYDEBUG
+			yytmp = yychar < 0;
+#endif
+			if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+				yychar = 0;		/* reached EOF */
+#if YYDEBUG
+			if ( yydebug && yytmp )
+			{
+				register int yy_i;
+
+				(void)printf( "Received token " );
+				if ( yychar == 0 )
+					(void)printf( "end-of-file\n" );
+				else if ( yychar < 0 )
+					(void)printf( "-none-\n" );
+				else
+				{
+					for ( yy_i = 0;
+						yytoks[yy_i].t_val >= 0;
+						yy_i++ )
+					{
+						if ( yytoks[yy_i].t_val
+							== yychar )
+						{
+							break;
+						}
+					}
+					(void)printf( "%s\n", yytoks[yy_i].t_name );
+				}
+			}
+#endif
+			/*
+			** look through exception table
+			*/
+			{
+				register int *yyxi = yyexca;
+
+				while ( ( *yyxi != -1 ) ||
+					( yyxi[1] != yy_state ) )
+				{
+					yyxi += 2;
+				}
+				while ( ( *(yyxi += 2) >= 0 ) &&
+					( *yyxi != yychar ) )
+					;
+				if ( ( yy_n = yyxi[1] ) < 0 )
+					YYACCEPT;
+			}
+		}
+
+		/*
+		** check for syntax error
+		*/
+		if ( yy_n == 0 )	/* have an error */
+		{
+			/* no worry about speed here! */
+			switch ( yyerrflag )
+			{
+			case 0:		/* new error */
+				yyerror(yychar, yylval, yy_state );
+				goto skip_init;
+			yyerrlab:
+				/*
+				** get globals into registers.
+				** we have a user generated syntax type error
+				*/
+				yy_pv = yypv;
+				yy_ps = yyps;
+				yy_state = yystate;
+				yynerrs++;
+			skip_init:
+			case 1:
+			case 2:		/* incompletely recovered error */
+					/* try again... */
+				yyerrflag = 3;
+				/*
+				** find state where "error" is a legal
+				** shift action
+				*/
+				while ( yy_ps >= yys )
+				{
+					yy_n = yypact[ *yy_ps ] + YYERRCODE;
+					if ( yy_n >= 0 && yy_n < YYLAST &&
+						yychk[yyact[yy_n]] == YYERRCODE)					{
+						/*
+						** simulate shift of "error"
+						*/
+						yy_state = yyact[ yy_n ];
+						goto yy_stack;
+					}
+					/*
+					** current state has no shift on
+					** "error", pop stack
+					*/
+#if YYDEBUG
+#	define _POP_ "Error recovery pops state %d, uncovers state %d\n"
+					if ( yydebug )
+						(void)printf( _POP_, *yy_ps,
+							yy_ps[-1] );
+#	undef _POP_
+#endif
+					yy_ps--;
+					yy_pv--;
+				}
+				/*
+				** there is no state on stack with "error" as
+				** a valid shift.  give up.
+				*/
+				YYABORT;
+			case 3:		/* no shift yet; eat a token */
+#if YYDEBUG
+				/*
+				** if debugging, look up token in list of
+				** pairs.  0 and negative shouldn't occur,
+				** but since timing doesn't matter when
+				** debugging, it doesn't hurt to leave the
+				** tests here.
+				*/
+				if ( yydebug )
+				{
+					register int yy_i;
+
+					(void)printf( "Error recovery discards " );
+					if ( yychar == 0 )
+						(void)printf( "token end-of-file\n" );
+					else if ( yychar < 0 )
+						(void)printf( "token -none-\n" );
+					else
+					{
+						for ( yy_i = 0;
+							yytoks[yy_i].t_val >= 0;
+							yy_i++ )
+						{
+							if ( yytoks[yy_i].t_val
+								== yychar )
+							{
+								break;
+							}
+						}
+						(void)printf( "token %s\n",
+							yytoks[yy_i].t_name );
+					}
+				}
+#endif
+				if ( yychar == 0 )	/* reached EOF. quit */
+					YYABORT;
+				yychar = -1;
+				goto yy_newstate;
+			}
+		}/* end if ( yy_n == 0 ) */
+		/*
+		** reduction by production yy_n
+		** put stack tops, etc. so things right after switch
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, print the string that is the user's
+		** specification of the reduction which is just about
+		** to be done.
+		*/
+		if ( yydebug )
+			(void)printf( "Reduce by (%d) \"%s\"\n",
+				yy_n, yyreds[ yy_n ] );
+#endif
+		yytmp = yy_n;			/* value to switch over */
+		yypvt = yy_pv;			/* $vars top of value stack */
+		/*
+		** Look in goto table for next state
+		** Sorry about using yy_state here as temporary
+		** register variable, but why not, if it works...
+		** If yyr2[ yy_n ] doesn't have the low order bit
+		** set, then there is no action to be done for
+		** this reduction.  So, no saving & unsaving of
+		** registers done.  The only difference between the
+		** code just after the if and the body of the if is
+		** the goto yy_stack in the body.  This way the test
+		** can be made before the choice of what to do is needed.
+		*/
+		{
+			/* length of production doubled with extra bit */
+			register int yy_len = yyr2[ yy_n ];
+
+			if ( !( yy_len & 01 ) )
+			{
+				yy_len >>= 1;
+				yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+				yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+					*( yy_ps -= yy_len ) + 1;
+				if ( yy_state >= YYLAST ||
+					yychk[ yy_state =
+					yyact[ yy_state ] ] != -yy_n )
+				{
+					yy_state = yyact[ yypgo[ yy_n ] ];
+				}
+				goto yy_stack;
+			}
+			yy_len >>= 1;
+			yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+			yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+				*( yy_ps -= yy_len ) + 1;
+			if ( yy_state >= YYLAST ||
+				yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
+			{
+				yy_state = yyact[ yypgo[ yy_n ] ];
+			}
+		}
+					/* save until reenter driver code */
+		yystate = yy_state;
+		yyps = yy_ps;
+		yypv = yy_pv;
+	}
+	/*
+	** code supplied by user is placed in this switch
+	*/
+	switch( yytmp )
+	{
+		
+case 1:
+# line 177 "cgram.g"
+{;} break;
+case 4:
+# line 182 "cgram.g"
+{;} break;
+case 5:
+# line 183 "cgram.g"
+{proc_lst->tree = yypvt[-0] ;} break;
+case 6:
+# line 184 "cgram.g"
+{;} break;
+case 7:
+# line 185 "cgram.g"
+{;} break;
+case 8:
+# line 186 "cgram.g"
+{;} break;
+case 9:
+# line 188 "cgram.g"
+{;} break;
+case 11:
+# line 191 "cgram.g"
+{;} break;
+case 12:
+# line 193 "cgram.g"
+{invoc_grp(Str0(yypvt[-0])); ;} break;
+case 13:
+# line 194 "cgram.g"
+{invocbl(yypvt[-0], -1); ;} break;
+case 14:
+# line 195 "cgram.g"
+{invocbl(yypvt[-2], atoi(Str0(yypvt[-0]))); ;} break;
+case 15:
+# line 197 "cgram.g"
+{;} break;
+case 17:
+# line 200 "cgram.g"
+{;} break;
+case 18:
+# line 202 "cgram.g"
+{lnkdcl(Str0(yypvt[-0])); ;} break;
+case 19:
+# line 203 "cgram.g"
+{lnkdcl(Str0(yypvt[-0])); ;} break;
+case 20:
+# line 205 "cgram.g"
+{idflag = F_Global ;} break;
+case 21:
+# line 205 "cgram.g"
+{;} break;
+case 22:
+# line 207 "cgram.g"
+{init_rec(Str0(yypvt[-0])); idflag = F_Field ;} break;
+case 23:
+# line 207 "cgram.g"
+{
+		 ;
+		} break;
+case 24:
+# line 211 "cgram.g"
+{;} break;
+case 25:
+# line 212 "cgram.g"
+{;} break;
+case 26:
+# line 214 "cgram.g"
+{
+		yyval = tree6(N_Proc,yypvt[-5],yypvt[-5],yypvt[-2],yypvt[-1],yypvt[-0]) ;
+		} break;
+case 27:
+# line 218 "cgram.g"
+{init_proc(Str0(yypvt[-0]));	idflag = F_Argument ;} break;
+case 28:
+# line 218 "cgram.g"
+{
+		 ;
+		} break;
+case 29:
+# line 222 "cgram.g"
+{;} break;
+case 30:
+# line 223 "cgram.g"
+{;} break;
+case 31:
+# line 224 "cgram.g"
+{proc_lst->nargs = -proc_lst->nargs ;} break;
+case 32:
+# line 227 "cgram.g"
+{
+		install(Str0(yypvt[-0]),idflag) ;
+		} break;
+case 33:
+# line 230 "cgram.g"
+{
+		install(Str0(yypvt[-0]),idflag) ;
+		} break;
+case 34:
+# line 234 "cgram.g"
+{;} break;
+case 35:
+# line 235 "cgram.g"
+{;} break;
+case 36:
+# line 237 "cgram.g"
+{idflag = F_Dynamic ;} break;
+case 37:
+# line 238 "cgram.g"
+{idflag = F_Static ;} break;
+case 38:
+# line 240 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 39:
+# line 241 "cgram.g"
+{yyval = yypvt[-1] ;} break;
+case 40:
+# line 243 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 41:
+# line 244 "cgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 42:
+# line 246 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 45:
+# line 250 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 47:
+# line 253 "cgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 49:
+# line 256 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 50:
+# line 257 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 51:
+# line 258 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 52:
+# line 259 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 53:
+# line 260 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 54:
+# line 261 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 55:
+# line 262 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 56:
+# line 263 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 57:
+# line 264 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 58:
+# line 265 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 59:
+# line 266 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 60:
+# line 267 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 61:
+# line 268 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 62:
+# line 269 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 63:
+# line 270 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 64:
+# line 271 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 65:
+# line 272 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 66:
+# line 273 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 67:
+# line 274 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 68:
+# line 275 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 69:
+# line 276 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 70:
+# line 277 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 71:
+# line 278 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 72:
+# line 279 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 73:
+# line 280 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 74:
+# line 281 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 75:
+# line 282 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 76:
+# line 283 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 77:
+# line 284 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 78:
+# line 285 "cgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 79:
+# line 286 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 80:
+# line 287 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 82:
+# line 290 "cgram.g"
+{yyval = to_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 83:
+# line 291 "cgram.g"
+{yyval = toby_nd(yypvt[-3],yypvt[-4],yypvt[-2],yypvt[-0]) ;} break;
+case 85:
+# line 294 "cgram.g"
+{yyval = tree4(N_Alt,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 87:
+# line 297 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 88:
+# line 298 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 89:
+# line 299 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 90:
+# line 300 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 91:
+# line 301 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 92:
+# line 302 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 93:
+# line 303 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 94:
+# line 304 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 95:
+# line 305 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 96:
+# line 306 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 97:
+# line 307 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 98:
+# line 308 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 99:
+# line 309 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 100:
+# line 310 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 102:
+# line 313 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 103:
+# line 314 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 105:
+# line 317 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 106:
+# line 318 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 107:
+# line 319 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 108:
+# line 320 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 110:
+# line 323 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 111:
+# line 324 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 112:
+# line 325 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 113:
+# line 326 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 115:
+# line 329 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 117:
+# line 332 "cgram.g"
+{yyval = tree4(N_Limit,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 118:
+# line 333 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 119:
+# line 334 "cgram.g"
+{yyval = tree4(N_Apply,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 121:
+# line 337 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],tree1(N_Empty) ,yypvt[-0]) ;} break;
+case 122:
+# line 338 "cgram.g"
+{yyval = tree3(N_Not,yypvt[-0],yypvt[-0]) ;} break;
+case 123:
+# line 339 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 124:
+# line 340 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 125:
+# line 341 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 126:
+# line 342 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 127:
+# line 343 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 128:
+# line 344 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 129:
+# line 345 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 130:
+# line 346 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 131:
+# line 347 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 132:
+# line 348 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 133:
+# line 349 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 134:
+# line 350 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 135:
+# line 351 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 136:
+# line 352 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 137:
+# line 353 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 138:
+# line 354 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 139:
+# line 355 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 140:
+# line 356 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 141:
+# line 357 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 142:
+# line 358 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 143:
+# line 359 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 144:
+# line 360 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 154:
+# line 371 "cgram.g"
+{yyval = tree3(N_Create,yypvt[-1],yypvt[-0]);	proc_lst->has_coexpr = 1; ;} break;
+case 155:
+# line 372 "cgram.g"
+{LSym0(yypvt[-0]) = putloc(Str0(yypvt[-0]),0) ;} break;
+case 156:
+# line 373 "cgram.g"
+{yyval = tree2(N_Next,yypvt[-0]) ;} break;
+case 157:
+# line 374 "cgram.g"
+{yyval = tree3(N_Break,yypvt[-1],yypvt[-0]) ;} break;
+case 158:
+# line 375 "cgram.g"
+{if ((yypvt[-1])->n_type == N_Elist) yyval = invk_nd(yypvt[-2],tree1(N_Empty) ,yypvt[-1]); else yyval = yypvt[-1] ;} break;
+case 159:
+# line 376 "cgram.g"
+{yyval = yypvt[-1] ;} break;
+case 160:
+# line 377 "cgram.g"
+{yyval = list_nd(yypvt[-2],yypvt[-1]) ;} break;
+case 161:
+# line 378 "cgram.g"
+{yyval = buildarray(yypvt[-3],yypvt[-2],yypvt[-1]) ;} break;
+case 162:
+# line 379 "cgram.g"
+{yyval = invk_nd(yypvt[-1],yypvt[-2],list_nd(yypvt[-1],tree1(N_Empty) )) ;} break;
+case 163:
+# line 380 "cgram.g"
+{yyval = invk_nd(yypvt[-2],yypvt[-3],list_nd(yypvt[-2],yypvt[-1])) ;} break;
+case 164:
+# line 381 "cgram.g"
+{yyval = invk_nd(yypvt[-2],yypvt[-3],yypvt[-1]) ;} break;
+case 165:
+# line 382 "cgram.g"
+{yyval = tree4(N_Field,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 166:
+# line 383 "cgram.g"
+{yyval = key_leaf(yypvt[-1],spec_str("fail")) ;} break;
+case 167:
+# line 384 "cgram.g"
+{yyval = key_leaf(yypvt[-1],Str0(yypvt[-0])) ;} break;
+case 168:
+# line 386 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 169:
+# line 387 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 170:
+# line 389 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 171:
+# line 390 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 172:
+# line 392 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 173:
+# line 393 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 174:
+# line 395 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 175:
+# line 397 "cgram.g"
+{yyval = tree4(N_Ret,yypvt[-0],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 176:
+# line 398 "cgram.g"
+{yyval = tree4(N_Ret,yypvt[-1],yypvt[-1],yypvt[-0]) ;} break;
+case 177:
+# line 399 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 178:
+# line 400 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 179:
+# line 402 "cgram.g"
+{yyval = tree5(N_If,yypvt[-3],yypvt[-2],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 180:
+# line 403 "cgram.g"
+{yyval = tree5(N_If,yypvt[-5],yypvt[-4],yypvt[-2],yypvt[-0]) ;} break;
+case 181:
+# line 405 "cgram.g"
+{yyval = case_nd(yypvt[-5],yypvt[-4],yypvt[-1]) ;} break;
+case 183:
+# line 408 "cgram.g"
+{yyval = tree4(N_Clist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 184:
+# line 410 "cgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 185:
+# line 411 "cgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 186:
+# line 413 "cgram.g"
+{yyval = yypvt[-0]; ;} break;
+case 187:
+# line 414 "cgram.g"
+{yyval = tree4(N_Elist,yypvt[-1],yypvt[-2],yypvt[-0]); ;} break;
+case 188:
+# line 416 "cgram.g"
+{
+		yyval = tree3(N_Create,yypvt[-0],yypvt[-0]);	proc_lst->has_coexpr = 1; ;
+		} break;
+case 189:
+# line 419 "cgram.g"
+{
+		yyval =tree4(N_Elist,yypvt[-1],yypvt[-2],tree3(N_Create,yypvt[-1],yypvt[-0]));	proc_lst->has_coexpr = 1; ;
+		} break;
+case 190:
+# line 423 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_IntLit,0) ;} break;
+case 191:
+# line 424 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_RealLit,0) ;} break;
+case 192:
+# line 425 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_StrLit,(int)Val1(yypvt[-0])) ;} break;
+case 193:
+# line 426 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_CsetLit,(int)Val1(yypvt[-0])) ;} break;
+case 194:
+# line 428 "cgram.g"
+{yyval = sect_nd(yypvt[-2],yypvt[-5],yypvt[-3],yypvt[-1]) ;} break;
+case 195:
+# line 430 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 196:
+# line 431 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 197:
+# line 432 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 199:
+# line 435 "cgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+	}
+	goto yystack;		/* reset registers in driver code */
+}
diff --git a/src/iconc/cproto.h b/src/iconc/cproto.h
new file mode 100644
index 0000000..a32b982
--- /dev/null
+++ b/src/iconc/cproto.h
@@ -0,0 +1,165 @@
+/*
+ * Prototypes for functions in iconc.
+ */
+struct sig_lst   *add_sig    (struct code *sig, struct c_fnc *fnc);
+void           addlib     (char *libname);
+struct code      *alc_ary    (int n);
+int               alc_cbufs  (int num, nodeptr lifetime);
+int               alc_dtmp   (nodeptr lifetime);
+int               alc_itmp   (nodeptr lifetime);
+struct code      *alc_lbl    (char *desc, int flag);
+int               alc_sbufs  (int num, nodeptr lifetime);
+#ifdef OptimizeType
+unsigned int   *alloc_mem_typ   (unsigned int n_types);
+#endif					/* OptimizeType */
+void           arth_anlz  (struct il_code *var1, struct il_code *var2,
+                               int *maybe_int, int *maybe_dbl, int *chk1,
+                               struct code **conv1p, int *chk2,
+                               struct code **conv2p);
+struct node      *aug_nd     (nodeptr op, nodeptr arg1, nodeptr arg2);
+struct node      *binary_nd  (nodeptr op, nodeptr arg1, nodeptr arg2);
+void         bitrange    (int typcd, int *frst_bit, int *last_bit);
+nodeptr           buildarray (nodeptr a, nodeptr lb, nodeptr e);
+void           callc_add  (struct c_fnc *cont);
+void           callo_add  (char *oper_nm, int ret_flag,
+                               struct c_fnc *cont, int need_cont,
+                               struct code *arglist, struct code *on_ret);
+struct node      *case_nd    (nodeptr loc_model, nodeptr expr, nodeptr cases);
+int               ccomp      (char *srcname, char *exename);
+void           cd_add     (struct code *cd);
+struct val_loc   *chk_alc    (struct val_loc *rslt, nodeptr lifetime);
+void           chkinv     (void);
+void           chkstrinv  (void);
+struct node      *c_str_leaf (int type,struct node *loc_model, char *c);
+void	          codegen    (struct node *t);
+int               cond_anlz  (struct il_code *il, struct code **cdp);
+void           const_blks (void);
+struct val_loc   *cvar_loc   (char *name);
+int               do_inlin   (struct implement *impl, nodeptr n, int *sep_cont,
+				struct op_symentry *symtab, int n_va);
+void	          doiconx    (char *s);
+struct val_loc   *dtmp_loc   (int n);
+void          eval_arith (int indx1, int indx2, int *maybe_int, int *maybe_dbl);
+int           eval_cnv   (int typcd, int indx, int def, int *cnv_flags);
+int	eval_is	(int typcd,int indx);
+void           findcases  (struct il_code *il, int has_dflt,
+                               struct case_anlz *case_anlz);
+void           fix_fncs   (struct c_fnc *fnc);
+struct fentry    *flookup    (char *id);
+void           gen_inlin  (struct il_code *il, struct val_loc *rslt,
+                               struct code **scont_strt,
+                               struct code **scont_fail, struct c_fnc *cont,
+                               struct implement *impl, int nsyms,
+                               struct op_symentry *symtab, nodeptr n,
+                               int dcl_var, int n_va);
+int	          getopr     (int ac, int *cc);
+#ifdef OptimizeType
+unsigned int    get_bit_vector (struct typinfo *src, int pos);
+#endif					/* OptimizeType */
+struct gentry    *glookup    (char *id);
+void	          hsyserr    (char **av, char *file);
+struct node      *i_str_leaf (int type,struct node *loc_model,char *c, int d);
+long              iconint    (char *image);
+struct code      *il_copy    (struct il_c *dest, struct val_loc *src);
+struct code      *il_cnv     (int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest);
+struct code      *il_dflt    (int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest);
+void           implproto  (struct implement *ip);
+void           init       (void);
+void           init_proc  (char *name);
+void           init_rec   (char *name);
+void           init_src   (void);
+void           install    (char *name,int flag);
+struct gentry    *instl_p    (char *name, int flag);
+struct node      *int_leaf   (int type,struct node *loc_model,int c);
+struct val_loc   *itmp_loc   (int n);
+struct node      *invk_main  (struct pentry *main_proc);
+struct node      *invk_nd    (struct node *loc_model, struct node *proc,
+                              struct node *args);
+void           invoc_grp  (char *grp);
+void           invocbl    (nodeptr op, int arity);
+struct node      *key_leaf   (nodeptr loc_model, char *keyname);
+void           liveness (nodeptr n, nodeptr resumer, nodeptr *failer, int *gen);
+struct node      *list_nd    (nodeptr loc_model, nodeptr args);
+void           lnkdcl     (char *name);
+void	          readdb     (char *db_name);
+struct val_loc   *loc_cpy    (struct val_loc *loc, int mod_access);
+#ifdef OptimizeType
+void           mark_recs (struct fentry *fp, struct typinfo *typ,
+                              int *num_offsets, int *offset, int *bad_recs);
+#else					/* OptimizeType */
+void           mark_recs (struct fentry *fp, unsigned int *typ,
+                              int *num_offsets, int *offset, int *bad_recs);
+#endif					/* OptimizeType */
+struct code      *mk_goto    (struct code *label);
+struct node      *multiunary (char *op, nodeptr loc_model, nodeptr oprnd);
+struct sig_act   *new_sgact  (struct code *sig, struct code *cd,
+                               struct sig_act *next);
+int               nextchar   (void);
+void           nfatal     (struct node *n, char *s1, char *s2);
+int               n_arg_sym  (struct implement *ip);
+void           outerfnc   (struct c_fnc *fnc);
+int               past_prms  (struct node *n);
+void           proccode   (struct pentry *proc);
+void           prt_fnc    (struct c_fnc *fnc);
+void           prt_frame  (char *prefix, int ntend, int n_itmp,
+				int i, int j, int k);
+struct centry    *putlit     (char *image,int littype,int len);
+struct lentry    *putloc     (char *id,int id_type);
+void	          quit       (char *msg);
+void	          quitf      (char *msg,char *arg);
+void           recconstr  (struct rentry *r);
+void           resolve    (struct pentry *proc);
+unsigned int      round2     (unsigned int n);
+struct code      *sig_cd     (struct code *fail, struct c_fnc *fnc);
+void           src_file   (char *name);
+struct node      *sect_nd    (nodeptr op, nodeptr arg1, nodeptr arg2,
+                               nodeptr arg3);
+void           tfatal     (char *s1,char *s2);
+struct node      *to_nd      (nodeptr loc_model, nodeptr arg1,
+                               nodeptr arg2);
+struct node      *toby_nd    (nodeptr loc_model, nodeptr arg1,
+                               nodeptr arg2, nodeptr arg3);
+int               trans      (void);
+struct node      *tree1      (int type);
+struct node      *tree2      (int type,struct node *loc_model);
+struct node      *tree3      (int type,struct node *loc_model,
+                               struct node *c);
+struct node      *tree4      (int type, struct node *loc_model,
+                               struct node *c, struct node *d);
+struct node      *tree5      (int type, struct node *loc_model,
+			       struct node *c, struct node *d,
+			       struct node *e);
+struct node      *tree6      (int type,struct node *loc_model,
+			       struct node *c, struct node *d,
+			       struct node *e, struct node *f);
+void	          tsyserr    (char *s);
+void	          twarn      (char *s1,char *s2);
+struct code      *typ_chk    (struct il_code *var, int typcd);
+int               type_case  (struct il_code *il, int (*fnc)(),
+                               struct case_anlz *case_anlz);
+void           typeinfer  (void);
+struct node      *unary_nd   (nodeptr op, nodeptr arg);
+void           var_dcls   (void);
+#ifdef OptimizeType
+int               varsubtyp  (struct typinfo *typ, struct lentry **single);
+#else					/* OptimizeType */
+int               varsubtyp  (unsigned int *typ, struct lentry **single);
+#endif					/* OptimizeType */
+void	          writecheck (int rc);
+void	          yyerror    (int tok,struct node *lval,int state);
+int               yylex      (void);
+int               yyparse    (void);
+#ifdef OptimizeType
+void         xfer_packed_types (struct typinfo *type);
+#endif					/* OptimizeType */
+
+#ifdef DeBug
+void symdump (void);
+void ldump   (struct lentry **lhash);
+void gdump   (void);
+void cdump   (void);
+void fdump   (void);
+void rdump   (void);
+#endif					/* DeBug */
diff --git a/src/iconc/csym.c b/src/iconc/csym.c
new file mode 100644
index 0000000..8e764e3
--- /dev/null
+++ b/src/iconc/csym.c
@@ -0,0 +1,853 @@
+/*
+ * csym.c -- functions for symbol table management.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+
+static struct gentry    *alcglob  (struct gentry *blink,
+				    char *name,int flag);
+static struct fentry    *alcfld   (struct fentry *blink, char *name,
+				    struct par_rec *rp);
+static struct centry    *alclit	  (struct centry *blink,
+				    char *image, int len,int flag);
+static struct lentry    *alcloc	  (struct lentry *blink,
+				    char *name,int flag);
+static struct par_rec   *alcprec  (struct rentry *rec, int offset,
+				    struct par_rec *next);
+static struct centry    *clookup  (char *image,int flag);
+static struct lentry    *dcl_loc  (char *id, int id_type,
+                                    struct lentry *next);
+static struct lentry    *llookup  (char *id);
+static void           opstrinv (struct implement *ip);
+static struct gentry    *putglob  (char *id,int id_type);
+static struct gentry    *try_gbl  (char *id);
+
+int max_sym = 0;  /* max number of parameter symbols in run-time routines */
+int max_prm = 0;  /* max number of parameters for any invocable routine */
+
+/*
+ * The operands of the invocable declaration are stored in a list for
+ *  later processing.
+ */
+struct strinv {
+   nodeptr op;
+   int arity;
+   struct strinv *next;
+   };
+struct strinv *strinvlst = NULL;
+int op_tbl_sz;
+
+struct pentry *proc_lst = NULL; /* procedure list */
+struct rentry *rec_lst = NULL;  /* record list */
+
+
+/*
+ *instl_p - install procedure or record in global symbol table, returning
+ *  the symbol table entry.
+ */
+struct gentry *instl_p(name, flag)
+char *name;
+int flag;
+   {
+   struct gentry *gp;
+
+   flag |= F_Global;
+   if ((gp = glookup(name)) == NULL) 
+      gp = putglob(name, flag);
+   else if ((gp->flag & (~F_Global)) == 0) {
+      /* 
+       * superfluous global declaration for record or proc
+       */
+      gp->flag |= flag;
+      }
+   else			/* the user can't make up his mind */
+      tfatal("inconsistent redeclaration", name);
+   return gp;
+   }
+
+/*
+ * install - put an identifier into the global or local symbol table.
+ *  The basic idea here is to look in the right table and install
+ *  the identifier if it isn't already there.  Some semantic checks
+ *  are performed.
+ */
+void install(name, flag)
+char *name;
+int flag;
+   {
+   struct fentry *fp;
+   struct gentry *gp;
+   struct lentry *lp;
+   struct par_rec **rpp;
+   struct fldname *fnp;
+   int foffset;
+
+   switch (flag) {
+      case F_Global:	/* a variable in a global declaration */
+         if ((gp = glookup(name)) == NULL)
+            putglob(name, flag);
+         else
+            gp->flag |= flag;
+         break;
+
+      case F_Static:	/* static declaration */
+         ++proc_lst->nstatic;
+         lp = dcl_loc(name, flag, proc_lst->statics);
+         proc_lst->statics = lp;
+         break;
+
+      case F_Dynamic:	/* local declaration */
+         ++proc_lst->ndynam;
+         lp = dcl_loc(name, flag, proc_lst->dynams);
+         proc_lst->dynams = lp;
+         break;
+
+      case F_Argument:	/* formal parameter */
+         ++proc_lst->nargs;
+         if (proc_lst->nargs > max_prm)
+            max_prm = proc_lst->nargs;
+         lp = dcl_loc(name, flag, proc_lst->args);
+         proc_lst->args = lp;
+         break;
+
+      case F_Field: /* field declaration */
+         fnp = NewStruct(fldname);
+         fnp->name = name;
+         fnp->next = rec_lst->fields;
+         rec_lst->fields = fnp;
+         foffset = rec_lst->nfields++;
+         if (foffset > max_prm)
+            max_prm = foffset;
+         if ((fp = flookup(name)) == NULL) {
+            /*
+             * first occurrence of this field name.
+             */
+            fhash[FHasher(name)] = alcfld(fhash[FHasher(name)], name,
+               alcprec(rec_lst, foffset, NULL));
+            }
+         else {
+            rpp = &(fp->rlist);
+            while (*rpp != NULL && (*rpp)->offset <= foffset &&
+               (*rpp)->rec != rec_lst)
+               rpp = &((*rpp)->next);
+            if (*rpp == NULL || (*rpp)->offset > foffset)
+               *rpp = alcprec(rec_lst, foffset, *rpp);
+            else
+               tfatal("duplicate field name", name);
+            }
+         break;
+
+      default:
+         tsyserr("install: unrecognized symbol table flag.");
+      }
+   }
+
+/*
+ * dcl_loc - handle declaration of a local identifier.
+ */
+static struct lentry *dcl_loc(name, flag, next)
+char *name;
+int flag;
+struct lentry *next;
+   {
+   register struct lentry *lp;
+
+   if ((lp = llookup(name)) == NULL) {
+      lp = putloc(name,flag);
+      lp->next = next;
+      }
+   else if (lp->flag == flag) /* previously declared as same type */
+      twarn("redeclared identifier", name);
+   else		/* previously declared as different type */
+      tfatal("inconsistent redeclaration", name);
+   return lp;
+   }
+
+/*
+ * putloc - make a local symbol table entry and return pointer to it.
+ */
+struct lentry *putloc(id,id_type)
+char *id;
+int id_type;
+   {
+   register struct lentry *ptr;
+   register struct lentry **lhash;
+   unsigned hashval;
+
+   if ((ptr = llookup(id)) == NULL) {	/* add to head of hash chain */
+      lhash = proc_lst->lhash;
+      hashval = LHasher(id);
+      ptr = alcloc(lhash[hashval], id, id_type);
+      lhash[hashval] = ptr;
+      ptr->next = NULL;
+      }
+   return ptr;
+   }
+
+/*
+ * putglob makes a global symbol table entry and returns a pointer to it.
+ */
+static struct gentry *putglob(id, id_type)
+char *id;
+int id_type;
+   {
+   register struct gentry *ptr;
+   register unsigned hashval;
+
+   if ((ptr = glookup(id)) == NULL) {	 /* add to head of hash chain */
+      hashval = GHasher(id);
+      ptr = alcglob(ghash[hashval], id, id_type);
+      ghash[hashval] = ptr;
+      }
+   return ptr;
+   }
+
+/*
+ * putlit makes a constant symbol table entry and returns a pointer to it.
+ */
+struct centry *putlit(image, littype, len)
+char *image;
+int len, littype;
+   {
+   register struct centry *ptr;
+   register unsigned hashval;
+
+   if ((ptr = clookup(image,littype)) == NULL) { /* add to head of hash chain */
+      hashval = CHasher(image);
+      ptr = alclit(chash[hashval], image, len, littype);
+      chash[hashval] = ptr;
+      }
+   return ptr;
+   }
+
+/*
+ * llookup looks up id in local symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+
+static struct lentry *llookup(id)
+char *id;
+   {
+   register struct lentry *ptr;
+
+   ptr = proc_lst->lhash[LHasher(id)];
+   while (ptr != NULL && ptr->name != id)
+      ptr = ptr->blink;
+   return ptr;
+   }
+
+/*
+ * flookup looks up id in flobal symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+struct fentry *flookup(id)
+char *id;
+   {
+   register struct fentry *ptr;
+
+   ptr = fhash[FHasher(id)];
+   while (ptr != NULL && ptr->name != id) {
+      ptr = ptr->blink;
+      }
+   return ptr;
+   }
+
+/*
+ * glookup looks up id in global symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+struct gentry *glookup(id)
+char *id;
+   {
+   register struct gentry *ptr;
+
+   ptr = ghash[GHasher(id)];
+   while (ptr != NULL && ptr->name != id) {
+      ptr = ptr->blink;
+      }
+   return ptr;
+   }
+
+/*
+ * clookup looks up id in constant symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+static struct centry *clookup(image,flag)
+char *image;
+int flag;
+   {
+   register struct centry *ptr;
+
+   ptr = chash[CHasher(image)];
+   while (ptr != NULL && (ptr->image != image || ptr->flag != flag))
+      ptr = ptr->blink;
+
+   return ptr;
+   }
+
+#ifdef DeBug
+/*
+ * symdump - dump symbol tables.
+ */
+void symdump()
+   {
+   struct pentry *proc;
+
+   gdump();
+   cdump();
+   rdump();
+   fdump();
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      fprintf(stderr,"\n");
+      fprintf(stderr,"Procedure %s\n", proc->sym_entry->name);
+      ldump(proc->lhash);
+      }
+   }
+
+/*
+ * prt_flgs - print flags from a symbol table entry.
+ */
+static void prt_flgs(flags)
+int flags;
+   {
+   if (flags & F_Global)
+      fprintf(stderr, " F_Global");
+   if (flags & F_Proc)
+      fprintf(stderr, " F_Proc");
+   if (flags & F_Record)
+      fprintf(stderr, " F_Record");
+   if (flags & F_Dynamic)
+      fprintf(stderr, " F_Dynamic");
+   if (flags & F_Static)
+      fprintf(stderr, " F_Static");
+   if (flags & F_Builtin)
+      fprintf(stderr, " F_Builtin");
+   if (flags & F_StrInv)
+      fprintf(stderr, " F_StrInv");
+   if (flags & F_ImpError)
+      fprintf(stderr, " F_ImpError");
+   if (flags & F_Argument)
+      fprintf(stderr, " F_Argument");
+   if (flags & F_IntLit)
+      fprintf(stderr, " F_IntLit");
+   if (flags & F_RealLit)
+      fprintf(stderr, " F_RealLit");
+   if (flags & F_StrLit)
+      fprintf(stderr, " F_StrLit");
+   if (flags & F_CsetLit)
+      fprintf(stderr, " F_CsetLit");
+   if (flags & F_Field)
+      fprintf(stderr, " F_Field");
+   fprintf(stderr, "\n");
+   }
+/*
+ * ldump displays local symbol table to stderr.
+ */
+
+void ldump(lhash)
+struct lentry **lhash;
+   {
+   register int i;
+   register struct lentry *lptr;
+
+   fprintf(stderr,"   Dump of local symbol table\n");
+   fprintf(stderr,"     address                 name  globol-ref  flags\n");
+   for (i = 0; i < LHSize; i++)
+      for (lptr = lhash[i]; lptr != NULL; lptr = lptr->blink) {
+         fprintf(stderr,"    %8x %20s    ", lptr, lptr->name);
+         if (lptr->flag & F_Global)
+            fprintf(stderr, "%8x ", lptr->val.global);
+         else
+            fprintf(stderr, "       - ");
+         prt_flgs(lptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * gdump displays global symbol table to stderr.
+ */
+
+void gdump()
+   {
+   register int i;
+   register struct gentry *gptr;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of global symbol table\n");
+   fprintf(stderr,"  address                 name  nargs  flags\n");
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         fprintf(stderr," %8x %20s   %4d ", gptr,
+		gptr->name, gptr->nargs);
+         prt_flgs(gptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * cdump displays constant symbol table to stderr.
+ */
+
+void cdump()
+   {
+   register int i;
+   register struct centry *cptr;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of constant symbol table\n");
+   fprintf(stderr,
+      "  address  value                                      flags\n");
+   for (i = 0; i < CHSize; i++)
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr->blink) {
+         fprintf(stderr," %8x  %-40.40s  ", cptr, cptr->image);
+         prt_flgs(cptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * fdump displays field symbol table to stderr.
+ */
+void fdump()
+   {
+   int i;
+   struct par_rec *prptr;
+   struct fentry *fp;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of field symbol table\n");
+   fprintf(stderr,
+      "  address                field  global-ref  offset\n");
+   for (i = 0; i < FHSize; i++)
+      for (fp = fhash[i]; fp != NULL; fp = fp->blink) {
+         fprintf(stderr," %8x %20s\n", fp, fp->name);
+         for (prptr = fp->rlist; prptr != NULL; prptr = prptr->next)
+            fprintf(stderr,"                                  %8x    %4d\n",
+               prptr->sym_entry, prptr->offset);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * prt_flds - print a list of fields stored in reverse order.
+ */
+static void prt_flds(f)
+struct fldname *f;
+   {
+   if (f == NULL)
+     return;
+   prt_flds(f->next);
+   fprintf(stderr, "  %s", f->name);
+   }
+
+/*
+ * rdump displays list of records and their fields.
+ */
+void rdump()
+   {
+   struct rentry *rp;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of record list\n");
+   fprintf(stderr, " global-ref   fields\n");
+   for (rp = rec_lst; rp != NULL; rp = rp->next) {
+      fprintf(stderr, "   %8x ", rp->sym_entry);
+      prt_flds(rp->fields);
+      fprintf(stderr, "\n");
+      }
+   }
+#endif					/* DeBug */
+
+/*
+ * alcloc allocates a local symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct lentry *alcloc(blink, name, flag)
+struct lentry *blink;
+char *name;
+int flag;
+   {
+   register struct lentry *lp;
+
+   lp = NewStruct(lentry);
+   lp->blink = blink;
+   lp->name = name;
+   lp->flag = flag;
+   return lp;
+   }
+
+/*
+ * alcfld allocates a field symbol table entry, fills in the entry with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct fentry *alcfld(blink, name, rp)
+struct fentry *blink;
+char *name;
+struct par_rec *rp;
+   {
+   register struct fentry *fp;
+
+   fp = NewStruct(fentry);
+   fp->blink = blink;
+   fp->name = name;
+   fp->rlist = rp;
+   return fp;
+   }
+
+/*
+ * alcglob allocates a global symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct gentry *alcglob(blink, name, flag)
+struct gentry *blink;
+char *name;
+int flag;
+   {
+   register struct gentry *gp;
+
+   gp = NewStruct(gentry);
+   gp->blink = blink;
+   gp->name = name;
+   gp->flag = flag;
+   return gp;
+   }
+
+/*
+ * alclit allocates a constant symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct centry *alclit(blink, image, len, flag)
+struct centry *blink;
+char *image;
+int len, flag;
+   {
+   register struct centry *cp;
+
+   cp = NewStruct(centry);
+   cp->blink = blink;
+   cp->image = image;
+   cp->length = len;
+   cp->flag = flag;
+   switch (flag) {
+      case F_IntLit:
+         cp->u.intgr = iconint(image);
+         break;
+      case F_CsetLit:
+         cp->u.cset = bitvect(image, len);
+         break;
+      }
+   return cp;
+   }
+
+/*
+ * alcprec allocates an entry for the parent record list for a field.
+ */
+static struct par_rec *alcprec(rec, offset, next)
+struct rentry *rec;
+int offset;
+struct par_rec *next;
+   {
+   register struct par_rec *rp;
+
+   rp = NewStruct(par_rec);
+   rp->rec= rec;
+   rp->offset = offset;
+   rp->next = next;
+   return rp;
+   }
+
+/*
+ * resolve - resolve the scope of undeclared identifiers.
+ */
+void resolve(proc)
+struct pentry *proc;
+   {
+   struct lentry **lhash;
+   register struct lentry *lp;
+   struct gentry *gp;
+   int i;
+   char *id;
+
+   lhash = proc->lhash;
+
+   for (i = 0; i < LHSize; ++i) {
+      lp = lhash[i];
+      while (lp != NULL) {
+         id = lp->name;
+         if (lp->flag == 0) {				/* undeclared */
+            if ((gp = try_gbl(id)) != NULL) {		/* check global */
+               lp->flag = F_Global;
+               lp->val.global = gp;
+               }
+            else {					/* implicit local */
+               if (uwarn) {
+                  fprintf(stderr, "%s undeclared identifier, procedure %s\n",
+                     id, proc->name);
+                  ++twarns;
+                  }
+               lp->flag = F_Dynamic;
+               lp->next = proc->dynams;
+               proc->dynams = lp;
+               ++proc->ndynam;
+               }
+            }
+         lp = lp->blink;
+         }
+      }
+   }
+
+/*
+ * try_glb - see if the identifier is or should be a global variable.
+ */
+static struct gentry *try_gbl(id)
+char *id;
+   {
+   struct gentry *gp;
+   register struct implement *iptr;
+   int nargs;
+   int n;
+
+   gp = glookup(id);
+   if (gp == NULL) {
+      /*
+       * See if it is a built-in function.
+       */
+      iptr = db_ilkup(id, bhash);
+      if (iptr == NULL)
+         return NULL;
+      else {
+        if (iptr->in_line == NULL)
+           nfatal(NULL, "built-in function not installed", id);
+         nargs = iptr->nargs;
+         if (nargs > 0 && iptr->arg_flgs[nargs - 1] & VarPrm)
+            nargs = -nargs;
+         gp = putglob(id, F_Global | F_Builtin);
+         gp->val.builtin = iptr;
+
+         n = n_arg_sym(iptr);
+         if (n > max_sym)
+            max_sym = n;
+         }
+      }
+   return gp;
+   }
+
+/*
+ * invoc_grp - called when "invocable all" is encountered.
+ */
+void invoc_grp(grp)
+char *grp;
+   {
+   if (grp == spec_str("all"))
+      str_inv = 1; /* enable full string invocation */
+   else
+      tfatal("invalid operand to invocable", grp);
+   }
+
+/*
+ * invocbl - indicate that the operator is needed for for string invocation.
+ */
+void invocbl(op, arity)
+nodeptr op;
+int arity;
+   {
+   struct strinv *si;
+   
+   si = NewStruct(strinv);
+   si->op = op;
+   si->arity = arity;
+   si->next = strinvlst;
+   strinvlst = si;  
+   }
+
+/*
+ * chkstrinv - check to see what is needed for string invocation.
+ */
+void chkstrinv()
+   {
+   struct strinv *si;
+   struct gentry *gp;
+   struct implement *ip;
+   char *op_name;
+   int arity;
+   int i;
+
+   /*
+    * A table of procedure blocks for operators is set up for use by
+    *  string invocation.
+    */
+   op_tbl_sz = 0;
+   fprintf(codefile, "\nstatic B_IProc(2) init_op_tbl[OpTblSz]");
+
+   if (str_inv) {
+      /*
+       * All operations must be available for string invocation. Make sure all
+       *  built-in functions have either been hidden by global declarations
+       *  or are in global variables, make sure no global variables are
+       *  optimized away, and make sure all operations are in the table of
+       *  operations.
+       */
+      for (i = 0; i < IHSize; ++i)  /* built-in function table */
+         for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+            try_gbl(ip->name);
+      for (i = 0; i < GHSize; i++)  /* global symbol table */
+         for (gp = ghash[i]; gp != NULL; gp = gp->blink)
+            gp->flag |= F_StrInv;
+      for (i = 0; i < IHSize; ++i)  /* operator table */
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            opstrinv(ip);
+      }
+   else {
+      /*
+       * selected operations must be available for string invocation.
+       */
+      for (si = strinvlst; si != NULL; si = si->next) {
+         op_name = Str0(si->op);
+         if (isalpha(*op_name) || (*op_name == '_')) {
+             /*
+              * This needs to be something in a global variable: function,
+              *  procedure, or constructor.
+              */
+             gp = try_gbl(op_name);
+             if (gp == NULL)
+                nfatal(si->op, "not available for string invocation", op_name);
+             else
+                gp->flag |= F_StrInv;
+             }
+         else {
+             /*
+              * must be an operator.
+              */
+             arity = si->arity;
+             i = IHasher(op_name);
+             for (ip = ohash[i]; ip != NULL && ip->op != op_name;
+                 ip = ip->blink)
+                 ;
+             if (arity < 0) {
+                /*
+                 * Operators of all arities with this symbol.
+                 */
+                while (ip != NULL && ip->op == op_name) {
+                   opstrinv(ip);
+                   ip = ip->blink;
+                   }
+                }
+             else {
+                /*
+                 * Operator of a specific arity.
+                 */
+                while (ip != NULL && ip->nargs != arity)
+                   ip = ip->blink;
+                if (ip == NULL || ip->op != op_name)
+                   nfatal(si->op, "not available for string invocation",
+                      op_name);
+                else
+                   opstrinv(ip);
+                }
+             }
+         }
+      }
+
+   /*
+    * Add definitions to the header file indicating the size of the operator
+    *  table and finish the declaration in the code file.
+    */
+   if (op_tbl_sz == 0) {
+      fprintf(inclfile, "#define OpTblSz 1\n");
+      fprintf(inclfile, "int op_tbl_sz = 0;\n");
+      fprintf(codefile, ";\n");
+      }
+   else {
+      fprintf(inclfile, "#define OpTblSz %d\n", op_tbl_sz);
+      fprintf(inclfile, "int op_tbl_sz = OpTblSz;\n");
+      fprintf(codefile, "\n   };\n");
+      }
+   }
+
+/*
+ * opstrinv - set up string invocation for an operator.
+ */
+static void opstrinv(ip)
+struct implement *ip;
+   {
+   char c1, c2;
+   char *name;
+   char *op;
+   register char *s;
+   int nargs;
+   int n;
+
+   if (ip == NULL || ip->iconc_flgs & InStrTbl) 
+      return;
+
+   /*
+    * Keep track of the maximum number of argument symbols in any operation
+    *  so type inference can allocate enough storage for the worst case of
+    *  general invocation.
+    */
+   n = n_arg_sym(ip);
+   if (n > max_sym)
+      max_sym = n;
+
+   name = ip->name;
+   c1 = ip->prefix[0];
+   c2 = ip->prefix[1];
+   op = ip->op;
+   nargs = ip->nargs;
+   if (ip->arg_flgs[nargs - 1] & VarPrm)
+      nargs = -nargs;   /* indicate varargs with negative number of params */
+
+   if (op_tbl_sz++ == 0) {
+       fprintf(inclfile, "\n");
+       fprintf(codefile, " = {\n");
+       }
+   else
+       fprintf(codefile, ",\n");
+   implproto(ip);   /* output prototype */
+
+   /*
+    * Output procedure block for this operator into table used by string
+    *  invocation.
+    */
+   fprintf(codefile, "   {T_Proc, 11, O%c%c_%s, %d, -1, 0, 0, {{%d, \"", c1, c2,
+      name, nargs, strlen(op));
+   for (s = op; *s != '\0'; ++s) {
+      if (*s == '\\')
+         fprintf(codefile, "\\");
+      fprintf(codefile, "%c", *s);
+      }
+   fprintf(codefile, "\"}}}");
+   ip->iconc_flgs |= InStrTbl;
+   }
+
+/*
+ * n_arg_sym - determine the number of argument symbols (dereferenced
+ *  and undereferenced arguments are separate symbols) for an operation
+ *  in the data base.
+ */
+int n_arg_sym(ip)
+struct implement *ip;
+   {
+   int i;
+   int num;
+
+   num = 0;
+   for (i = 0; i < ip->nargs; ++i) {
+      if (ip->arg_flgs[i] & RtParm)
+         ++num;
+      if (ip->arg_flgs[i] & DrfPrm)
+         ++num;
+      }
+   return num;
+   }
diff --git a/src/iconc/csym.h b/src/iconc/csym.h
new file mode 100644
index 0000000..cf104af
--- /dev/null
+++ b/src/iconc/csym.h
@@ -0,0 +1,380 @@
+/*
+ * Structures for symbol table entries.
+ */
+
+#define MaybeTrue  1 /* condition might be true at run time */
+#define MaybeFalse 2 /* condition might be false at run time */
+
+#define MayConvert 1 /* type conversion may convert the value */ 
+#define MayDefault 2 /* defaulting type conversion may use default */
+#define MayKeep    4 /* conversion may succeed without any actual conversion */
+
+#ifdef OptimizeType
+#define NULL_T     0x1000000 
+#define REAL_T     0x2000000
+#define INT_T      0x4000000
+#define CSET_T     0x8000000
+#define STR_T      0x10000000
+
+#define TYPINFO_BLOCK 400000
+
+/* 
+ * Optimized type structure for bit vectors  
+ *     All previous occurencess of unsigned int * (at least
+ *     when refering to bit vectors) have been replaced by 
+ *     struct typinfo.
+ */
+struct typinfo {
+   unsigned int packed;       /* packed representation of types */
+   unsigned int  *bits;         /* full length bit vector         */
+};
+#endif					/* OptimizeType */
+
+/*
+ * Data base type codes are mapped to type inferencing information using
+ *  an array.
+ */
+struct typ_info {
+   int frst_bit;      /* first bit in bit vector allocated to this type */
+   int num_bits;      /* number of bits in bit vector allocated to this type */
+   int new_indx;      /* index into arrays of allocated types for operation */
+#ifdef OptimizeType
+   struct typinfo *typ; /* for variables: initial type */
+#else					/* OptimizeType */
+   unsigned int *typ;   /* for variabled: initial type */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * A type is a bit vector representing a union of basic types. There
+ *  are 3 sizes of types: first class types (Icon language types),
+ *  intermediate value types (first class types plus variable references), 
+ *  run-time routine types (intermediate value types plus internal
+ *  references to descriptors such as set elements). When the size of
+ *  the type is known from context, a simple bit vector can be used.
+ *  In other contexts, the size must be included.
+ */
+struct type {
+   int size;
+#ifdef OptimizeType
+   struct typinfo *bits;
+#else					/* OptimizeType */
+   unsigned int *bits;
+#endif					/* OptimizeType */
+   struct type *next;
+   };
+
+
+#define DecodeSize(x)		(x & 0xFFFFFF)
+#define DecodePacked(x)		(x >> 24)
+/*
+ * NumInts - convert from the number of bits in a bit vector to the
+ *  number of integers implementing it.
+ */
+#define NumInts(n_bits) (n_bits - 1) / IntBits + 1
+
+/*
+ * ClrTyp - zero out the bit vector for a type.
+ */
+#ifdef OptimizeType
+#define ClrTyp(size,typ) {\
+   int typ_indx;\
+   if ((typ)->bits == NULL)\
+      clr_packed((typ),(size));\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+         (typ)->bits[typ_indx] = 0;}
+#else					/* OptimizeType */
+#define ClrTyp(size,typ) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (typ)[typ_indx] = 0;}
+#endif					/* OptimizeType */
+
+/*
+ * CpyTyp - copy a type of the given size from one bit vector to another.
+ */
+#ifdef OptimizeType
+#define CpyTyp(nsize,src,dest) {\
+   int typ_indx, num;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL))  {\
+      ClrTyp((nsize),(dest));\
+      cpy_packed_to_packed((src),(dest),(nsize));\
+   }\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL)) {\
+      ClrTyp((nsize),(dest));\
+      xfer_packed_to_bits((src),(dest),(nsize));\
+   }\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL))  {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] = (src)->bits[typ_indx];\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] = (src)->bits[typ_indx];}
+#else					/* OptimizeType */
+#define CpyTyp(size,src,dest) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (dest)[typ_indx] = (src)[typ_indx];}
+#endif					/* OptimizeType */
+
+/*
+ * MrgTyp - merge a type of the given size from one bit vector into another.
+ */
+#ifdef OptimizeType
+#define MrgTyp(nsize,src,dest) {\
+   int typ_indx;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL))\
+      mrg_packed_to_packed((src),(dest),(nsize));\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL))\
+      xfer_packed_to_bits((src),(dest),(nsize));\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL)) {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];}
+#else					/* OptimizeType */
+#define MrgTyp(size,src,dest) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (dest)[typ_indx] |= (src)[typ_indx];}
+#endif					/* OptimizeType */
+
+/*
+ * ChkMrgTyp - merge a type of the given size from one bit vector into another,
+ *  updating the changed flag if the destination is changed by the merger.
+ */
+#ifdef OptimizeType
+#define ChkMrgTyp(nsize,src,dest) {\
+   int typ_indx, ret; unsigned int old;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL)) {\
+       ret = mrg_packed_to_packed((src),(dest),(nsize));\
+       changed += ret;\
+   }\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL)) {\
+      ret = xfer_packed_to_bits((src),(dest),(nsize));\
+      changed += ret;\
+   }\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL)) {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx) {\
+         old = (dest)->bits[typ_indx];\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+         if (old != (dest)->bits[typ_indx]) ++changed;}\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx) {\
+         old = (dest)->bits[typ_indx];\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+         if (old != (dest)->bits[typ_indx]) ++changed;}}
+#else					/* OptimizeType */
+#define ChkMrgTyp(size,src,dest) {\
+   int typ_indx; unsigned int old;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx) {\
+      old = (dest)[typ_indx];\
+      (dest)[typ_indx] |= (src)[typ_indx];\
+      if (old != (dest)[typ_indx]) ++changed;}}
+#endif					/* OptimizeType */
+
+
+struct centry {		/* constant table entry */
+   struct centry *blink;	/*   link for bucket chain */
+   char *image;			/*   pointer to string image of literal */
+   int length;			/*   length of string */
+   union {
+      unsigned short *cset;	/*   pointer to bit string for cset literal */
+      long intgr;		/*   value of integer literal */
+      } u;
+   uword flag;			/*   type of literal flag */
+   char prefix[PrfxSz+1];	/*   unique prefix used in data block name */
+   };
+
+struct fentry {			/* field table entry */
+   struct fentry *blink;	/*   link for bucket chain */
+   char *name;			/*   name of field */
+   struct par_rec *rlist;	/*   head of list of records */
+   };
+
+struct lentry {			/* local table entry */
+   struct lentry *blink;	/*   link for bucket chain */
+   char *name;			/*   name of variable */
+   uword flag;			/*   variable flags */
+   union {
+      struct gentry *global;    /*   for globals: global symbol table entry */
+      int index;                /*   type index; run-time descriptor index */
+      } val;
+   struct lentry *next;		/*   used for linking a class of variables */
+   };
+
+struct gentry {			 /* global table entry */
+   struct gentry *blink;	 /*   link for bucket chain */
+   char *name;			 /*   name of variable */
+   uword flag;			 /*   variable flags */
+   union {
+      struct implement *builtin; /*   pointer to built-in function */
+      struct pentry *proc;	 /*   pointer to procedure entry */
+      struct rentry *rec;	 /*   pointer to record entry */
+      } val;
+   int index;			 /*   index into global array */
+   int init_type;                /*   initial type if procedure */
+   };
+
+/*
+ * Structure for list of parent records for a field name.
+ */
+struct par_rec {
+   struct rentry *rec;		/* parent record */
+   int offset;			/* field's offset within this record */
+   int mark;                    /* used during code generation */
+   struct par_rec *next;
+   };
+
+/*
+ * Structure for a procedure.
+ */
+struct pentry {
+   char *name;			/* name of procedure */
+   char prefix[PrfxSz+1];	/* prefix to make name unique */
+   struct lentry **lhash;	/* hash area for procedure's local table */
+   int nargs;			/* number of args */
+   struct lentry *args;		/* list of arguments in reverse order */
+   int ndynam;                  /* number of dynamic locals */
+   struct lentry *dynams;       /* list of dynamics in reverse order */
+   int nstatic;                 /* number of statics */
+   struct lentry *statics;	/* list of statics in reverse order */
+   struct node *tree;		/* syntax tree for procedure */
+   int has_coexpr;		/* this procedure contains co-expressions */
+   int tnd_loc;			/* number of tended dynamic locals */
+   int ret_flag;		/* proc returns, suspends, and/or fails */
+   int reachable;               /* this procedure may be executed */
+   int iteration;		/* last iteration of type inference performed */
+   int arg_lst;			/* for varargs - the type number of the list */
+#ifdef OptimizeType
+   struct typinfo *ret_typ;	/* type returned from procedure */
+#else					/* OptimizeType */
+   unsigned int *ret_typ;	/* type returned from procedure */
+#endif					/* OptimizeType */
+   struct store *in_store;	/* store at start of procedure */
+   struct store *susp_store;	/* store for resumption points of procedure */
+   struct store *out_store;	/* store on exiting procedure */
+   struct lentry **vartypmap;   /* mapping from var types to symtab entries */
+#ifdef OptimizeType
+   struct typinfo *coexprs;     /* co-expressions in which proc may be called */
+#else					/* OptimizeType */
+   unsigned int *coexprs;     /* co-expressions in which proc may be called */
+#endif					/* OptimizeType */
+   struct pentry *next;
+   };
+
+/*
+ * Structure for a record.
+ */
+struct rentry {
+   char *name;			/* name of record */
+   char prefix[PrfxSz+1];	/* prefix to make name unique */
+   int frst_fld;		/* offset of variable type of 1st field */
+   int nfields;			/* number of fields */
+   struct fldname *fields;	/* list of field names in reverse order */
+   int rec_num;			/* id number for record */
+   struct rentry *next;
+   };
+
+struct fldname {                /* record field */
+   char *name;                  /* field name */
+   struct fldname *next;
+   };
+
+/*
+ * Structure used to analyze whether a type_case statement can be in-lined.
+ *  Only one type check is supported: the type_case will be implemented
+ *  as an "if" statement.
+ */
+struct case_anlz {
+   int n_cases;             /* number of cases actually needed for this use */
+   int typcd;               /* for "if" optimization, the type code to check */
+   struct il_code *il_then; /* for "if" optimization, the then clause */
+   struct il_code *il_else; /* for "if" optimization, the else clause */
+   };
+
+/*
+ * spec_op contains the implementations for operations with do not have
+ *  standard unary/binary syntax.
+ */
+#define ToOp      0  /* index into spec_op of i to j */
+#define ToByOp    1  /* index into spec_op of i to j by k */
+#define SectOp    2  /* index into spec_op of x[i:j] */
+#define SubscOp   3  /* index into spec_op of x[i] */
+#define ListOp    4  /* index into spec_op of [e1, e2, ... ] */
+#define NumSpecOp 5
+extern struct implement *spec_op[NumSpecOp];
+
+/*
+ * Flag values.
+ */
+
+#define F_Global	    01	/* variable declared global externally */
+#define F_Proc		    04	/* procedure */
+#define F_Record	   010	/* record */
+#define F_Dynamic	   020	/* variable declared local dynamic */
+#define F_Static	   040	/* variable declared local static */
+#define F_Builtin	  0100	/* identifier refers to built-in procedure */
+#define F_StrInv          0200  /* variable needed for string invocation */
+#define F_ImpError	  0400	/* procedure has default error */
+#define F_Argument	 01000	/* variable is a formal parameter */
+#define F_IntLit	 02000	/* literal is an integer */
+#define F_RealLit	 04000	/* literal is a real */
+#define F_StrLit	010000	/* literal is a string */
+#define F_CsetLit	020000	/* literal is a cset */
+#define F_Field		040000  /* identifier refers to a record field */
+#define F_SmplInv      0100000  /* identifier only used in simple invocation */
+
+/*
+ * Symbol table region pointers.
+ */
+
+extern struct implement *bhash[];	/* hash area for built-in func table */
+extern struct centry *chash[];		/* hash area for constant table */
+extern struct fentry *fhash[];		/* hash area for field table */
+extern struct gentry *ghash[];		/* hash area for global table */
+extern struct implement *khash[];	/* hash area for keyword table */
+extern struct implement *ohash[];	/* hash area for operator table */
+
+extern struct pentry *proc_lst; /* procedure list */
+extern struct rentry *rec_lst;  /* record list */
+
+extern int max_sym; /* max number of parameter symbols in run-time routines */
+extern int max_prm; /* max number of parameters for any invocable routine */
+
+extern struct symtyps *cur_symtyps; /* maps run-time routine symbols to types */
+extern struct pentry *cur_proc; /* procedure currently being translated */
+
+/*
+ * Hash functions for symbol tables. Note, hash table sizes (xHSize)
+ *  are all a power of 2.
+ */
+
+#define CHasher(x)	(((word)x)&(CHSize-1))	 /* constant symbol table */
+#define FHasher(x)	(((word)x)&(FHSize-1))	 /* field symbol table */
+#define GHasher(x)	(((word)x)&(GHSize-1))	 /* global symbol table */
+#define LHasher(x)	(((word)x)&(LHSize-1))	 /* local symbol table */
+
+/*
+ * flags for implementation entries.
+ */
+#define ProtoPrint 1  /* a prototype has already been printed */
+#define InStrTbl   2  /* operator is in string table */
+
+/*
+ * Whether an operation can fail may depend on whether error conversion
+ *  is allowed. The following macro checks this.
+ */
+#define MightFail(ret_flag) ((ret_flag & DoesFail) ||\
+   (err_conv && (ret_flag & DoesEFail)))
diff --git a/src/iconc/ctoken.h b/src/iconc/ctoken.h
new file mode 100644
index 0000000..1e95e98
--- /dev/null
+++ b/src/iconc/ctoken.h
@@ -0,0 +1,111 @@
+# define IDENT 257
+# define INTLIT 258
+# define REALLIT 259
+# define STRINGLIT 260
+# define CSETLIT 261
+# define EOFX 262
+# define BREAK 263
+# define BY 264
+# define CASE 265
+# define CREATE 266
+# define DEFAULT 267
+# define DO 268
+# define ELSE 269
+# define END 270
+# define EVERY 271
+# define FAIL 272
+# define GLOBAL 273
+# define IF 274
+# define INITIAL 275
+# define INVOCABLE 276
+# define LINK 277
+# define LOCAL 278
+# define NEXT 279
+# define NOT 280
+# define OF 281
+# define PROCEDURE 282
+# define RECORD 283
+# define REPEAT 284
+# define RETURN 285
+# define STATIC 286
+# define SUSPEND 287
+# define THEN 288
+# define TO 289
+# define UNTIL 290
+# define WHILE 291
+# define BANG 292
+# define MOD 293
+# define AUGMOD 294
+# define AND 295
+# define AUGAND 296
+# define STAR 297
+# define AUGSTAR 298
+# define INTER 299
+# define AUGINTER 300
+# define PLUS 301
+# define AUGPLUS 302
+# define UNION 303
+# define AUGUNION 304
+# define MINUS 305
+# define AUGMINUS 306
+# define DIFF 307
+# define AUGDIFF 308
+# define DOT 309
+# define SLASH 310
+# define AUGSLASH 311
+# define ASSIGN 312
+# define SWAP 313
+# define NMLT 314
+# define AUGNMLT 315
+# define REVASSIGN 316
+# define REVSWAP 317
+# define SLT 318
+# define AUGSLT 319
+# define SLE 320
+# define AUGSLE 321
+# define NMLE 322
+# define AUGNMLE 323
+# define NMEQ 324
+# define AUGNMEQ 325
+# define SEQ 326
+# define AUGSEQ 327
+# define EQUIV 328
+# define AUGEQUIV 329
+# define NMGT 330
+# define AUGNMGT 331
+# define NMGE 332
+# define AUGNMGE 333
+# define SGT 334
+# define AUGSGT 335
+# define SGE 336
+# define AUGSGE 337
+# define QMARK 338
+# define AUGQMARK 339
+# define AT 340
+# define AUGAT 341
+# define BACKSLASH 342
+# define CARET 343
+# define AUGCARET 344
+# define BAR 345
+# define CONCAT 346
+# define AUGCONCAT 347
+# define LCONCAT 348
+# define AUGLCONCAT 349
+# define TILDE 350
+# define NMNE 351
+# define AUGNMNE 352
+# define SNE 353
+# define AUGSNE 354
+# define NEQUIV 355
+# define AUGNEQUIV 356
+# define LPAREN 357
+# define RPAREN 358
+# define PCOLON 359
+# define COMMA 360
+# define MCOLON 361
+# define COLON 362
+# define SEMICOL 363
+# define LBRACK 364
+# define RBRACK 365
+# define LBRACE 366
+# define RBRACE 367
diff --git a/src/iconc/ctrans.c b/src/iconc/ctrans.c
new file mode 100644
index 0000000..7d33ac5
--- /dev/null
+++ b/src/iconc/ctrans.c
@@ -0,0 +1,184 @@
+/*
+ * ctrans.c - main control of the translation process.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+static void	trans1		(char *filename);
+
+/*
+ * Variables.
+ */
+int tfatals = 0;		/* total number of fatal errors */
+int twarns = 0;			/* total number of warnings */
+int nocode;			/* set by lexer; unused in compiler */
+int in_line;			/* current input line number */
+int incol;			/* current input column number */
+int peekc;			/* one-character look ahead */
+struct srcfile *srclst = NULL;	/* list of source files to translate */
+
+static char *lpath;		/* LPATH value */
+
+/*
+ * translate a number of files, returning an error count
+ */
+int trans()
+   {
+   register struct pentry *proc;
+   struct srcfile *sf;
+
+   lpath = getenv("LPATH");	/* remains null if unspecified */
+
+   for (sf = srclst; sf != NULL; sf = sf->next)
+      trans1(sf->name);	/* translate each file in turn */
+
+   if (!pponly) {
+      /*
+       * Resolve undeclared references.
+       */
+      for (proc = proc_lst; proc != NULL; proc = proc->next)
+         resolve(proc);
+   
+#ifdef DeBug
+      symdump();
+#endif					/* DeBug */
+   
+      if (tfatals == 0) {
+         chkstrinv();  /* see what needs be available for string invocation */
+         chkinv();     /* perform "naive" optimizations */
+         }
+   
+      if (tfatals == 0)
+         typeinfer();        /* perform type inference */
+   
+      if (just_type_trace)
+         return tfatals;     /* stop without generating code */
+   
+      if (tfatals == 0) {
+         var_dcls();         /* output declarations for globals and statics */
+         const_blks();       /* output blocks for cset and real literals */
+         for (proc = proc_lst; proc != NULL; proc = proc->next)
+            proccode(proc);  /* output code for a procedure */
+         recconstr(rec_lst); /* output code for record constructors */
+/* ANTHONY */
+/*
+	 print_ghash();
+*/
+      }
+    }
+
+   /*
+    * Report information about errors and warnings and be correct about it.
+    */
+   if (tfatals == 1)
+      fprintf(stderr, "1 error; ");
+   else if (tfatals > 1)
+      fprintf(stderr, "%d errors; ", tfatals);
+   else if (verbose > 0)
+      fprintf(stderr, "No errors; ");
+
+   if (twarns == 1)
+      fprintf(stderr, "1 warning\n");
+   else if (twarns > 1)
+      fprintf(stderr, "%d warnings\n", twarns);
+   else if (verbose > 0)
+      fprintf(stderr, "no warnings\n");
+   else if (tfatals > 0)
+      fprintf(stderr, "\n");
+
+#ifdef TranStats
+   tokdump();
+#endif					/* TranStats */
+
+   return tfatals;
+   }
+
+/*
+ * translate one file.
+ */
+static void trans1(filename)
+char *filename;
+   {
+   in_line = 1;			/* start with line 1, column 0 */
+   incol = 0;
+   peekc = 0;			/* clear character lookahead */
+
+   if (!ppinit(filename,lpath?lpath:".",m4pre)) {
+      tfatal(filename, "cannot open source file");
+      return;
+      }
+   if (!largeints)		/* undefine predef symbol if no -l option */
+      ppdef("_LARGE_INTEGERS", (char *)NULL);
+   ppdef("_MULTITASKING", (char *)NULL);	/* never defined in compiler */
+   ppdef("_EVENT_MONITOR", (char *)NULL);
+   ppdef("_MEMORY_MONITOR", (char *)NULL);
+   ppdef("_VISUALIZATION", (char *)NULL);
+
+   if (strcmp(filename,"-") == 0)
+      filename = "stdin";
+   if (verbose > 0)
+      fprintf(stderr, "%s:\n",filename);
+
+   tok_loc.n_file = filename;
+   in_line = 1;
+
+   if (pponly)
+      ppecho();			/* preprocess only */
+   else
+   yyparse();				/* Parse the input */
+      }
+
+/*
+ * writecheck - check the return code from a stdio output operation
+ */
+void writecheck(rc)
+   int rc;
+
+   {
+   if (rc < 0)
+      quit("unable to write to icode file");
+   }
+
+/*
+ * lnkdcl - find file locally or on LPATH and add to source list.
+ */
+void lnkdcl(name)
+char *name;
+{
+   struct srcfile **pp;
+   struct srcfile *p;
+   char buf[MaxPath];
+
+   if (pathfind(buf, lpath, name, SourceSuffix))
+      src_file(buf);
+   else
+      tfatal("cannot resolve reference to file name", name);
+      }
+
+/*
+ * src_file - add the file name to the list of source files to be translated,
+ *   if it is not already on the list.
+ */
+void src_file(name)
+char *name;
+   {
+   struct srcfile **pp;
+   struct srcfile *p;
+
+   for (pp = &srclst; *pp != NULL; pp = &(*pp)->next)
+     if (strcmp((*pp)->name, name) == 0)
+        return;
+   p = NewStruct(srcfile);
+   p->name = salloc(name);
+   p->next = NULL;
+   *pp = p;
+}
diff --git a/src/iconc/ctrans.h b/src/iconc/ctrans.h
new file mode 100644
index 0000000..3e03d06
--- /dev/null
+++ b/src/iconc/ctrans.h
@@ -0,0 +1,47 @@
+/*
+ *  Miscellaneous compiler-specific definitions.
+ */
+
+#define Iconc
+
+#ifndef CUsage
+   #define CUsage "[-C C-comp] [-E] [-T] [-c] [-f{adelns}] [-n{acest}]\n\
+ [-o ofile] [-p C-opts] [-r runtime] [-s] [-t] [-u] [-v i]"
+#endif					/* CUsage */
+
+#define Abs(n) ((n) >= 0 ? (n) : -(n))
+#define Max(x,y) ((x)>(y)?(x):(y))
+
+#define tonum(c)	(isdigit(c) ? (c - '0') : ((c & 037) + 9))
+
+/*
+ * Hash tables must be a power of 2.
+ */
+#define CHSize 128	/* size of constant hash table */
+#define FHSize  32	/* size of field hash table */
+#define GHSize 128	/* size of global hash table */
+#define LHSize 128	/* size of local hash table */
+
+#define PrfxSz 3        /* size of prefix */
+
+/*
+ * srcfile is used construct the queue of source files to be translated.
+ */
+struct srcfile {
+   char *name;
+   struct srcfile *next;
+   };
+
+extern struct srcfile *srclst;
+
+/*
+ * External definitions needed throughout translator.
+ */
+extern int twarns;
+
+#ifdef TranStats
+#include "tstats.h"
+#else					/* TranStats */
+#define TokInc(x)
+#define TokDec(x)
+#endif					/* TranStats */
diff --git a/src/iconc/ctree.c b/src/iconc/ctree.c
new file mode 100644
index 0000000..170a631
--- /dev/null
+++ b/src/iconc/ctree.c
@@ -0,0 +1,777 @@
+/*
+ * ctree.c -- functions for constructing parse trees.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "csym.h"
+#include "ctoken.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * prototypes for static functions.
+ */
+static nodeptr chk_empty (nodeptr n);
+static void put_elms  (nodeptr t, nodeptr args, int slot);
+static nodeptr subsc_nd  (nodeptr op, nodeptr arg1, nodeptr arg2);
+
+/*
+ *  tree[1-6] construct parse tree nodes with specified values.
+ *   loc_model is a node containing the same line and column information
+ *   as is needed in this node, while parameters a through d are values to
+ *   be assigned to n_field[0-3]. Note that this could be done with a
+ *   single routine; a separate routine for each node size is used for
+ *   speed and simplicity.
+ */
+
+nodeptr tree1(type)
+int type;
+   {
+   register nodeptr t;
+
+   t = NewNode(0);
+   t->n_type = type;
+   t->n_file = NULL;
+   t->n_line = 0;
+   t->n_col = 0;
+   t->freetmp = NULL;
+   return t;
+   }
+
+nodeptr tree2(type, loc_model)
+int type;
+nodeptr loc_model;
+   {
+   register nodeptr t;
+
+   t = NewNode(0);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   return t;
+   }
+
+nodeptr tree3(type, loc_model, a)
+int type;
+nodeptr loc_model;
+nodeptr a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   return t;
+   }
+
+nodeptr tree4(type, loc_model, a, b)
+int type;
+nodeptr loc_model;
+nodeptr a, b;
+   {
+   register nodeptr t;
+
+   t = NewNode(2);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   return t;
+   }
+
+nodeptr tree5(type, loc_model, a, b, c)
+int type;
+nodeptr loc_model;
+nodeptr a, b, c;
+   {
+   register nodeptr t;
+
+   t = NewNode(3);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   t->n_field[2].n_ptr = c;
+   return t;
+   }
+
+nodeptr tree6(type, loc_model, a, b, c, d)
+int type;
+nodeptr loc_model;
+nodeptr a, b, c, d;
+   {
+   register nodeptr t;
+
+   t = NewNode(4);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   t->n_field[2].n_ptr = c;
+   t->n_field[3].n_ptr = d;
+   return t;
+   }
+
+nodeptr int_leaf(type, loc_model, a)
+int type;
+nodeptr loc_model;
+int a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = a;
+   return t;
+   }
+
+nodeptr c_str_leaf(type, loc_model, a)
+int type;
+nodeptr loc_model;
+char *a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_str = a;
+   return t;
+   }
+
+/*
+ * i_str_leaf - create a leaf node containing a string and length.
+ */
+nodeptr i_str_leaf(type, loc_model, a, b)
+int type;
+nodeptr loc_model;
+char *a;
+int b;
+   {
+   register nodeptr t;
+
+   t = NewNode(2);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_str = a;
+   t->n_field[1].n_val = b;
+   return t;
+   }
+
+/*
+ * key_leaf - create a leaf node for a keyword.
+ */
+nodeptr key_leaf(loc_model, keyname)
+nodeptr loc_model;
+char *keyname;
+   {
+   register nodeptr t;
+   struct implement *ip;
+   struct il_code *il;
+   char *s;
+   int typcd;
+
+   /*
+    * Find the data base entry for the keyword, if it exists.
+    */
+   ip = db_ilkup(keyname, khash);
+
+   if (ip == NULL)
+      tfatal("invalid keyword", keyname);
+   else if (ip->in_line == NULL)
+      tfatal("keyword not installed", keyname);
+   else {
+      il = ip->in_line;
+      s = il->u[1].s;
+      if (il->il_type == IL_Const) {
+        /*
+         * This is a constant keyword, treat it as a literal.
+         */
+        t = NewNode(1);
+        t->n_file = loc_model->n_file;
+        t->n_line = loc_model->n_line;
+        t->n_col = loc_model->n_col;
+        t->freetmp = NULL;
+        typcd = il->u[0].n;
+        if (typcd == cset_typ) {
+           t->n_type =  N_Cset;
+           CSym0(t) = putlit(&s[1], F_CsetLit, strlen(s) - 2);
+           }
+        else if (typcd == int_typ) {
+           t->n_type = N_Int;
+           CSym0(t) = putlit(s, F_IntLit, 0);
+           }
+        else if (typcd == real_typ) {
+           t->n_type = N_Real;
+           CSym0(t) = putlit(s, F_RealLit, 0);
+           }
+        else if (typcd == str_typ) {
+           t->n_type = N_Str;
+           CSym0(t) = putlit(&s[1], F_StrLit, strlen(s) - 2);
+           }
+        return t;
+        }
+     }
+
+   t = NewNode(2);
+   t->n_type = N_InvOp;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 0;      /* number of arguments */
+   t->n_field[1].ip = ip;
+   return t;
+   }
+
+/*
+ * list_nd - create a list creation node.
+ */
+nodeptr list_nd(loc_model, args)
+nodeptr loc_model;
+nodeptr args;
+   {
+   register nodeptr t;
+   struct implement *impl;
+   int nargs;
+
+   /*
+    * Determine the number of arguments.
+    */
+   if (args->n_type == N_Empty)
+      nargs = 0;
+   else {
+      nargs = 1;
+      for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
+         ++nargs;
+      if (nargs > max_prm)
+         max_prm = nargs;
+      }
+
+   impl = spec_op[ListOp];
+   if (impl == NULL)
+      nfatal(loc_model, "list creation not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(loc_model, "list creation not installed", NULL);
+
+   t = NewNode(nargs + 2);
+   t->n_type = N_InvOp;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = nargs;
+   t->n_field[1].ip = impl;
+   if (nargs > 0)
+      put_elms(t, args, nargs + 1);
+   return t;
+   }
+
+/*
+ * invk_nd - create a node for invocation.
+ */
+nodeptr invk_nd(loc_model, proc, args)
+nodeptr loc_model;
+nodeptr proc;
+nodeptr args;
+   {
+   register nodeptr t;
+   int nargs;
+
+   /*
+    * Determine the number of arguments.
+    */
+   if (args->n_type == N_Empty)
+      nargs = 0;
+   else {
+      nargs = 1;
+      for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
+         ++nargs;
+      if (nargs > max_prm)
+         max_prm = nargs;
+      }
+
+   t = NewNode(nargs + 2);
+   t->n_type = N_Invok;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = nargs;
+   t->n_field[1].n_ptr = proc;
+   if (nargs > 0)
+      put_elms(t, args, nargs + 1);
+   return t;
+   }
+
+/*
+ * put_elms - convert a linked list of arguments into an array of arguments
+ *  in a node.
+ */
+static void put_elms(t, args, slot)
+nodeptr t;
+nodeptr args;
+int slot;
+   {
+   if (args->n_type == N_Elist) {
+      /*
+       * The linked list is in reverse argument order.
+       */
+      t->n_field[slot].n_ptr = chk_empty(args->n_field[1].n_ptr);
+      put_elms(t, args->n_field[0].n_ptr, slot - 1);
+      free(args);
+      }
+   else
+      t->n_field[slot].n_ptr = chk_empty(args);
+   }
+
+/*
+ * chk_empty - if an argument is empty, replace it with &null.
+ */
+static nodeptr chk_empty(n)
+nodeptr n;
+   {
+   if (n->n_type == N_Empty)
+      n = key_leaf(n, spec_str("null"));
+   return n;
+   }
+
+/*
+ * case_nd - create a node for a case statement.
+ */
+nodeptr case_nd(loc_model, expr, cases)
+nodeptr loc_model;
+nodeptr expr;
+nodeptr cases;
+   {
+   register nodeptr t;
+   nodeptr reverse;
+   nodeptr nxt_cases;
+   nodeptr ccls;
+
+   t = NewNode(3);
+   t->n_type = N_Case;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = expr;
+   t->n_field[2].n_ptr = NULL;
+
+   /*
+    * The list of cases is in reverse order. Walk the list reversing it,
+    *  and extract the default clause if one exists.
+    */
+   reverse = NULL;
+   while (cases->n_type != N_Ccls) {
+      nxt_cases = cases->n_field[0].n_ptr;
+      ccls = cases->n_field[1].n_ptr;
+      if (ccls->n_field[0].n_ptr->n_type == N_Res) {
+         /*
+          * default clause.
+          */
+         if (t->n_field[2].n_ptr == NULL)
+            t->n_field[2].n_ptr = ccls->n_field[1].n_ptr;
+         else
+            nfatal(ccls, "duplicate default clause", NULL);
+         }
+       else {
+          if (reverse == NULL) {
+             reverse = cases;
+             reverse->n_field[0].n_ptr = ccls;
+             }
+          else {
+             reverse->n_field[1].n_ptr = ccls;
+             cases->n_field[0].n_ptr = reverse;
+             reverse = cases;
+             }
+         }
+      cases = nxt_cases;
+      }
+
+   /*
+    * Last element in list.
+    */
+   if (cases->n_field[0].n_ptr->n_type == N_Res) {
+      /*
+       * default clause.
+       */
+      if (t->n_field[2].n_ptr == NULL)
+         t->n_field[2].n_ptr = cases->n_field[1].n_ptr;
+      else
+         nfatal(ccls, "duplicate default clause", NULL);
+      if (reverse != NULL)
+         reverse = reverse->n_field[0].n_ptr;
+      }
+   else {
+      if (reverse == NULL)
+         reverse = cases;
+      else
+         reverse->n_field[1].n_ptr = cases;
+      }
+   t->n_field[1].n_ptr = reverse;
+   return t;
+   }
+
+/*
+ * multiunary - construct nodes to implement a sequence of unary operators
+ *  that have been lexically analyzed as one operator.
+ */
+nodeptr multiunary(op, loc_model, oprnd)
+nodeptr loc_model;
+char *op;
+nodeptr oprnd;
+   {
+   int n;
+   nodeptr nd;
+
+   if (*op == '\0')
+     return oprnd;
+   for (n = 0; optab[n].tok.t_word != NULL; ++n)
+      if ((optab[n].expected & Unary) & (*(optab[n].tok.t_word) == *op)) {
+         nd = OpNode(n);
+         nd->n_file = loc_model->n_file;
+         nd->n_line = loc_model->n_line;
+         nd->n_col = loc_model->n_col;
+         return unary_nd(nd,multiunary(++op,loc_model,oprnd));
+         }
+   fprintf(stderr, "compiler error: inconsistent parsing of unary operators");
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * binary_nd - construct a node for a binary operator.
+ */
+nodeptr binary_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for the operator.
+    */
+   impl = optab[Val0(op)].binary;
+   if (impl == NULL)
+      nfatal(op, "binary operator not implemented", optab[Val0(op)].tok.t_word);
+   else if (impl->in_line == NULL)
+      nfatal(op, "binary operator not installed", optab[Val0(op)].tok.t_word);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * unary_nd - construct a node for a unary operator.
+ */
+nodeptr unary_nd(op, arg)
+nodeptr op;
+nodeptr arg;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for the operator.
+    */
+   impl = optab[Val0(op)].unary;
+   if (impl == NULL)
+      nfatal(op, "unary operator not implemented", optab[Val0(op)].tok.t_word);
+   else if (impl->in_line == NULL)
+      nfatal(op, "unary operator not installed", optab[Val0(op)].tok.t_word);
+
+   t = NewNode(3);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 1;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg;
+   return t;
+   }
+
+/*
+ * buildarray - convert "multi-dimensional" subscripting into a sequence
+ *  of subsripting operations.
+ */
+nodeptr buildarray(a,lb,e)
+nodeptr a, lb, e;
+   {
+   register nodeptr t, t2;
+   if (e->n_type == N_Elist) {
+      t2 = int_leaf(lb->n_type, lb, lb->n_field[0].n_val);
+      t = subsc_nd(t2, buildarray(a,lb,e->n_field[0].n_ptr),
+         e->n_field[1].n_ptr);
+      free(e);
+      }
+   else
+      t = subsc_nd(lb, a, e);
+   return t;
+   }
+
+/*
+ * subsc_nd - construct a node for subscripting.
+ */
+static nodeptr subsc_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for subscripting.
+    */
+   impl = spec_op[SubscOp];
+   if (impl == NULL)
+      nfatal(op, "subscripting not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "subscripting not installed", NULL);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * to_nd - construct a node for binary to.
+ */
+nodeptr to_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for to.
+    */
+   impl = spec_op[ToOp];
+   if (impl == NULL)
+      nfatal(op, "'i to j' not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "'i to j' not installed", NULL);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * toby_nd - construct a node for binary to-by.
+ */
+nodeptr toby_nd(op, arg1, arg2, arg3)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+nodeptr arg3;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for to-by.
+    */
+   impl = spec_op[ToByOp];
+   if (impl == NULL)
+      nfatal(op, "'i to j by k' not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "'i to j by k' not installed", NULL);
+
+   t = NewNode(5);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 3;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   t->n_field[4].n_ptr = arg3;
+   return t;
+   }
+
+/*
+ * aug_nd - create a node for an augmented assignment.
+ */
+nodeptr aug_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   t = NewNode(5);
+   t->n_type = N_Augop;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+
+   /*
+    * Find the data base entry for assignment.
+    */
+   impl = optab[asgn_loc].binary;
+   if (impl == NULL)
+      nfatal(op, "assignment not implemented", NULL);
+   t->n_field[0].ip = impl;
+
+   /*
+    * The operator table entry for the augmented assignment is
+    *  immediately after the entry for the operation.
+    */
+   impl = optab[Val0(op) - 1].binary;
+   if (impl == NULL)
+      nfatal(op, "binary operator not implemented",
+         optab[Val0(op) - 1].tok.t_word);
+   t->n_field[1].ip = impl;
+
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   /* t->n_field[4].typ - type of intermediate result */
+   return t;
+   }
+
+/*
+ * sect_nd - create a node for sectioning.
+ */
+nodeptr sect_nd(op, arg1, arg2, arg3)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+nodeptr arg3;
+   {
+   register nodeptr t;
+   int tok;
+   struct implement *impl;
+   struct implement *impl1;
+
+   t = NewNode(5);
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+
+   /*
+    * Find the data base entry for sectioning.
+    */
+   impl = spec_op[SectOp];
+   if (impl == NULL)
+      nfatal(op, "sectioning not implemented", NULL);
+
+   tok = optab[Val0(op)].tok.t_type;
+   if (tok == COLON) {
+      /*
+       * Simple sectioning, treat as a ternary operator.
+       */
+      t->n_type = N_InvOp;
+      t->n_field[0].n_val = 3;      /* number of arguments */
+      t->n_field[1].ip = impl;
+      }
+   else {
+      /*
+       * Find the data base entry for addition or subtraction.
+       */
+      if (tok == PCOLON) {
+         impl1 = optab[plus_loc].binary;
+         if (impl1 == NULL)
+            nfatal(op, "addition not implemented", NULL);
+         }
+      else { /* MCOLON */
+         impl1 = optab[minus_loc].binary;
+         if (impl1 == NULL)
+            nfatal(op, "subtraction not implemented", NULL);
+         }
+      t->n_type = N_Sect;
+      t->n_field[0].ip = impl;
+      t->n_field[1].ip = impl1;
+      }
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   t->n_field[4].n_ptr = arg3;
+   return t;
+   }
+
+/*
+ * invk_main - produce an procedure invocation node with one argument for
+ *  use in the initial invocation to main() during type inference.
+ */
+nodeptr invk_main(main_proc)
+struct pentry *main_proc;
+   {
+   register nodeptr t;
+
+   t = NewNode(3);
+   t->n_type = N_InvProc;
+   t->n_file = NULL; 
+   t->n_line = 0;
+   t->n_col = 0;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 1;               /* 1 argument */
+   t->n_field[1].proc = main_proc;
+   t->n_field[2].n_ptr = tree1(N_Empty);
+
+   if (max_prm < 1)
+      max_prm = 1;
+   return t;
+   }
diff --git a/src/iconc/ctree.h b/src/iconc/ctree.h
new file mode 100644
index 0000000..d38d3c4
--- /dev/null
+++ b/src/iconc/ctree.h
@@ -0,0 +1,200 @@
+/*
+ * Structure of a tree node.
+ */
+
+typedef	struct node	*nodeptr;
+
+/*
+ * Kinds of fields in syntax tree node.
+ */
+union field {
+   long n_val;		 /* integer-valued fields */
+   char *n_str;		 /* string-valued fields */
+   struct lentry *lsym;  /* fields referencing local symbol table entries */ 
+   struct centry *csym;  /* fields referencing constant symbol table entries */
+   struct implement *ip; /* fields referencing an operation */
+   struct pentry *proc;	 /* pointer to procedure entry */
+   struct rentry *rec;	 /* pointer to record entry */
+#ifdef OptimizeType
+   struct typinfo *typ;  /* extra type field */
+#else					/* OptimizeType */
+   unsigned int *typ;    /* extra type field */
+#endif					/* OptimizeType */
+   nodeptr n_ptr;	 /* subtree pointers */
+   };
+
+/*
+ * A store is an array that maps variables types (which are given indexes)
+ *  to the types stored within the variables.
+ */
+struct store {
+   struct store *next;
+   int perm;               /* flag: whether store stays across iterations */
+#ifdef OptimizeType
+   struct typinfo *types[1]; /* actual size is number of variables */
+#else					/* OptimizeType */
+   unsigned int *types[1]; /* actual size is number of variables */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * Array of parameter types for an operation call.
+ */
+struct symtyps {
+   int nsyms;                /* number of parameter symbols */
+   struct symtyps *next;
+#ifdef OptimizeType
+   struct typinfo *types[1];   /* really one for every symbol */
+#else					/* OptimizeType */
+   unsigned int *types[1];   /* really one for every symbol */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * definitions for maintaining allocation status.
+ */
+#define NotAlloc 0   /* temp var neither in use nor reserved */
+#define InUnse   1   /* temp var currently contains live variable */
+/*            n < 0     reserved: must be free by node with postn field = n */
+
+#define DescTmp 1    /* allocation of descriptor temporary */
+#define CIntTmp 2    /* allocation of C integer temporary */
+#define CDblTmp 3    /* allocation of C double temporary */
+#define SBuf    4    /* allocation of string buffer */
+#define CBuf    5    /* allocation of cset buffer */
+
+struct freetmp {     /* list of things to free at a node */
+   int kind;         /*   DescTmp, CIntTmp, CDblTmp, SBuf, or CBuf */
+   int indx;         /*   index into status array */
+   int old;          /*   old status */
+   struct freetmp *next;
+   };
+
+struct node {
+   int n_type;		    /* node type */
+   char *n_file;	    /* name of file containing source program */
+   int n_line;		    /* line number in source program */
+   int n_col;		    /* column number in source program */
+   int flag;
+   int *new_types;          /* pntr to array of struct types created here */
+#ifdef OptimizeType
+   struct typinfo *type;	    /* type of this expression */
+#else					/* OptimizeType */
+   unsigned int *type;		    /* type of this expression */
+#endif					/* OptimizeType */
+   struct store *store;     /* if needed, store saved between iterations */
+   struct symtyps *symtyps; /* for operation in data base: types of arg syms */
+   nodeptr lifetime;        /* lifetime of intermediate result */
+   int reuse;               /* result may be reused without being recomputed */
+   nodeptr intrnl_lftm;     /* lifetime of variables internal to operation */
+   int postn;               /* relative position of node in execution order */
+   struct freetmp *freetmp; /* temporary variables to free at this point */
+   union field n_field[1];  /* node fields */
+   };
+
+/*
+ * NewNode - allocate a parse tree node with "size" fields.
+ */
+#define NewNode(size) (struct node *)alloc((unsigned int)\
+    (sizeof(struct node) + (size-1) * sizeof(union field)))
+
+/*
+ * Macros to access fields of parse tree nodes.
+ */
+
+#define Type(t)		t->n_type
+#define File(t)		t->n_file
+#define Line(t)		t->n_line
+#define Col(t)		t->n_col
+#define Tree0(t)	t->n_field[0].n_ptr
+#define Tree1(t)	t->n_field[1].n_ptr
+#define Tree2(t)	t->n_field[2].n_ptr
+#define Tree3(t)	t->n_field[3].n_ptr
+#define Tree4(t)	t->n_field[4].n_ptr
+#define Val0(t)		t->n_field[0].n_val
+#define Val1(t)		t->n_field[1].n_val
+#define Val2(t)		t->n_field[2].n_val
+#define Val3(t)		t->n_field[3].n_val
+#define Val4(t)		t->n_field[4].n_val
+#define Str0(t)		t->n_field[0].n_str
+#define Str1(t)		t->n_field[1].n_str
+#define Str2(t)		t->n_field[2].n_str
+#define Str3(t)		t->n_field[3].n_str
+#define LSym0(t)	t->n_field[0].lsym
+#define CSym0(t)	t->n_field[0].csym
+#define Impl0(t)	t->n_field[0].ip
+#define Impl1(t)	t->n_field[1].ip
+#define Rec1(t)		t->n_field[1].rec
+#define Proc1(t)	t->n_field[1].proc
+#define Typ4(t)		t->n_field[4].typ
+
+/*
+ * External declarations.
+ */
+
+extern nodeptr yylval;		/* parser's current token value */
+extern struct node tok_loc;     /* "model" token holding current location */
+
+/*
+ * Node types.
+ */
+
+#define N_Activat	 1		/* activation control structure */
+#define N_Alt		 2		/* alternation operator */
+#define N_Apply		 3		/* procedure application */
+#define N_Augop		 4		/* augmented operator */
+#define N_Bar		 5		/* generator control structure */
+#define N_Break		 6		/* break statement */
+#define N_Case		 7		/* case statement */
+#define N_Ccls		 8		/* case clause */
+#define N_Clist		 9		/* list of case clauses */
+#define N_Create	10		/* create control structure */
+#define N_Cset		11		/* cset literal */
+#define N_Elist		12		/* list of expressions */
+#define N_Empty		13		/* empty expression or statement */
+#define N_Field		14		/* record field reference */
+#define N_Id		15		/* identifier token */
+#define N_If		16		/* if-then-else statement */
+#define N_Int		17		/* integer literal */
+#define N_Invok		18		/* invocation */
+#define N_InvOp		19		/* invoke operation */
+#define N_InvProc	20		/* invoke operation */
+#define N_InvRec	21		/* invoke operation */
+#define N_Limit		22		/* LIMIT control structure */
+#define N_Loop		23		/* while, until, every, or repeat */
+#define N_Next		24		/* next statement */
+#define N_Not		25		/* not prefix control structure */
+#define N_Op		26		/* operator token */
+#define N_Proc		27		/* procedure */
+#define N_Real		28		/* real literal */
+#define N_Res		29		/* reserved word token */
+#define N_Ret		30		/* fail, return, or succeed */
+#define N_Scan		31		/* scan-using statement */
+#define N_Sect		32		/* s[i:j] (section) */
+#define N_Slist		33		/* list of statements */
+#define N_Str		34		/* string literal */
+#define N_SmplAsgn	35		/* simple assignment to named var */ 
+#define N_SmplAug	36		/* simple assignment to named var */ 
+
+#define AsgnDirect 0  /* rhs of special := can compute directly into var */
+#define AsgnCopy   1  /* special := must copy result into var */
+#define AsgnDeref  2  /* special := must dereference result into var */
+
+
+/*
+ * Macros for constructing basic nodes.
+ */
+
+#define CsetNode(a,b)		i_str_leaf(N_Cset,&tok_loc,a,b) 
+#define IdNode(a)		c_str_leaf(N_Id,&tok_loc,a) 
+#define IntNode(a)		c_str_leaf(N_Int,&tok_loc,a) 
+#define OpNode(a)		int_leaf(N_Op,&tok_loc,a) 
+#define RealNode(a)		c_str_leaf(N_Real,&tok_loc,a) 
+#define ResNode(a)		int_leaf(N_Res,&tok_loc,a) 
+#define StrNode(a,b)		i_str_leaf(N_Str,&tok_loc,a,b) 
+
+/*
+ * MultiUnary - create subtree from an operator symbol that represents
+ *  multiple unary operators.
+ */
+#define MultiUnary(a,b) multiunary(optab[Val0(a)].tok.t_word, a, b)
diff --git a/src/iconc/dbase.c b/src/iconc/dbase.c
new file mode 100644
index 0000000..fdd3e50
--- /dev/null
+++ b/src/iconc/dbase.c
@@ -0,0 +1,196 @@
+/*
+ * dbase.c - routines to access data base of implementation information
+ *  produced by rtt.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+/*
+ * Prototypes.
+ */
+static int chck_spec (struct implement *ip);
+static int acpt_op   (struct implement *ip);
+
+
+static struct optab *optr; /* pointer into operator table */
+
+/*
+ * readdb - read data base produced by rtt.
+ */
+void readdb(db_name)
+char *db_name;
+   {
+   char *op, *s;
+   int i;
+   struct implement *ip;
+   char buf[MaxPath];			/* file name construction buffer */
+   struct fileparts *fp;
+   unsigned hashval;
+
+   fp = fparse(db_name);
+   if (*fp->ext == '\0')
+      db_name = salloc(makename(buf, NULL, db_name, DBSuffix));
+   else if (!smatch(fp->ext, DBSuffix))
+      quitf("bad data base name: %s", db_name);
+
+   if (!db_open(db_name, &s))
+        db_err1(1, "cannot open data base");
+
+   if (largeints && (*s == 'N')) {
+       twarn("Warning, run-time system does not support large integers", NULL);
+       largeints = 0;
+       }
+
+   /*
+    * Read information about functions.
+    */
+   db_tbl("functions", bhash);
+
+   /*
+    * Read information about operators.
+    */
+   optr = optab;
+
+   /*
+    * read past operators header.
+    */
+   db_chstr("operators", "operators");
+
+   while ((op = db_string()) != NULL) {
+      if ((ip = db_impl('O')) == NULL)
+         db_err2(1, "no implementation information for operator", op);
+      ip->op = op;
+      if (acpt_op(ip)) {
+         db_code(ip);
+         hashval = IHasher(op);
+         ip->blink = ohash[hashval];
+         ohash[hashval] = ip;
+         db_chstr("end", "end");
+         }
+      else
+         db_dscrd(ip);
+      }
+   db_chstr("endsect", "endsect");
+
+   /*
+    * Read information about keywords.
+    */
+   db_tbl("keywords", khash);
+
+   db_close();
+
+   /*
+    * If error conversion is supported, make sure it is reflected in
+    *   the minimum result sequence of operations.
+    */
+   if (err_conv) {
+      for (i = 0; i < IHSize; ++i)
+         for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      for (i = 0; i < IHSize; ++i)
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      for (i = 0; i < IHSize; ++i)
+         for (ip = khash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      }
+   }
+
+/*
+ * acpt_opt - given a data base entry for an operator determine if it
+ *  is in iconc's operator table.
+ */
+static int acpt_op(ip)
+struct implement *ip;
+   {
+   register char *op;
+   register int opcmp;
+
+   /*
+    * Calls to this function are in lexical order by operator symbol continue
+    *  searching operator table  from where we left off.
+    */
+   op = ip->op;
+   for (;;) {
+      /*
+       * optab has augmented assignments out of lexical order. Skip anything
+       *  which does not expect an implementation. This gets augmented
+       *  assignments out of the way.
+       */
+      while (optr->expected == 0 && optr->tok.t_word != NULL)
+         ++optr;
+      if (optr->tok.t_word == NULL)
+         return chck_spec(ip);
+      opcmp = strcmp(op, optr->tok.t_word);
+      if (opcmp > 0)
+         ++optr;
+      else if (opcmp < 0)
+         return chck_spec(ip);
+      else {
+         if (ip->nargs == 1 && (optr->expected & Unary)) {
+            if (optr->unary == NULL) {
+               optr->unary = ip;
+               return 1;
+               }
+            else
+               return 0;
+            }
+         else if (ip->nargs == 2 && (optr->expected & Binary)) {
+            if (optr->binary == NULL) {
+               optr->binary = ip;
+               return 1;
+               }
+            else
+               return 0;
+            }
+         else
+            return chck_spec(ip);
+         }
+      }
+   }
+
+/*
+ * chck_spec - check whether the operator is one that does not use standard
+ *    unary or binary syntax.
+ */
+static int chck_spec(ip)
+struct implement *ip;
+   {
+   register char *op;
+   int indx;
+
+   indx = -1;
+   op = ip->op;
+   if (strcmp(op, "...") == 0) {
+      if (ip->nargs == 2)
+         indx = ToOp;
+      else
+         indx = ToByOp;
+      }
+   else if (strcmp(op, "[:]") == 0)
+      indx = SectOp;
+   else if (strcmp(op, "[]") == 0)
+      indx = SubscOp;
+   else if (strcmp(op, "[...]") == 0)
+      indx = ListOp;
+
+   if (indx == -1) {
+      db_err2(0, "unexpected operator (or arity),", op);
+      return 0;
+      }
+   if (spec_op[indx] == NULL) {
+      spec_op[indx] = ip;
+      return 1;
+      }
+   else
+      return 0;
+   }
diff --git a/src/iconc/fixcode.c b/src/iconc/fixcode.c
new file mode 100644
index 0000000..b8c06e0
--- /dev/null
+++ b/src/iconc/fixcode.c
@@ -0,0 +1,372 @@
+/*
+ * fixcode.c - routines to "fix code" by determining what signals are returned
+ *   by continuations and what must be done when they are.  Also perform
+ *   optional control flow optimizations.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "ctree.h"
+#include "csym.h"
+#include "cproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static struct code    *ck_unneed (struct code *cd, struct code *lbl);
+static void         clps_brch (struct code *branch);
+static void         dec_refs  (struct code *cd);
+static void         rm_unrch  (struct code *cd);
+
+/*
+ * fix_fncs - go through the generated C functions, determine how calls
+ *  handle signals, in-line trivial functions where possible, remove
+ *  goto's which immediately precede their labels, and remove unreachable
+ *  code.
+ */
+void fix_fncs(fnc)
+struct c_fnc *fnc;
+   {
+   struct code *cd, *cd1;
+   struct code *contbody;
+   struct sig_act *sa;
+   struct sig_lst *sl;
+   struct code *call;
+   struct code *create;
+   struct code *ret_sig;
+   struct code *sig;
+   struct c_fnc *calledcont;
+   int no_break;
+   int collapse;
+
+   /*
+    * Fix any called functions and decide how the calls handle the
+    *  returned signals.
+    */
+   fnc->flag |= CF_Mark;
+   for (call = fnc->call_lst; call != NULL; call = call->NextCall) {
+      calledcont = call->Cont;
+      if (calledcont != NULL) {
+         if  (!(calledcont->flag & CF_Mark))
+            fix_fncs(calledcont);
+         if (calledcont->flag & CF_ForeignSig) {
+            call->Flags |= ForeignSig;
+            fnc->flag |= CF_ForeignSig;
+            }
+         }
+
+
+      /*
+       * Try to collapse call chains of continuations.
+       */
+      if (opt_cntrl && calledcont != NULL) {
+         contbody = calledcont->cd.next;
+         if (call->OperName == NULL && contbody->cd_id == C_RetSig) {
+           /*
+            * A direct call of a continuation which consists of just a
+            *  return. Replace call with code to handle the returned signal.
+            */
+           ret_sig = contbody->SigRef->sig;
+           if (ret_sig == &resume)
+               cd1 = sig_cd(call->ContFail, fnc);
+            else
+               cd1 = sig_cd(ret_sig, fnc);
+            cd1->prev = call->prev;
+            cd1->prev->next = cd1;
+            cd1->next = call->next;
+            if (cd1->next != NULL)
+               cd1->next->prev = cd1;
+            --calledcont->ref_cnt;
+            continue;	/* move on to next call */
+            }
+         else if (contbody->cd_id == C_CallSig && contbody->next == NULL) {
+            /*
+             * The called continuation contains only a call.
+             */
+            if (call->OperName == NULL) {
+               /*
+                * We call the continuation directly, so we can in-line it.
+                *  We must replace signal returns with appropriate actions.
+                */
+               if (--calledcont->ref_cnt != 0 && contbody->Cont != NULL)
+                  ++contbody->Cont->ref_cnt;
+               call->OperName = contbody->OperName;
+               call->ArgLst = contbody->ArgLst;
+               call->Cont = contbody->Cont;
+               call->Flags = contbody->Flags;
+               for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                  ret_sig = sa->cd->SigRef->sig;
+                  if (ret_sig == &resume)
+                     cd1 = sig_cd(call->ContFail, fnc);
+                  else
+                     cd1 = sig_cd(ret_sig, fnc);
+                  call->SigActs = new_sgact(sa->sig, cd1, call->SigActs);
+                  }
+               continue;	/* move on to next call */
+               }
+            else if (contbody->OperName == NULL) {
+               /*
+                * The continuation simply calls another continuation. We can
+                *  eliminate the intermediate continuation as long as we can
+                *  move signal conversions to the other side of the operation.
+                *  The operation only intercepts resume signals.
+                */
+               collapse = 1;
+               for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                  ret_sig = sa->cd->SigRef->sig;
+                  if (sa->sig != ret_sig && (sa->sig == &resume ||
+                      ret_sig == &resume))
+                     collapse = 0;
+                  }
+               if (collapse) {
+                  if (--calledcont->ref_cnt != 0 && contbody->Cont != NULL)
+                     ++contbody->Cont->ref_cnt;
+                  call->Cont = contbody->Cont;
+                  for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                     ret_sig = sa->cd->SigRef->sig;
+                     if (ret_sig != &resume)
+                        call->SigActs = new_sgact(sa->sig, sig_cd(ret_sig, fnc),
+                           call->SigActs);
+                     }
+                  continue;	/* move on to next call */
+                  }
+               }
+            }
+         }
+
+      /*
+       * We didn't do any optimizations. We must still figure out
+       *  out how to handle signals returned by the continuation.
+       */
+      if (calledcont != NULL) {
+         for (sl = calledcont->sig_lst; sl != NULL; sl = sl->next) {
+            if (sl->ref_cnt > 0) {
+               sig = sl->sig;
+               /*
+                * If an operation is being called, it handles failure from the
+                *  continuation.
+                */
+               if (sig != &resume || call->OperName == NULL) {
+                  if (sig == &resume)
+                     cd1 = sig_cd(call->ContFail, fnc);
+                  else
+                     cd1 = sig_cd(sig, fnc);
+                  call->SigActs = new_sgact(sig, cd1, call->SigActs);
+                  }
+               }
+            }
+         }
+      }
+
+   /*
+    * fix up the signal handling in the functions implementing co-expressions.
+    */
+   for (create = fnc->creatlst; create != NULL; create = create->NextCreat)
+      fix_fncs(create->Cont);
+
+   if (!opt_cntrl)
+      return;  /* control flow optimizations disabled. */
+   /*
+    * Collapse branch chains and remove unreachable code.
+    */
+   for (cd = &(fnc->cd); cd != NULL; cd = cd->next) {
+      switch (cd->cd_id) {
+         case C_CallSig:
+            no_break = 1;
+            for (sa = cd->SigActs; sa != NULL; sa = sa->next) {
+               if (sa->cd->cd_id == C_Break) {
+                  switch (cd->next->cd_id) {
+                     case C_Goto:
+                        sa->cd->cd_id = cd->next->cd_id;
+                        sa->cd->Lbl = cd->next->Lbl;
+                        ++sa->cd->Lbl->RefCnt;
+                        break;
+                     case C_RetSig:
+                        sa->cd->cd_id = cd->next->cd_id;
+                        sa->cd->SigRef= cd->next->SigRef;
+                        ++sa->cd->SigRef->ref_cnt;
+                        break;
+                     default: 
+                        no_break = 0;
+                     }
+                  }
+               if (sa->cd->cd_id == C_Goto)
+                  clps_brch(sa->cd);
+               }
+            if (no_break)
+               rm_unrch(cd);
+            /*
+             * Try converting gotos into breaks.
+             */
+            for (sa = cd->SigActs; sa != NULL; sa = sa->next)
+               if (sa->cd->cd_id == C_Goto) {
+                  cd1 = cd->next;
+                  while (cd1 != NULL && (cd1->cd_id == C_Label ||
+                     cd1->cd_id == C_RBrack)) {
+                        if (cd1 == sa->cd->Lbl) {
+                           sa->cd->cd_id = C_Break;
+                           --cd1->RefCnt;
+                           break;
+                           }
+                        cd1 = cd1->next;
+                        }
+                  }
+            break;
+
+         case C_Goto:
+            clps_brch(cd);
+            rm_unrch(cd);
+            if (cd->cd_id == C_Goto)
+               ck_unneed(cd, cd->Lbl);
+            break;
+
+         case C_If:
+            if (cd->ThenStmt->cd_id == C_Goto) {
+               clps_brch(cd->ThenStmt);
+               if (cd->ThenStmt->cd_id == C_Goto)
+                  ck_unneed(cd, cd->ThenStmt->Lbl);
+               }
+            break;
+
+         case C_PFail:
+         case C_PRet:
+         case C_RetSig:
+            rm_unrch(cd);
+            break;
+         }
+      }
+
+   /*
+    * If this function only contains a return, indicate that we can
+    *  call a shared signal returning function instead of it. This is
+    *  a special case of "common subROUTINE elimination".
+    */
+   if (fnc->cd.next->cd_id == C_RetSig)
+      fnc->flag |= CF_SigOnly;
+   }
+
+/*
+ * clps_brch - collapse branch chains.
+ */
+static void clps_brch(branch)
+struct code *branch;
+   {
+   struct code *cd;
+   int save_id;
+
+   cd = branch->Lbl->next;
+   while (cd->cd_id == C_Label)
+      cd = cd->next;
+
+   /*
+    * Avoid infinite recursion on empty infinite loops.
+    */
+   save_id = branch->cd_id;
+   branch->cd_id = 0;
+   if (cd->cd_id == C_Goto)
+      clps_brch(cd);
+   branch->cd_id = save_id;
+
+   switch (cd->cd_id) {
+      case C_Goto:
+         --branch->Lbl->RefCnt;
+         ++cd->Lbl->RefCnt;
+         branch->Lbl = cd->Lbl;
+         break;
+      case C_RetSig:
+         /*
+          * This optimization requires that C_Goto have as many fields
+          *  as C_RetSig.
+          */
+         --branch->Lbl->RefCnt;
+         ++cd->SigRef->ref_cnt;
+         branch->cd_id = C_RetSig;
+         branch->SigRef = cd->SigRef;
+         break;
+      }
+   }
+
+/*
+ * rm_unrch - any code after the given point up to the next label is
+ *   unreachable. Remove it.
+ */
+static void rm_unrch(cd)
+struct code *cd;
+   {
+   struct code *cd1;
+
+   for (cd1 = cd->next; cd1 != NULL && cd1->cd_id != C_LBrack &&
+      (cd1->cd_id != C_Label || cd1->RefCnt == 0); cd1 = cd1->next) {
+         if (cd1->cd_id == C_RBrack) {
+            /*
+             * Continue deleting past a '}', but don't delete the '}' itself.
+             */
+            cd->next = cd1;
+            cd1->prev = cd;
+            cd = cd1;
+            }
+         else
+            dec_refs(cd1);
+         }
+   cd->next = cd1;
+   if (cd1 != NULL)
+      cd1->prev = cd;
+   }
+
+/*
+ * dec_refs - decrement reference counts for things this code references.
+ */
+static void dec_refs(cd)
+struct code *cd;
+   {
+   struct sig_act *sa;
+
+   if (cd == NULL)
+      return;
+   switch (cd->cd_id) {
+      case C_Goto:
+         --cd->Lbl->RefCnt;
+         return;
+      case C_RetSig:
+         --cd->SigRef->ref_cnt;
+         return;
+      case C_CallSig:
+         if (cd->Cont != NULL)
+            --cd->Cont->ref_cnt;
+         for (sa = cd->SigActs; sa != NULL; sa = sa->next)
+            dec_refs(sa->cd);
+         return;
+     case C_If:
+         dec_refs(cd->ThenStmt);
+         return;
+     case C_Create:
+        --cd->Cont->ref_cnt;
+         return;
+        }
+   }
+
+/*
+ * ck_unneed - if there is nothing between a goto and its label, except
+ *   perhaps other labels or '}', it is useless, so remove it.
+ */
+static struct code *ck_unneed(cd, lbl)
+struct code *cd;
+struct code *lbl;
+   {
+   struct code *cd1;
+
+   cd1 = cd->next;
+   while (cd1 != NULL && (cd1->cd_id == C_Label || cd1->cd_id == C_RBrack)) {
+      if (cd1 == lbl) {
+         cd = cd->prev;
+         cd->next = cd->next->next;
+         cd->next->prev = cd;
+         --lbl->RefCnt;
+         break;
+         }
+      cd1 = cd1->next;
+      }
+   return cd;
+   }
+
diff --git a/src/iconc/incheck.c b/src/iconc/incheck.c
new file mode 100644
index 0000000..d4110f9
--- /dev/null
+++ b/src/iconc/incheck.c
@@ -0,0 +1,802 @@
+/*
+ * incheck.c - analyze a run-time operation using type information.
+ *   Determine wither the operation can be in-lined and what kinds
+ *   of parameter passing optimizations can be done.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+
+struct op_symentry *cur_symtab; /* symbol table for current operation */
+
+/*
+ * Prototypes for static functions.
+ */
+static struct code *and_cond (struct code *cd1, struct code *cd2);
+static int          cnv_anlz (unsigned int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest,
+                               struct code **cdp);
+static int          defer_il (struct il_code *il);
+static int          if_anlz  (struct il_code *il);
+static void      ilc_anlz (struct il_c *ilc);
+static int          il_anlz  (struct il_code *il);
+static void      ret_anlz (struct il_c *ilc);
+static int          tc_anlz  (struct il_code *il, int has_dflt);
+
+static int n_branches;  /* number branches caused by run-time type checking */
+static int side_effect; /* abstract clause indicates side-effect */
+static int n_vararg;    /* size of variable part of arg list to operation */
+static int n_susp;      /* number of suspends */
+static int n_ret;       /* number of returns */
+
+/*
+ * do_inlin - determine if this operation can be in-lined at the current
+ *  invocation. Also gather information about how arguments are used,
+ *  and determine where the success continuation for the operation
+ *  should be put.
+ */
+int do_inlin(impl, n, cont_loc, symtab, n_va) 
+struct implement *impl;
+nodeptr n;
+int *cont_loc;
+struct op_symentry *symtab;
+int n_va;
+   {
+   int nsyms;
+   int i;
+
+   /*
+    * Copy arguments needed by other functions into globals and
+    *  initialize flags and counters for information to be gathered
+    *  during analysis.
+    */
+   cur_symtyps = n->symtyps; /* mapping from arguments to types */
+   cur_symtab = symtab;      /* parameter info to be filled in */
+   n_vararg = n_va;
+   n_branches = 0;
+   side_effect = 0;
+   n_susp = 0;
+   n_ret = 0;
+
+   /*
+    * Analyze the code for this operation using type information for
+    *  the arguments to the invocation.
+    */
+   il_anlz(impl->in_line);
+
+
+   /*
+    * Don't in-line if there is more than one decision made based on
+    *  run-time type checks (this is a heuristic).
+    */
+   if (n_branches > 1)
+      return 0;
+
+   /*
+    * If the operation (after eliminating code not used in this context)
+    *  has one suspend and no returns, the "success continuation" can
+    *  be placed in-line at the suspend site. Otherwise, any suspends
+    *  require a separate function for the continuation.
+    */
+   if (n_susp == 1 && n_ret == 0)
+     *cont_loc = SContIL;    /* in-line continuation */
+   else if (n_susp > 0)
+     *cont_loc = SepFnc;     /* separate function for continuation */
+   else
+     *cont_loc = EndOper;    /* place "continuation" after the operation */
+
+   /*
+    * When an argument at the source level is an Icon variable, it is
+    *  sometimes safe to use it directly in the generated code as the
+    *  argument to the operation. However, it is NOT safe under the
+    *  following conditions:
+    *
+    *    - if the operation modifies the argument.
+    *    - if the operation suspends and resumes so that intervening
+    *      changes to the variable would be visible as changes to the
+    *      argument.
+    *    - if the operation has side effects that might involve the
+    *      variable and be visible as changes to the argument.
+    */
+   nsyms = (cur_symtyps == NULL ? 0 : cur_symtyps->nsyms);
+   for (i = 0; i < nsyms; ++i)
+      if (symtab[i].n_mods == 0 && n->intrnl_lftm == n && !side_effect)
+        symtab[i].var_safe = 1;
+
+   return 1;
+   }
+
+/*
+ * il_anlz - analyze a piece of RTL code. Return an indication of
+ *  whether execution can continue beyond it.
+ */
+static int il_anlz(il)
+struct il_code *il;
+   {
+   int fall_thru;
+   int ncases;
+   int condition;
+   int indx;
+   int i, j;
+
+   if (il == NULL)
+       return 1;
+
+   switch (il->il_type) {
+      case IL_Const: /* should have been replaced by literal node */
+         return 1;
+
+      case IL_If1:
+         /*
+          * if-then statement. Determine whether the condition may
+          *  succeed or fail. Analyze the then clause if needed.
+          */
+         condition = if_anlz(il->u[0].fld);
+         fall_thru = 0;
+         if (condition & MaybeTrue)
+            fall_thru |= il_anlz(il->u[1].fld);
+         if (condition & MaybeFalse)
+            fall_thru = 1;
+         return fall_thru;
+
+      case IL_If2:
+         /*
+          * if-then-else statement. Determine whether the condition may
+          *  succeed or fail. Analyze the "then" clause and the "else"
+          *  clause if needed.
+          */
+         condition = if_anlz(il->u[0].fld);
+         fall_thru = 0;
+         if (condition & MaybeTrue)
+            fall_thru |= il_anlz(il->u[1].fld);
+         if (condition & MaybeFalse)
+            fall_thru |= il_anlz(il->u[2].fld);
+         return fall_thru;
+
+      case IL_Tcase1:
+         /*
+          * type_case statement with no default clause.
+          */
+         return tc_anlz(il, 0);
+
+      case IL_Tcase2:
+         /*
+          * type_case statement with a default clause.
+          */
+         return tc_anlz(il, 1);
+
+      case IL_Lcase:
+         /*
+          * len_case statement. Determine which case matches the number
+          *  of arguments.
+          */
+         ncases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < ncases; ++i) {
+            if (il->u[indx++].n == n_vararg)     /* selection number */
+               return il_anlz(il->u[indx].fld);  /* action */
+            ++indx;
+            }
+         return il_anlz(il->u[indx].fld);        /* default */
+
+      case IL_Acase: {
+         /*
+          * arith_case statement.
+          */
+         struct il_code *var1;
+         struct il_code *var2;
+         int maybe_int;
+         int maybe_dbl;
+         int chk1;
+         int chk2;
+
+         var1 = il->u[0].fld;
+         var2 = il->u[1].fld;
+         arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, NULL,
+           &chk2, NULL);
+
+         /*
+          * Analyze the selected case (note, large integer code is not
+          *  currently in-lined and can be ignored).
+          */
+         fall_thru = 0;
+         if (maybe_int)
+            fall_thru |= il_anlz(il->u[2].fld);     /* C_integer action */
+         if (maybe_dbl)
+            fall_thru |= il_anlz(il->u[4].fld);     /* C_double action */
+         return fall_thru;
+         }
+
+      case IL_Err1:
+         /*
+          * runerr() with no offending value.
+          */
+         return 0;
+
+      case IL_Err2:
+         /*
+          * runerr() with an offending value. Note the reference to
+          *  the offending value descriptor.
+          */
+         indx = il->u[1].fld->u[0].n;    /* symbol table index of variable */
+         if (indx < cur_symtyps->nsyms)
+            ++cur_symtab[indx].n_refs;
+         return 0;
+
+      case IL_Block:
+         /*
+          * inline {...} statement.
+          */
+         i = il->u[1].n + 2;              /* skip declaration stuff */
+         ilc_anlz(il->u[i].c_cd);         /* body of block */
+         return il->u[0].n;
+
+      case IL_Call:
+         /*
+          * call to body function.
+          */
+         if (il->u[3].n & DoesSusp)
+            n_susp = 2;  /* force continuation into separate function */
+
+         /*
+          * Analyze the C code for prototype parameter declarations
+          *  and actual arguments. There are twice as many pieces of
+          *  C code to look at as there are parameters.
+          */
+         j = 2 * il->u[7].n;
+         i = 8;              /* index of first piece of C code */
+         while (j--)
+            ilc_anlz(il->u[i++].c_cd);
+         return ((il->u[3].n & DoesFThru) != 0);
+
+      case IL_Lst:
+         /*
+          * Two consecutive pieces of RTL code.
+          */
+         fall_thru = il_anlz(il->u[0].fld);
+         if (fall_thru)
+            fall_thru = il_anlz(il->u[1].fld);
+         return fall_thru;
+
+      case IL_Abstr:
+         /*
+          * abstract type computation. See if it indicates side effects.
+          */
+         if (il->u[0].fld != NULL)
+             side_effect = 1;
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * if_anlz - analyze the condition of an if statement.
+ */
+static int if_anlz(il)
+struct il_code *il;
+   {
+   int cond;
+   int cond1;
+
+   if (il->il_type == IL_Bang) {
+      /*
+       * ! <condition>, negate the result of the condition
+       */
+      cond1 = cond_anlz(il->u[0].fld, NULL);
+      cond = 0;
+      if (cond1 & MaybeTrue)
+         cond = MaybeFalse;
+      if (cond1 & MaybeFalse)
+         cond |= MaybeTrue;
+      }
+   else
+      cond = cond_anlz(il, NULL);
+   if (cond == (MaybeTrue | MaybeFalse))
+      ++n_branches;  /* must make a run-time decision */
+   return cond;
+   }
+
+/*
+ * cond_anlz - analyze a simple condition or the conjunction of two
+ *   conditions. If cdp is not NULL, use it to return a pointer code
+ *   that implements the condition.
+ */
+int cond_anlz(il, cdp)
+struct il_code *il;
+struct code **cdp;
+   {
+   struct code *cd1;
+   struct code *cd2;
+   int cond1;
+   int cond2;
+   int indx;
+
+   switch (il->il_type) {
+      case IL_And:
+         /*
+          * <cond> && <cond>
+          */
+         cond1 = cond_anlz(il->u[0].fld, (cdp == NULL ? NULL : &cd1));
+         if (cond1 & MaybeTrue) {
+            cond2 = cond_anlz(il->u[1].fld, (cdp == NULL ? NULL : &cd2));
+            if (cdp != NULL) {
+               if (!(cond2 & MaybeTrue))
+                  *cdp = NULL;
+               else
+                  *cdp = and_cond(cd1, cd2);
+               }
+            return (cond1 & MaybeFalse) | cond2;
+            }
+         else {
+            if (cdp != NULL)
+               *cdp = cd1;
+            return cond1;
+            }
+
+      case IL_Cnv1:
+         /*
+          * cnv:<dest-type>(<source>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, NULL, NULL, cdp);
+
+      case IL_Cnv2:
+         /*
+          * cnv:<dest-type>(<source>,<destination>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, NULL, il->u[2].c_cd, cdp);
+
+      case IL_Def1:
+         /*
+          * def:<dest-type>(<source>,<default-value>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, il->u[2].c_cd, NULL, cdp);
+
+      case IL_Def2:
+         /*
+          * def:<dest-type>(<source>,<default-value>,<destination>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, il->u[2].c_cd, il->u[3].c_cd,
+            cdp);
+
+      case IL_Is:
+         /*
+          * is:<type-name>(<variable>)
+          */
+         indx = il->u[1].fld->u[0].n;
+         cond1 = eval_is(il->u[0].n, indx);
+         if (cdp == NULL) {
+            if (indx < cur_symtyps->nsyms && cond1 == (MaybeTrue | MaybeFalse))
+               ++cur_symtab[indx].n_refs;
+            }
+         else {
+            if (cond1 == (MaybeTrue | MaybeFalse))
+               *cdp = typ_chk(il->u[1].fld, il->u[0].n);
+            else
+               *cdp = NULL;
+            }
+         return cond1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+
+/*
+ * and_cond - construct && of two conditions, either of which may have
+ *  been optimized away.
+ */
+static struct code *and_cond(cd1, cd2)
+struct code *cd1;
+struct code *cd2;
+   {
+   struct code *cd;
+
+   if (cd1 == NULL)
+      return cd2;
+   else if (cd2 == NULL)
+      return cd1;
+   else {
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Ary;
+      cd->Array(0) =            cd1;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =              " && ";
+      cd->ElemTyp(2) = A_Ary;
+      cd->Array(2) =            cd2;
+      return cd;
+      }
+   }
+
+/*
+ * cnv_anlz - analyze a type conversion. Determine whether it can succeed
+ *  and, if requested, produce code to perform the conversion. Also
+ *  gather information about the variables it uses.
+ */
+static int cnv_anlz(typcd, src, dflt, dest, cdp)
+unsigned int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+struct code **cdp;
+   {
+   struct val_loc *src_loc;
+   int cond;
+   int cnv_flags;
+   int indx;
+
+   /*
+    * Find out what is going on in the default and destination subexpressions.
+    *  (The information is used elsewhere.)
+    */
+   ilc_anlz(dflt);
+   ilc_anlz(dest);
+
+   if (cdp != NULL)
+      *cdp = NULL;   /* clear code pointer in case it is not set below */
+
+   /*
+    * Determine whether the conversion may succeed, whether it may fail,
+    *  and whether it may actually convert a value or use the default
+    *  value when it succeeds.
+    */
+   indx = src->u[0].n;  /* symbol table index for source of conversion */
+   cond = eval_cnv(typcd, indx, dflt != NULL, &cnv_flags);
+
+   /*
+    * Many optimizations are possible depending on whether a conversion
+    *  is actually needed, whether type checking is needed, whether defaulting
+    *  is done, and whether there is an explicit destination. Several
+    *  optimizations are performed here; more may be added in the future.
+    */
+   if (!(cnv_flags & MayDefault))
+      dflt = NULL;  /* demote defaulting to simple conversion */
+
+   if (cond & MaybeTrue) {
+      if (cnv_flags == MayKeep && dest == NULL) {
+          /*
+           * No type conversion, defaulting, or copying is needed.
+           */
+         if (cond & MaybeFalse) {
+            /*
+             * A type check is needed.
+             */
+            ++cur_symtab[indx].n_refs; /* non-modifying reference to source. */
+            if (cdp != NULL) {
+               switch (typcd) {
+                  case TypECInt:
+                     *cdp = typ_chk(src, TypCInt);
+                     break;
+                  case TypEInt:
+                     *cdp = typ_chk(src, int_typ);
+                     break;
+                  case TypTStr:
+                     *cdp = typ_chk(src, str_typ);
+                     break;
+                  case TypTCset:
+                     *cdp = typ_chk(src, cset_typ);
+                     break;
+                  default:
+                     *cdp = typ_chk(src, typcd);
+                  }
+               }
+            }
+
+         if (cdp != NULL) {
+            /*
+             * Conversion from an integer to a C_integer can be done without
+             *  any executable code; this is not considered a real conversion.
+             *  It is accomplished by changing the symbol table so only the
+             *  dword of the descriptor is accessed.
+             */
+            switch (typcd) {
+               case TypCInt:
+               case TypECInt:
+                  cur_symtab[indx].loc = loc_cpy(cur_symtab[indx].loc, M_CInt);
+                  break;
+               }
+            }
+         }
+      else if (dest != NULL && cnv_flags == MayKeep && cond == MaybeTrue) {
+         /*
+          *  There is an explicit destination, but no conversion, defaulting,
+          *   or type checking is needed. Just copy the value to the
+          *   destination.
+          */
+         ++cur_symtab[indx].n_refs; /* non-modifying reference to source */
+         if (cdp != NULL)  {
+            src_loc = cur_symtab[indx].loc;
+            switch (typcd) {
+               case TypCInt:
+               case TypECInt:
+                  /*
+                   * The value is in the dword of the descriptor.
+                   */
+                  src_loc = loc_cpy(src_loc, M_CInt);
+                  break;
+               }
+            *cdp = il_copy(dest, src_loc);
+            }
+         }
+      else if (cnv_flags == MayDefault) {
+         /*
+          * The default value is used.
+          */
+         if (dest == NULL)
+            ++cur_symtab[indx].n_mods; /* modifying reference */
+         if (cdp != NULL) 
+            *cdp = il_dflt(typcd, src, dflt, dest);
+         }
+      else {
+         /*
+          * Produce code to do the actual conversion.
+          *  Determine whether the source location is being modified
+          *  or just referenced.
+          */
+         if (dest == NULL) {
+            /*
+             * "In place" conversion.
+             */
+            switch (typcd) {
+               case TypCDbl:
+               case TypCInt:
+               case TypECInt:
+                  /*
+                   * not really converted in-place.
+                   */
+                  ++cur_symtab[indx].n_refs; /* non-modifying reference */
+                  break;
+               default:
+                  ++cur_symtab[indx].n_mods; /* modifying reference */
+               }
+            }
+         else
+            ++cur_symtab[indx].n_refs; /* non-modifying reference */
+
+         if (cdp != NULL) 
+            *cdp = il_cnv(typcd, src, dflt, dest);
+         }
+      }
+   return cond;
+   }
+
+/*
+ * ilc_anlz - gather information about in-line C code.
+ */
+static void ilc_anlz(ilc)
+struct il_c *ilc;
+   {
+   while (ilc != NULL) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+            /* 
+             * Non-modifying reference to variable
+             */
+            if (ilc->n != RsltIndx) {
+               ++cur_symtab[ilc->n].n_refs;
+               }
+            break;
+
+         case ILC_Mod:
+            /* 
+             * Modifying reference to variable
+             */
+            if (ilc->n != RsltIndx) {
+               ++cur_symtab[ilc->n].n_mods;
+               }
+            break;
+
+         case ILC_Ret:
+            /*
+             * Return statement.
+             */
+            ++n_ret;
+            ret_anlz(ilc);
+            break;
+
+         case ILC_Susp:
+            /*
+             * Suspend statement.
+             */
+            ++n_susp;
+            ret_anlz(ilc);
+            break;
+
+         case ILC_CGto:
+            /*
+             * Conditional goto.
+             */
+            ilc_anlz(ilc->code[0]);
+            break;
+         }
+      ilc = ilc->next;
+      }
+   }
+
+/*
+ * ret_anlz - gather information about the in-line C code associated
+ *   with a return or suspend.
+ */
+static void ret_anlz(ilc)
+struct il_c *ilc;
+   {
+   int i;
+   int j;
+
+   /*
+    * See if the code is simply returning a parameter.
+    */
+   if (ilc->n == RetDesc && ilc->code[0]->il_c_type == ILC_Ref &&
+      ilc->code[0]->next == NULL) {
+         j = ilc->code[0]->n;
+         ++cur_symtab[j].n_refs;
+         ++cur_symtab[j].n_rets;
+         }
+   else {
+      for (i = 0; i < 3 && ilc->code[i] != NULL; ++i)
+         ilc_anlz(ilc->code[i]);
+      }
+   }
+
+/*
+ * deref_il - dummy routine to pass to a code walk.
+ */
+/*ARGSUSED*/
+static int defer_il(il)
+struct il_code *il;
+   {
+   /*
+    * Called for each case in a type_case statement that might be selected.
+    *  However, the actual analysis of the case, if it is needed,
+    *  is done elsewhere, so just return.
+    */
+   return 0;
+   }
+
+/*
+ * findcases - determine how many cases of an type_case statement may
+ *   be true. If there are two or less, determine the "if" statement
+ *   that can be used (if there are more than two, the code is not
+ *   in-lined).
+ */
+void findcases(il, has_dflt, case_anlz)
+struct il_code *il;
+int has_dflt;
+struct case_anlz *case_anlz;
+   {
+   int i;
+
+   case_anlz->n_cases = 0;
+   case_anlz->typcd = -1;
+   case_anlz->il_then = NULL;
+   case_anlz->il_else = NULL;
+   i = type_case(il, defer_il, case_anlz);
+   /*
+    * See if the explicit cases have accounted for all possible
+    *  types that might be present.
+    */
+   if (i == -1) {  /* all types accounted for */
+      if (case_anlz->il_else == NULL && case_anlz->il_then != NULL) {
+         /*   
+          * We don't need to actually check the type.
+          */
+         case_anlz->il_else = case_anlz->il_then;
+         case_anlz->il_then = NULL;
+         case_anlz->typcd = -1;
+         }
+      }
+    else {  /* not all types accounted for */
+      if (case_anlz->il_else != NULL)
+         case_anlz->n_cases = 3; /* force no inlining */
+      else if (has_dflt)
+         case_anlz->il_else = il->u[i].fld;         /* default */
+      }
+
+   if (case_anlz->n_cases > 2)
+      n_branches = 2;  /* no in-lining */
+   else if (case_anlz->il_then != NULL)
+      ++n_branches;
+   }
+
+
+/*
+ * tc_anlz - analyze a type_case statement. It is only of interest for
+ *   in-lining if it can be reduced to an "if" statement or an
+ *   unconditional statement.
+ */
+static int tc_anlz(il, has_dflt)
+struct il_code *il;
+int has_dflt;
+   {
+   struct case_anlz case_anlz;
+   int fall_thru;
+   int indx;
+
+   findcases(il, has_dflt, &case_anlz);
+
+   if (case_anlz.il_else == NULL)
+      fall_thru = 1;   /* either no code at all or condition with no "else" */
+   else
+      fall_thru = 0;   /* either unconditional or if-then-else: check code  */
+
+   if (case_anlz.il_then != NULL) {
+      fall_thru |= il_anlz(case_anlz.il_then);
+      indx = il->u[0].fld->u[0].n;    /* symbol table index of variable */
+      if (indx < cur_symtyps->nsyms)
+         ++cur_symtab[indx].n_refs;
+      }
+   if (case_anlz.il_else != NULL)
+      fall_thru |= il_anlz(case_anlz.il_else);
+   return fall_thru;
+   }
+
+/*
+ * arth_anlz - analyze the type checking of an arith_case statement.
+ */
+void arth_anlz(var1, var2, maybe_int, maybe_dbl, chk1, conv1p, chk2, conv2p)
+struct il_code *var1;
+struct il_code *var2;
+int *maybe_int;
+int *maybe_dbl;
+int *chk1;
+struct code **conv1p;
+int *chk2;
+struct code **conv2p;
+   {
+   int cond;
+   int cnv_typ;
+
+
+   /*
+    * First do an analysis to find out which cases are needed. This is
+    *  more accurate than analysing the conversions separately, but does
+    *  not get all the information we need.
+    */
+   eval_arith(var1->u[0].n, var2->u[0].n, maybe_int, maybe_dbl);
+
+   if (*maybe_int & (largeints | *maybe_dbl)) {
+      /*
+       * Too much type checking; don't bother with these cases. Force no
+       *   in-lining.
+       */
+      n_branches += 2;
+      }
+   else {
+      if (*maybe_int)
+         cnv_typ = TypCInt;
+      else
+         cnv_typ = TypCDbl;
+
+      /*
+       * See exactly what kinds of conversions/type checks are needed and,
+       *  if requested, generate code for them.
+       */
+      *chk1 = 0;
+      *chk2 = 0;
+
+      cond = cnv_anlz(cnv_typ, var1, NULL, NULL, conv1p);
+      if (cond & MaybeFalse) {
+         ++n_branches;          /* run-time decision */
+         *chk1 = 1;
+         if (var1->u[0].n < cur_symtyps->nsyms)
+            ++cur_symtab[var1->u[0].n].n_refs;  /* used in runerr2() */
+         }
+      cond = cnv_anlz(cnv_typ, var2, NULL, NULL, conv2p);
+      if (cond & MaybeFalse) {
+         ++n_branches;          /* run-time decision */
+         *chk2 = 1;
+         if (var2->u[0].n < cur_symtyps->nsyms)
+            ++cur_symtab[var2->u[0].n].n_refs;  /* used in runerr2() */
+         }
+      }
+   }
diff --git a/src/iconc/inline.c b/src/iconc/inline.c
new file mode 100644
index 0000000..234229c
--- /dev/null
+++ b/src/iconc/inline.c
@@ -0,0 +1,2007 @@
+/*
+ * inline.c - routines to put run-time routines in-line.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "ccode.h"
+#include "csym.h"
+#include "ctree.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static void          arth_arg  ( struct il_code *var,
+                                    struct val_loc *v_orig, int chk,
+                                    struct code *cnv);
+static int              body_fnc  (struct il_code *il);
+static void          chkforblk (void);
+static void          cnv_dest  (int loc, int is_cstr,
+                                    struct il_code *src, int sym_indx,
+                                    struct il_c *dest, struct code *cd, int i);
+static void          dwrd_asgn (struct val_loc *vloc, char *typ);
+static struct il_c     *line_ilc  (struct il_c *ilc);
+static int              gen_if    (struct code *cond_cd,
+                                    struct il_code *il_then,
+                                    struct il_code *il_else,
+                                    struct val_loc **locs);
+static int              gen_il    (struct il_code *il);
+static void          gen_ilc   (struct il_c *il);
+static void          gen_ilret (struct il_c *ilc);
+static int              gen_tcase (struct il_code *il, int has_dflt);
+static void          il_var    (struct il_code *il, struct code *cd,
+                                    int indx);
+static void          mrg_locs  (struct val_loc **locs);
+static struct code     *oper_lbl  (char *s);
+static void          part_asgn (struct val_loc *vloc, char *asgn,
+                                    struct il_c *value);
+static void          rstr_locs (struct val_loc **locs);
+static struct val_loc **sav_locs  (void);
+static void         sub_ilc    (struct il_c *ilc, struct code *cd, int indx);
+
+/*
+ * There are many parameters that are shared by multiple routines. There
+ *  are copied into statics.
+ */
+static struct val_loc *rslt;     /* result location */
+static struct code **scont_strt; /* label following operation code */
+static struct code **scont_fail; /* resumption label for in-line suspend */
+static struct c_fnc *cont;       /* success continuation */
+static struct implement *impl;   /* data base entry for operation */
+static int nsyms;                /* number symbols in operation symbol table */
+static int n_vararg;             /* size of variable part of arg list */
+static nodeptr intrnl_lftm;      /* lifetime of internal variables */
+static struct val_loc **tended;  /* array of tended locals */
+
+/*
+ * gen_inlin - generate in-line code for an operation.
+ */
+void gen_inlin(il, r, strt, fail, c, ip, ns, st, n, dcl_var, n_va)
+struct il_code *il;
+struct val_loc *r;
+struct code **strt;
+struct code **fail;
+struct c_fnc *c;
+struct implement *ip;
+int ns;
+struct op_symentry *st;
+nodeptr n;
+int dcl_var;
+int n_va;
+   {
+   struct code *cd;
+   struct val_loc *tnd;
+   int i;
+
+   /*
+    * Copy arguments in to globals.
+    */
+   rslt = r;
+   scont_strt = strt;
+   scont_fail = fail;
+   cont = c;
+   impl = ip;
+   nsyms = ns;
+   cur_symtab = st;
+   intrnl_lftm = n->intrnl_lftm;
+   cur_symtyps = n->symtyps;
+   n_vararg = n_va;
+
+   /*
+    * Generate code to initialize local tended descriptors and determine
+    *  how to access the descriptors.
+    */
+   for (i = 0; i < impl->ntnds; ++i) {
+      if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
+         tnd = chk_alc(NULL, n->intrnl_lftm);
+          switch (impl->tnds[i].var_type) {
+             case TndDesc:
+                cur_symtab[dcl_var].loc = tnd; 
+                break;
+             case TndStr:
+                cd = alc_ary(2);
+                cd->ElemTyp(0) = A_ValLoc;
+                cd->ValLoc(0) =                tnd;
+                cd->ElemTyp(1) = A_Str;
+                cd->Str(1) =                   " = emptystr;";
+                cd_add(cd);
+                cur_symtab[dcl_var].loc = loc_cpy(tnd, M_CharPtr);
+                break;
+             case TndBlk:
+                cd = alc_ary(2);
+                cd->ElemTyp(0) = A_ValLoc;
+                cd->ValLoc(0) =                tnd;
+                cd->ElemTyp(1) = A_Str;
+                cd->Str(1) =                   " = nullptr;"; 
+                cd_add(cd);
+                cur_symtab[dcl_var].loc = loc_cpy(tnd, M_BlkPtr);
+                cur_symtab[dcl_var].loc->blk_name = impl->tnds[i].blk_name;
+                break;
+             }
+         if (impl->tnds[i].init != NULL) {
+             cd = alc_ary(4);
+             cd->ElemTyp(0) = A_ValLoc;
+             cd->ValLoc(0) =                cur_symtab[dcl_var].loc;
+             cd->ElemTyp(1) = A_Str;
+             cd->Str(1) =                   " = "; 
+             sub_ilc(impl->tnds[i].init, cd, 2);
+             cd->ElemTyp(3) = A_Str;
+             cd->Str(3) =                   ";"; 
+             cd_add(cd);
+             }
+         }
+      ++dcl_var;
+      }
+
+   /*
+    * If there are local non-tended variables, generate code for the
+    *  declarations, placing everything in braces.
+     */
+   if (impl->nvars > 0) {
+      cd = NewCode(0);
+      cd->cd_id = C_LBrack;    /* { */
+      cd_add(cd);
+      for (i = 0;  i < impl->nvars; ++i) {
+         if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
+            gen_ilc(impl->vars[i].dcl);
+            cur_symtab[dcl_var].loc = cvar_loc(impl->vars[i].name);
+            }
+         ++dcl_var;
+         }
+      }
+
+   gen_il(il);  /* generate executable code */
+
+   if (impl->nvars > 0) {
+      cd = NewCode(0);
+      cd->cd_id = C_RBrack;    /* } */
+      cd_add(cd);
+      }
+   }
+
+/*
+ * gen_il - generate code from a sub-tree of in-line code from the data
+ *  base. Determine if execution can continue past this code.
+ *
+ */
+static int gen_il(il)
+struct il_code *il;
+   {
+   struct code *cd;
+   struct code *cd1;
+   struct il_code *il_cond;
+   struct il_code *il_then;
+   struct il_code *il_else;
+   struct il_code *il_t;
+   struct val_loc **locs;
+   struct val_loc **locs1;
+   struct val_loc *tnd;
+   int fall_thru;
+   int cond;
+   int ncases;
+   int indx;
+   int ntended;
+   int i;
+
+   if (il == NULL)
+      return 1;
+
+   switch (il->il_type) {
+      case IL_Const: /* should have been replaced by literal node */
+         return 1;
+
+      case IL_If1:
+      case IL_If2:
+         /*
+          * if-then or if-then-else statement.
+          */
+         il_then = il->u[1].fld;
+         if (il->il_type == IL_If2)
+            il_else = il->u[2].fld;
+         else
+            il_else = NULL;
+         il_cond = il->u[0].fld;
+         if (il->u[0].fld->il_type == IL_Bang) {
+            il_cond = il_cond->u[0].fld;
+            il_t = il_then;
+            il_then = il_else;
+            il_else = il_t;
+            }
+         locs = sav_locs();
+         cond = cond_anlz(il_cond, &cd1);
+         if (cond == (MaybeTrue | MaybeFalse))
+            fall_thru = gen_if(cd1, il_then, il_else, locs);
+         else {
+            if (cd1 != NULL) {
+               cd_add(cd1);  /* condition contains needed conversions */
+               cd = alc_ary(1);
+               cd->ElemTyp(0) = A_Str;
+               cd->Str(0) =              ";";
+               cd_add(cd);
+               }
+            if (cond == MaybeTrue)
+               fall_thru = gen_il(il_then);
+            else if (cond == MaybeFalse) {
+               locs1 = sav_locs();
+               rstr_locs(locs);
+               locs = locs1;
+               fall_thru = gen_il(il_else);
+               }
+            mrg_locs(locs);
+            }
+         return fall_thru;
+
+      case IL_Tcase1:
+         /*
+          * type_case statement with no default clause.
+          */
+         return gen_tcase(il, 0);
+
+      case IL_Tcase2:
+         /*
+          * type_case statement with a default clause.
+          */
+         return gen_tcase(il, 1);
+
+      case IL_Lcase:
+         /*
+          * len_case statement. Determine which case matches the number
+          *  of arguments.
+          */
+         ncases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < ncases; ++i) {
+            if (il->u[indx++].n == n_vararg)    /* selection number */
+               return gen_il(il->u[indx].fld);  /* action */
+            ++indx;
+            }
+         return gen_il(il->u[indx].fld);        /* default */
+
+      case IL_Acase: {
+         /*
+          * arith_case statement.
+          */
+         struct il_code *var1;
+         struct il_code *var2;
+         struct val_loc *v_orig1;
+         struct val_loc *v_orig2;
+         struct code *cnv1;
+         struct code *cnv2;
+         int maybe_int;
+         int maybe_dbl;
+         int chk1;
+         int chk2;
+
+         var1 = il->u[0].fld;
+         var2 = il->u[1].fld;
+         v_orig1 = cur_symtab[var1->u[0].n].loc;  /* remember for error msgs */
+         v_orig2 = cur_symtab[var2->u[0].n].loc;  /* remember for error msgs */
+         arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, &cnv1,
+           &chk2, &cnv2);
+
+         /*
+          * This statement is in-lined if there is only C integer
+          *  arithmetic, only C double arithmetic, or only a run-time
+          *  error.
+          */
+         arth_arg(var1, v_orig1, chk1, cnv1);
+         arth_arg(var2, v_orig2, chk2, cnv2);
+         if (maybe_int)
+            return gen_il(il->u[2].fld);     /* C_integer action */
+         else if (maybe_dbl)
+            return gen_il(il->u[4].fld);     /* C_double action */
+         else
+            return 0;
+         }
+
+      case IL_Err1:
+         /*
+          * runerr() with no offending value.
+          */
+         cd = alc_ary(3);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "err_msg(";
+         cd->ElemTyp(1) = A_Intgr;
+         cd->Intgr(1) =            il->u[0].n;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =              ", NULL);";
+         cd_add(cd);
+         if (err_conv)
+            cd_add(sig_cd(on_failure, cur_fnc));
+         for (i = 0; i < nsyms; ++i)
+            cur_symtab[i].loc = NULL;
+         return 0;
+
+      case IL_Err2:
+         /*
+          * runerr() with an offending value. Note the reference to
+          *  the offending value descriptor.
+          */
+         cd = alc_ary(5);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "err_msg(";
+         cd->ElemTyp(1) = A_Intgr;
+         cd->Intgr(1) =            il->u[0].n;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =              ", &(";
+         il_var(il->u[1].fld, cd, 3);
+         cd->ElemTyp(4) = A_Str;
+         cd->Str(4) =              "));";
+         cd_add(cd);
+         if (err_conv)
+            cd_add(sig_cd(on_failure, cur_fnc));
+         for (i = 0; i < nsyms; ++i)
+            cur_symtab[i].loc = NULL;
+         return 0;
+
+      case IL_Lst:
+         /*
+          * Two consecutive pieces of RTL code.
+          */
+         fall_thru = gen_il(il->u[0].fld);
+         if (fall_thru)
+            fall_thru = gen_il(il->u[1].fld);
+         return fall_thru;
+
+      case IL_Block:
+         /*
+          * inline {...} statement.
+          *
+          *  Allocate and initialize any tended locals.
+          */
+         ntended = il->u[1].n;
+         if (ntended > 0)
+            tended = (struct val_loc **)alloc((unsigned int)
+               sizeof(struct val_loc *) * ntended);
+         for (i = 2; i - 2 < ntended; ++i) {
+             tnd = chk_alc(NULL, intrnl_lftm);
+             tended[i - 2] = tnd;
+             switch (il->u[i].n) {
+                case TndDesc:
+                   break;
+                case TndStr:
+                   cd = alc_ary(2);
+                   cd->ElemTyp(0) = A_ValLoc;
+                   cd->ValLoc(0) =                tnd;
+                   cd->ElemTyp(1) = A_Str;
+                   cd->Str(1) =                   " = emptystr;";
+                   cd_add(cd);
+                   break;
+                case TndBlk:
+                   cd = alc_ary(2);
+                   cd->ElemTyp(0) = A_ValLoc;
+                   cd->ValLoc(0) =                tnd;
+                   cd->ElemTyp(1) = A_Str;
+                   cd->Str(1) =                   " = nullptr;"; 
+                   cd_add(cd);
+                   break;
+                }
+            }
+         gen_ilc(il->u[i].c_cd);    /* body of block */
+         /*
+          * See if execution can fall through this code.
+          */
+         if (il->u[0].n)
+            return 1;
+         else {
+            for (i = 0; i < nsyms; ++i)
+               cur_symtab[i].loc = NULL;
+            return 0;
+            }
+
+      case IL_Call:
+         /*
+          * call to body function.
+          */
+         return body_fnc(il);
+
+      case IL_Abstr:
+         /*
+          * abstract type computation. Only used by type inference.
+          */
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(1);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * arth_arg - in-line code to check a conversion for an arith_case statement.
+ */
+static void arth_arg(var, v_orig, chk, cnv)
+struct il_code *var;
+struct val_loc *v_orig;
+int chk;
+struct code *cnv;
+   {
+   struct code *lbl;
+   struct code *cd;
+
+   if (chk) {
+      /*
+       * Must check the conversion.
+       */
+      lbl = oper_lbl("converted");
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      if (cnv != NULL) {
+         cd = NewCode(2);
+         cd->cd_id = C_If;
+         cd->Cond = cnv;
+         cd->ThenStmt = mk_goto(lbl);
+         cd_add(cd);
+         }
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "err_msg(102, &(";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =           v_orig;    /* var location before conversion */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =              "));";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+   else if (cnv != NULL) {
+      cd_add(cnv);          /* conversion cannot fail  */
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              ";";
+      cd_add(cd);
+      }
+   }
+
+/*
+ * body_fnc - generate code to call a body function.
+ */
+static int body_fnc(il)
+struct il_code *il;
+   {
+   struct code *arg_lst;
+   struct code *cd;
+   struct c_fnc *cont1;
+   char *oper_nm;
+   int ret_val;
+   int ret_flag;
+   int need_rslt;
+   int num_sbuf;
+   int num_cbuf;
+   int expl_args;
+   int arglst_sz;  /* size of arg list in number of code pieces */
+   int il_indx;
+   int cd_indx;
+   int proto_prt;
+   int i;
+
+   /*
+    * Determine if a function prototype has been printed yet for this
+    *  body function.
+    */
+   proto_prt = il->u[0].n;
+   il->u[0].n = 1;
+
+   /*
+    * Construct the name of the body function.
+    */
+   oper_nm = (char *)alloc((unsigned int)(strlen(impl->name) + 6));
+   sprintf(oper_nm, "%c%c%c%c_%s", impl->oper_typ, impl->prefix[0],
+      impl->prefix[1], (char)il->u[1].n, impl->name);
+
+   /*
+    * Extract from the call the flags and other information describing
+    *  the function, then use this information to deduce the arguments
+    *  needed by the function.
+    */
+   ret_val = il->u[2].n;
+   ret_flag = il->u[3].n;
+   need_rslt = il->u[4].n;
+   num_sbuf = il->u[5].n;
+   num_cbuf = il->u[6].n;
+   expl_args = il->u[7].n;
+
+   /*
+    * determine how large the argument list is.
+    */
+   arglst_sz = 2 * expl_args - 1;
+   if (num_sbuf > 0)
+      arglst_sz += 3;
+   if (num_cbuf > 0)
+      arglst_sz += 2;
+   if (need_rslt)
+      arglst_sz += 3;
+   if (arglst_sz > 0)
+      arg_lst = alc_ary(arglst_sz);
+   else
+      arg_lst = alc_ary(0);
+
+   if (!proto_prt) {
+      /*
+       * Determine whether the body function returns a C integer, double,
+       *  no value, or a signal.
+       */
+      switch (ret_val) {
+         case RetInt:
+            fprintf(inclfile, "C_integer %s (", oper_nm);
+            break;
+         case RetDbl:
+            fprintf(inclfile, "double %s (", oper_nm);
+            break;
+         case RetNoVal:
+            fprintf(inclfile, "void %s (", oper_nm);
+            break;
+         case RetSig:
+            fprintf(inclfile, "int %s (", oper_nm);
+            break;
+         }
+     }
+
+   /*
+    * Produce prototype and code for the explicit arguments in the
+    *  function call. Note that the call entry contains C code for both.
+    */
+   il_indx = 8;
+   cd_indx = 0;
+   while (expl_args--) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;                /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      if (!proto_prt)
+        fprintf(inclfile, "%s", il->u[il_indx].c_cd->s);   /* parameter dcl */
+      ++il_indx;
+      sub_ilc(il->u[il_indx++].c_cd, arg_lst, cd_indx++);
+      }
+
+   /*
+    * If string buffers are needed, allocate them and pass pointer to
+    *   function.
+    */
+   if (num_sbuf > 0) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_Str;
+      arg_lst->Str(cd_indx) = "(char (*)[MaxCvtLen])";
+      ++cd_indx;
+      arg_lst->ElemTyp(cd_indx) = A_SBuf;
+      arg_lst->Intgr(cd_indx) = alc_sbufs(num_sbuf, intrnl_lftm);
+      if (!proto_prt)
+         fprintf(inclfile, "char (*r_sbuf)[MaxCvtLen]");
+      ++cd_indx;
+      }
+
+   /*
+    * If cset buffers are needed, allocate them and pass pointer to
+    *   function.
+    */
+   if (num_cbuf > 0) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_CBuf;
+      arg_lst->Intgr(cd_indx) = alc_cbufs(num_cbuf, intrnl_lftm);
+      if (!proto_prt)
+         fprintf(inclfile, "struct b_cset *r_cbuf");
+      ++cd_indx;
+      }
+
+   /*
+    * See if the function needs a pointer to the result location
+    *  of the operation.
+    */
+   if (need_rslt) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_Str;        /* location of result */
+      arg_lst->Str(cd_indx) = "&";
+      ++cd_indx;
+      arg_lst->ElemTyp(cd_indx) = A_ValLoc;
+      arg_lst->ValLoc(cd_indx) = rslt;
+      if (!proto_prt)
+         fprintf(inclfile, "dptr rslt");
+      ++cd_indx;
+      }
+
+   if (!proto_prt) {
+      /*
+       * The last possible argument is the success continuation.
+       *  If there are no arguments, indicate this in the prototype.
+       */
+      if (ret_flag & DoesSusp) {
+         if (cd_indx > 0)
+            fprintf(inclfile, ", ");
+         fprintf(inclfile, "continuation succ_cont");
+         }
+      else if (cd_indx == 0)
+         fprintf(inclfile, "void");
+      fprintf(inclfile, ");\n");
+      }
+
+   /*
+    * Does this call need the success continuation for the operation.
+    */
+   if (ret_flag & DoesSusp)
+       cont1 = cont;
+   else
+       cont1 = NULL;
+
+   switch (ret_val) {
+      case RetInt:
+         /*
+          * The body function returns a C integer.
+          */
+         cd = alc_ary(6);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =               rslt;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  ".vword.integr = ";
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                  oper_nm;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  "(";
+         cd->ElemTyp(4) = A_Ary;
+         cd->Array(4) =                  arg_lst;
+         cd->ElemTyp(5) = A_Str;
+         cd->Str(5) =                  ");";
+         cd_add(cd);
+         dwrd_asgn(rslt, "Integer");
+         cd_add(mk_goto(*scont_strt));
+         break;
+      case RetDbl:
+         /*
+          * The body function returns a C double.
+          */
+         cd = alc_ary(6);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =               rslt;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  ".vword.bptr = (union block *)alcreal(";
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                  oper_nm;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  "(";
+         cd->ElemTyp(4) = A_Ary;
+         cd->Array(4) =                  arg_lst;
+         cd->ElemTyp(5) = A_Str;
+         cd->Str(5) =                  "));";
+         cd_add(cd);
+         dwrd_asgn(rslt, "Real");
+         chkforblk();    /* make sure the block allocation succeeded */
+         cd_add(mk_goto(*scont_strt));
+         break;
+      case RetNoVal:
+         /*
+          * The body function does not directly return a value.
+          */
+         cd = alc_ary(4);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =                  oper_nm;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  "(";
+         cd->ElemTyp(2) = A_Ary;
+         cd->Array(2) =                  arg_lst;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  ");";
+         cd_add(cd);
+         if (ret_flag & DoesFail | (err_conv && (ret_flag & DoesEFail)))
+            cd_add(sig_cd(on_failure, cur_fnc));
+         else if (ret_flag & DoesRet)
+            cd_add(mk_goto(*scont_strt));
+         break;
+      case RetSig:
+         /*
+          * The body function returns a signal.
+          */
+         callo_add(oper_nm, ret_flag, cont1, 0, arg_lst, mk_goto(*scont_strt));
+         break;
+      }
+   /*
+    * See if execution can fall through this call.
+    */
+   if (ret_flag & DoesFThru)
+      return 1;
+   else {
+      for (i = 0; i < nsyms; ++i)
+         cur_symtab[i].loc = NULL;
+      return 0;
+      }
+   }
+
+
+/*
+ * il_var - generate code for a possibly subscripted variable into
+ *   an element of a code array.
+ */
+static void il_var(il, cd, indx)
+struct il_code *il;
+struct code *cd;
+int indx;
+   {
+   struct code *cd1;
+
+   if (il->il_type == IL_Subscr) {
+      /*
+       * Subscripted variable.
+       */
+      cd1 = cd;
+      cd = alc_ary(4);
+      cd1->ElemTyp(indx) = A_Ary;
+      cd1->Array(indx) = cd;
+      indx = 0;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =                  "[";
+      cd->ElemTyp(2) = A_Intgr;
+      cd->Intgr(2) =                il->u[1].n;
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) =                  "]";
+      }
+
+   /*
+    * See if this is the result location of the operation or an ordinary
+    *  variable.
+    */
+   cd->ElemTyp(indx) = A_ValLoc;
+   if (il->u[0].n == RsltIndx)
+      cd->ValLoc(indx) = rslt;
+   else
+      cd->ValLoc(indx) = cur_symtab[il->u[0].n].loc;
+   }
+
+/*
+ * part_asgn - generate code for an assignment to (part of) a descriptor.
+ */
+static void part_asgn(vloc, asgn, value)
+struct val_loc *vloc;
+char *asgn;
+struct il_c *value;
+   {
+   struct code *cd;
+
+   cd = alc_ary(4);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =                          vloc;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                             asgn;
+   sub_ilc(value, cd, 2);                /* value */
+   cd->ElemTyp(3) = A_Str;
+   cd->Str(3) =                             ";";
+   cd_add(cd);
+   }
+
+/*
+ * dwrd_asgn - generate code to assign a type code to the dword of a descriptor.
+ */
+static void dwrd_asgn(vloc, typ)
+struct val_loc *vloc;
+char *typ;
+   {
+   struct code *cd;
+
+   cd = alc_ary(4);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =               vloc;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                  ".dword = D_";
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                  typ;
+   cd->ElemTyp(3) = A_Str;
+   cd->Str(3) =                  ";";
+   cd_add(cd);
+   }
+
+/*
+ * sub_ilc - generate code from a sequence of C code and place it
+ *  in a slot in a code array.
+ */
+static void sub_ilc(ilc, cd, indx)
+struct il_c *ilc;
+struct code *cd;
+int indx;
+   {
+   struct il_c *ilc1;
+   struct code *cd1;
+   int n;
+
+   /*
+    * Count the number of pieces of C code to process.
+    */
+   n = 0;
+   for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next)
+      ++n;
+
+   /*
+    * If there is only one piece of code, place it directly in the 
+    *  slot of the array. Otherwise allocate a sub-array and place it
+    *  in the slot.
+    */
+   if (n > 1) {
+      cd1 = cd;
+      cd = alc_ary(n);
+      cd1->ElemTyp(indx) = A_Ary;
+      cd1->Array(indx) = cd;
+      indx = 0;
+      }
+
+   while (ilc != NULL) {
+      switch (ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+            /*
+             * Reference to variable in symbol table.
+             */
+            cd->ElemTyp(indx) = A_ValLoc;
+            if (ilc->n == RsltIndx)
+               cd->ValLoc(indx) = rslt;
+            else {
+               if (ilc->s == NULL)
+                  cd->ValLoc(indx) = cur_symtab[ilc->n].loc;
+               else {
+                  /*
+                   * Access the entire descriptor.
+                   */
+                  cd->ValLoc(indx) = loc_cpy(cur_symtab[ilc->n].loc, M_None);
+                  }
+               }
+            break;
+
+         case ILC_Tend:
+            /*
+             * Reference to a tended variable.
+             */
+            cd->ElemTyp(indx) = A_ValLoc;
+            cd->ValLoc(indx) = tended[ilc->n];
+            break;
+
+         case ILC_Str:
+            /*
+             * String representing C code.
+             */
+            cd->ElemTyp(indx) = A_Str;
+            cd->Str(indx) = ilc->s;
+            break;
+
+         case ILC_SBuf:
+            /*
+             * String buffer for a conversion.
+             */
+            cd->ElemTyp(indx) = A_SBuf;
+            cd->Intgr(indx) = alc_sbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_CBuf:
+            /*
+             * Cset buffer for a conversion.
+             */
+            cd->ElemTyp(indx) = A_CBuf;
+            cd->Intgr(indx) = alc_cbufs(1, intrnl_lftm);
+            break;
+
+
+         default:
+            fprintf(stderr, "compiler error: unknown info in data base\n");
+            exit(1);
+         }
+      ilc = ilc->next;
+      ++indx;
+      }
+
+   }
+
+/*
+ * gen_ilret - generate code to set the result value from a suspend or
+ *   return.
+ */
+static void gen_ilret(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc0;
+   struct code *cd;
+   char *cap_id;
+   int typcd;
+
+   if (rslt == &ignore)
+      return;    /* Don't bother computing the result; it's never used */
+
+   ilc0 = ilc->code[0];
+   typcd = ilc->n;
+
+   if (typcd < 0) {
+      /*
+       * RTL returns that do not look like function calls to standard Icon
+       *  type name.
+       */
+      switch (typcd) {
+         case TypCInt:
+            /*
+             * return/suspend C_integer <expr>;
+             */
+            part_asgn(rslt, ".vword.integr = ", ilc0);
+            dwrd_asgn(rslt, "Integer");
+            break;
+         case TypCDbl:
+            /*
+             * return/suspend C_double <expr>;
+             */
+            cd = alc_ary(4);
+            cd->ElemTyp(0) = A_ValLoc;
+            cd->ValLoc(0) =             rslt;
+            cd->ElemTyp(1) = A_Str;
+            cd->Str(1) =                ".vword.bptr = (union block *)alcreal(";
+            sub_ilc(ilc0, cd, 2);       /* value */
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) =                ");";
+            cd_add(cd);
+            dwrd_asgn(rslt, "Real");
+            chkforblk();    /* make sure the block allocation succeeded */
+            break;
+         case TypCStr:
+            /*
+             * return/suspend C_string <expr>;
+             */
+            cd = alc_ary(5);
+            cd->ElemTyp(0) = A_Str;
+            cd->Str(0) =                  "AsgnCStr(";
+            cd->ElemTyp(1) = A_ValLoc;
+            cd->ValLoc(1) =               rslt;
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                  ", ";
+            sub_ilc(ilc0, cd, 3);         /* <expr> */
+            cd->ElemTyp(4) = A_Str;
+            cd->Str(4) =                  ");";
+            cd_add(cd);
+            break;
+         case RetDesc:
+            /*
+             * return/suspend <expr>;
+             */
+            part_asgn(rslt, " = ", ilc0);
+            break;
+         case RetNVar:
+            /*
+             * return/suspend named_var(<desc-pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = ", ilc0);
+            dwrd_asgn(rslt, "Var");
+            break;
+         case RetSVar:
+            /*
+             * return/suspend struct_var(<desc-pntr>, <block_pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = (dptr)", ilc->code[1]);
+            cd = alc_ary(6);
+            cd->ElemTyp(0) = A_ValLoc;
+            cd->ValLoc(0) =               rslt;
+            cd->ElemTyp(1) = A_Str;
+            cd->Str(1) =                  ".dword = D_Var + ((word *)";
+            sub_ilc(ilc0, cd, 2);       /* value */
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) =                  " - (word *)";
+            cd->ElemTyp(4) = A_ValLoc;
+            cd->ValLoc(4) =               rslt;
+            cd->ElemTyp(5) = A_Str;
+            cd->Str(5) =                  ".vword.descptr);";
+            cd_add(cd);
+            break;
+         case RetNone:
+            /*
+             * return/suspend result;
+             *
+             *  Result already set, do nothing.
+             */
+            break;
+         default:
+            fprintf(stderr,
+               "compiler error: unknown RLT return in data base\n");
+            exit(1);
+            /* NOTREACHED */
+         }
+      }
+   else {
+      /*
+       * RTL returns that look like function calls to standard Icon type
+       *  names.
+       */
+      cap_id = icontypes[typcd].cap_id;
+      switch (icontypes[typcd].rtl_ret) {
+         case TRetBlkP:
+            /*
+             * return/suspend <type>(<block-pntr>);
+             */
+            part_asgn(rslt, ".vword.bptr = (union block *)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetDescP:
+            /*
+             * return/suspend <type>(<descriptor-pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = (dptr)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetCharP:
+            /*
+             * return/suspend <type>(<char-pntr>);
+             */
+            part_asgn(rslt, ".vword.sptr = (char *)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetCInt:
+            /*
+             * return/suspend <type>(<integer>);
+             */
+            part_asgn(rslt, ".vword.integr = (word)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetSpcl:
+            /*
+             * RTL returns that look like function calls to standard type
+             *  names but take more than one argument.
+             */
+            if (typcd == str_typ) {
+                /*
+                * return/suspend string(<len>, <char-pntr>);
+                */
+               part_asgn(rslt, ".vword.sptr = ", ilc->code[1]);
+               part_asgn(rslt, ".dword = ", ilc0);
+               }
+            else if (typcd == stv_typ) {
+               /*
+                * return/suspend substr(<desc-pntr>, <start>, <len>);
+                */
+               cd = alc_ary(9);
+               cd->ElemTyp(0) = A_Str;
+               cd->Str(0) =                  "SubStr(&";
+               cd->ElemTyp(1) = A_ValLoc;
+               cd->ValLoc(1) =               rslt;
+               cd->ElemTyp(2) = A_Str;
+               cd->Str(2) =                  ", ";
+               sub_ilc(ilc0, cd, 3);
+               cd->ElemTyp(4) = A_Str;
+               cd->Str(4) =                  ", ";
+               sub_ilc(ilc->code[2], cd, 5);
+               cd->ElemTyp(6) = A_Str;
+               cd->Str(6) =                  ", ";
+               sub_ilc(ilc->code[1], cd, 7);
+               cd->ElemTyp(8) = A_Str;
+               cd->Str(8) =                  ");";
+               cd_add(cd);
+               chkforblk();    /* make sure the block allocation succeeded */
+               }
+            else {
+               fprintf(stderr,
+                  "compiler error: unknown RLT return in data base\n");
+               exit(1);
+               /* NOTREACHED */
+               }
+            break;
+         default:
+            fprintf(stderr,
+               "compiler error: unknown RLT return in data base\n");
+            exit(1);
+            /* NOTREACHED */
+         }
+      }
+   }
+
+/*
+ * chkforblk - generate code to make sure the allocation of a block
+ *   for the result descriptor was successful.
+ */
+static void chkforblk()
+   {
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+
+   lbl = alc_lbl("got allocation", 0);
+   cd_add(lbl);
+   cur_fnc->cursor = lbl->prev;        /* code goes before label */
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(3);
+   cd1->ElemTyp(0) = A_Str;
+   cd1->Str(0) =                  "(";
+   cd1->ElemTyp(1) = A_ValLoc;
+   cd1->ValLoc(1) =               rslt;
+   cd1->ElemTyp(2) = A_Str;
+   cd1->Str(2) =                  ").vword.bptr != NULL";
+   cd->Cond = cd1;
+   cd->ThenStmt = mk_goto(lbl);
+   cd_add(cd);
+   cd = alc_ary(1);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                   "err_msg(307, NULL);";
+   cd_add(cd);
+   if (err_conv)
+      cd_add(sig_cd(on_failure, cur_fnc));
+   cur_fnc->cursor = lbl;
+   }
+
+/*
+ * gen_ilc - generate code for an sequence of in-line C code.
+ */
+static void gen_ilc(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc1;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl1;
+   struct code *fail_sav;
+   struct code **lbls;
+   int max_lbl;
+   int i;
+
+   /*
+    * Determine how many labels there are in the code and allocate an
+    *  array to map from label numbers to labels in the code.
+    */
+   max_lbl = -1;
+   for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next) {
+      switch(ilc1->il_c_type) {
+         case ILC_CGto:
+         case ILC_Goto:
+         case ILC_Lbl:
+            if (ilc1->n > max_lbl)
+               max_lbl = ilc1->n;
+         }
+      }
+   ++max_lbl;    /* adjust for 0 indexing */
+   if (max_lbl > 0) {
+      lbls = (struct code **)alloc((unsigned int) sizeof(struct code *) *
+         max_lbl);
+      for (i = 0; i < max_lbl; ++i)
+         lbls[i] = NULL;
+      }
+
+   while (ilc != NULL) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+         case ILC_Tend:
+         case ILC_SBuf:
+         case ILC_CBuf:
+         case ILC_Str:
+            /*
+             * The beginning of a sequence of code fragments that can be
+             *  place on one line.
+             */
+            ilc = line_ilc(ilc);
+            break;
+
+         case ILC_Fail:
+            /*
+             * fail - perform failure action.
+             */
+            cd_add(sig_cd(on_failure, cur_fnc));
+            break;
+
+         case ILC_EFail:
+            /*
+             * errorfail - same as fail if error conversion is supported.
+             */
+            if (err_conv)
+               cd_add(sig_cd(on_failure, cur_fnc));
+            break;
+
+         case ILC_Ret:
+            /*
+             * return - set result location and jump out of operation.
+             */
+            gen_ilret(ilc);
+            cd_add(mk_goto(*scont_strt));
+            break;
+
+         case ILC_Susp:
+            /*
+             * suspend - set result location. If there is a success
+             *  continuation, call it. Otherwise the "continuation"
+             *  will be generated in-line, so set up a resumption label.
+             */
+            gen_ilret(ilc);
+            if (cont == NULL)
+               *scont_strt = cur_fnc->cursor;
+            lbl1 = oper_lbl("end suspend");
+            cd_add(lbl1);
+            if (cont == NULL)
+               *scont_fail = lbl1;
+            else {
+               cur_fnc->cursor = lbl1->prev; 
+               fail_sav = on_failure;
+               on_failure = lbl1;
+               callc_add(cont);
+               on_failure = fail_sav;
+               cur_fnc->cursor = lbl1;
+               }
+            break;
+
+         case ILC_LBrc:
+            /*
+             * non-deletable '{'
+             */
+            cd = NewCode(0);
+            cd->cd_id = C_LBrack;
+            cd_add(cd);
+            break;
+
+         case ILC_RBrc:
+            /*
+             * non-deletable '}'
+             */
+            cd = NewCode(0);
+            cd->cd_id = C_RBrack;
+            cd_add(cd);
+            break;
+
+         case ILC_CGto:
+            /*
+             * Conditional goto.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd = NewCode(2);
+            cd->cd_id = C_If;
+            cd1 = alc_ary(1);
+            sub_ilc(ilc->code[0], cd1, 0);
+            cd->Cond = cd1;
+            cd->ThenStmt = mk_goto(lbls[i]);
+            cd_add(cd);
+            break;
+
+         case ILC_Goto:
+            /*
+             * Goto.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd_add(mk_goto(lbls[i]));
+            break;
+
+         case ILC_Lbl:
+            /*
+             * Label.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd_add(lbls[i]);
+            break;
+
+         default:
+            fprintf(stderr, "compiler error: unknown info in data base\n");
+            exit(1);
+         }
+      ilc = ilc->next;
+      }
+
+   if (max_lbl > 0)
+      free((char *)lbls);
+   }
+
+/*
+ * line_ilc - gather a line of in-line code.
+ */
+static struct il_c *line_ilc(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc1;
+   struct il_c *last;
+   struct code *cd;
+   int n;
+   int i;
+
+   /*
+    * Count the number of pieces in the line. Determine the last
+    *  piece in the sequence; this is returned to the caller.
+    */
+   n = 0;
+   ilc1 = ilc;
+   while (ilc1 != NULL) {
+      switch(ilc1->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+         case ILC_Tend:
+         case ILC_SBuf:
+         case ILC_CBuf:
+         case ILC_Str:
+            ++n;
+            last = ilc1;
+            ilc1 = ilc1->next;
+            break;
+         default: 
+            ilc1 = NULL;
+         }
+      }
+
+   /*
+    * Construct the line.
+    */
+   cd = alc_ary(n);
+   for (i = 0; i < n; ++i) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+            /*
+             * Reference to variable in symbol table.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            if (ilc->n == RsltIndx)
+               cd->ValLoc(i) = rslt;
+            else
+               cd->ValLoc(i) = cur_symtab[ilc->n].loc;
+            break;
+
+         case ILC_Tend:
+            /*
+             * Reference to a tended variable.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            cd->ValLoc(i) = tended[ilc->n];
+            break;
+
+         case ILC_SBuf:
+            /*
+             * String buffer for a conversion.
+             */
+            cd->ElemTyp(i) = A_SBuf;
+            cd->Intgr(i) = alc_sbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_CBuf:
+            /*
+             * Cset buffer for a conversion.
+             */
+            cd->ElemTyp(i) = A_CBuf;
+            cd->Intgr(i) = alc_cbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_Str:
+            /*
+             * String representing C code.
+             */
+            cd->ElemTyp(i) = A_Str;
+            cd->Str(i) = ilc->s;
+            break;
+
+         default:
+            ilc = NULL;  
+         }
+      ilc = ilc->next;
+      }
+
+   cd_add(cd);
+   return last;
+   }
+
+/*
+ * generate code to perform simple type checking.
+ */
+struct code *typ_chk(var, typcd)
+struct il_code *var;
+int typcd;
+   {
+   struct code *cd;
+
+   if (typcd == int_typ && largeints) {
+      /*
+       * Handle large integer support specially.
+       */
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword == D_Integer || (";
+      il_var(var, cd, 3);                    /* value */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                           ").dword == D_Lrgint)";
+      return cd;
+      }
+   else if (typcd < 0) {
+      /*
+       * Not a standard Icon type name.
+       */
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      switch (typcd) {
+         case TypVar:
+            cd->Str(0) =                     "(((";
+            il_var(var, cd, 1);              /* value */
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                     ").dword & D_Var) == D_Var)";
+            break;
+         case TypCInt:
+            cd->Str(0) =                     "((";
+            il_var(var, cd, 1);              /* value */
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                     ").dword == D_Integer)";
+            break;
+         }
+      }
+   else if (typcd == str_typ) {
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "(!((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword & F_Nqual))";
+      }
+   else {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword == D_";
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) = icontypes[typcd].cap_id;  /* type name */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                           ")";
+      }
+
+   return cd;
+   }
+
+/*
+ * oper_lbl - generate a label with an associated comment that includes
+ *   the operation name.
+ */
+static struct code *oper_lbl(s)
+char *s;
+   {
+   char *sbuf;
+
+   sbuf = (char *)alloc((unsigned int)(strlen(s) + strlen(impl->name) + 3));
+   sprintf(sbuf, "%s: %s", s, impl->name);
+   return alc_lbl(sbuf, 0);
+   }
+
+/*
+ * sav_locs - save the current interpretation of symbols that may
+ *  be affected by conversions.
+ */
+static struct val_loc **sav_locs()
+   {
+   struct val_loc **locs;
+   int i;
+
+   if (nsyms == 0)
+      return NULL;
+
+   locs = (struct val_loc **)alloc((unsigned int)(nsyms *
+      sizeof(struct val_loc *)));
+   for (i = 0; i < nsyms; ++i)
+      locs[i] = cur_symtab[i].loc;
+   return locs;
+   }
+
+/*
+ * rstr_locs - restore the interpretation of symbols that may
+ *  have been affected by conversions.
+ */
+static void rstr_locs(locs)
+struct val_loc **locs;
+   {
+   int i;
+
+   for (i = 0; i < nsyms; ++i)
+      cur_symtab[i].loc = locs[i];
+   free((char *)locs);
+   }
+
+/*
+ * mrg_locs - merge the interpretations of symbols along two execution
+ *  paths. Any ambiguity is caught by rtt, so differences only occur
+ *  if one path involves program termination so that the symbols
+ *  no longer have an interpretation along that path.
+ */
+static void mrg_locs(locs)
+struct val_loc **locs;
+   {
+   int i;
+
+   for (i = 0; i < nsyms; ++i)
+      if (cur_symtab[i].loc == NULL)
+         cur_symtab[i].loc = locs[i];
+   free((char *)locs);
+   }
+
+/*
+ * il_cnv - generate code for an in-line conversion.
+ */
+struct code *il_cnv(typcd, src, dflt, dest)
+int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+   {
+   struct code *cd;
+   struct code *cd1;
+   int dflt_to_ptr;
+   int loc;
+   int is_cstr;
+   int sym_indx;
+   int n;
+   int i;
+
+   sym_indx = src->u[0].n;
+
+   /*
+    * Determine whether the address must be taken of a default value and
+    *  whether the interpretation of the symbol in an in-place conversion
+    *  changes.
+    */
+   dflt_to_ptr = 0;
+   loc = PrmTend;
+   is_cstr = 0;
+   switch (typcd) {
+      case TypCInt:
+      case TypECInt:
+         loc = PrmInt;
+         break;
+      case TypCDbl:
+         loc = PrmDbl;
+         break;
+      case TypCStr:
+         is_cstr = 1;
+         break;
+      case TypEInt:
+         break;
+      case TypTStr:
+      case TypTCset:
+         dflt_to_ptr = 1;
+         break;
+      default:
+         /*
+          * Cset, real, integer, or string
+          */
+         if (typcd == cset_typ || typcd == str_typ)
+            dflt_to_ptr = 1;
+         break;
+      }
+
+  if (typcd == TypCDbl && !(eval_is(real_typ, sym_indx) & MaybeFalse)) {
+     /*
+      * Conversion from Icon real to C double. Just copy the C value
+      *  from the block.
+      */
+     cd = alc_ary(5);
+     cd->ElemTyp(0) = A_Str;
+     cd->Str(0) =                "(GetReal(&(";
+     il_var(src, cd, 1);
+     cd->ElemTyp(2) = A_Str;
+     cd->Str(2) =                "), ";
+     cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 3);
+     cd->ElemTyp(4) = A_Str;
+     cd->Str(4) =                "), 1)";
+     }
+  else if (typcd == TypCDbl && !largeints &&
+     !(eval_is(int_typ, sym_indx) & MaybeFalse)) {
+     /*
+      * Conversion from Icon integer (not large integer) to C double.
+      *  Do as a C conversion by an assigment.
+      */
+     cd = alc_ary(5);
+     cd->ElemTyp(0) = A_Str;
+     cd->Str(0) =                "(";
+     cd->ElemTyp(2) = A_Str;
+     cd->Str(2) =                " = IntVal( ";
+     cd->ElemTyp(4) = A_Str;
+     cd->Str(4) =                "), 1)";
+     /*
+      * Note that cnv_dest() must be called after the source is output
+      *  in case it changes the location of the parameter.
+      */
+     il_var(src, cd, 3);
+     cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 1);
+     }
+   else {
+      /*
+       * Compute the number of code fragments required to construct the
+       *  call to the conversion routine.
+       */
+      n = 7;
+      if (dflt != NULL)
+        n += 2;
+   
+      cd = alc_ary(n);
+   
+      /*
+       * The names of simple conversions are distinguished from defaulting
+       *  conversions by a prefix of "cnv_" or "def_".
+       */
+      cd->ElemTyp(0) = A_Str;
+      if (dflt == NULL)
+         cd->Str(0) = "cnv_";
+      else
+         cd->Str(0) = "def_";
+   
+      /*
+       * Determine the name of the conversion routine.
+       */
+      cd->ElemTyp(1) = A_Str;    /* may be overridden */
+      switch (typcd) {
+         case TypCInt:
+            cd->Str(1) = "c_int(&(";
+            break;
+         case TypCDbl:
+            cd->Str(1) = "c_dbl(&(";
+            break;
+         case TypCStr:
+            cd->Str(1) = "c_str(&(";
+            break;
+         case TypEInt:
+            cd->Str(1) = "eint(&(";
+            break;
+         case TypECInt:
+            cd->Str(1) = "ec_int(&(";
+            break;
+         case TypTStr:
+            /*
+             * Allocate a string buffer.
+             */
+            cd1 = alc_ary(3);
+            cd1->ElemTyp(0) = A_Str;
+            cd1->Str(0) = "tstr(";
+            cd1->ElemTyp(1) = A_SBuf;
+            cd1->Intgr(1) = alc_sbufs(1, intrnl_lftm);
+            cd1->ElemTyp(2) = A_Str;
+            cd1->Str(2) = ", (&";
+            cd->ElemTyp(1) = A_Ary;
+            cd->Array(1) = cd1;
+            break;
+         case TypTCset:
+            /*
+             * Allocate a cset buffer.
+             */
+            cd1 = alc_ary(3);
+            cd1->ElemTyp(0) = A_Str;
+            cd1->Str(0) = "tcset(";
+            cd1->ElemTyp(1) = A_CBuf;
+            cd1->Intgr(1) = alc_cbufs(1, intrnl_lftm);
+            cd1->ElemTyp(2) = A_Str;
+            cd1->Str(2) = ", &(";
+            cd->ElemTyp(1) = A_Ary;
+            cd->Array(1) = cd1;
+            break;
+         default:
+            /*
+             * Cset, real, integer, or string
+             */
+            if (typcd == cset_typ)
+               cd->Str(1) = "cset(&(";
+            else if (typcd == real_typ) 
+               cd->Str(1) = "real(&(";
+            else if (typcd == int_typ) 
+               cd->Str(1) = "int(&(";
+            else if (typcd == str_typ)
+               cd->Str(1) = "str(&(";
+            break;
+         }
+   
+      il_var(src, cd, 2);
+   
+      cd->ElemTyp(3) = A_Str;
+      if (dflt != NULL && dflt_to_ptr)
+         cd->Str(3) = "), &(";
+      else
+         cd->Str(3) = "), ";
+   
+   
+      /*
+       * Determine if this conversion has a default value.
+       */
+      i = 4;
+      if (dflt != NULL) {
+         sub_ilc(dflt, cd, i);
+         ++i;
+         cd->ElemTyp(i) = A_Str;
+         if (dflt_to_ptr)
+            cd->Str(i) = "), ";
+         else
+            cd->Str(i) = ", ";
+         ++i;
+         }
+   
+      cd->ElemTyp(i) = A_Str;
+      cd->Str(i) = "&(";
+      ++i;
+      cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i);
+      ++i;
+      cd->ElemTyp(i) = A_Str;
+      cd->Str(i) = "))";
+      }
+   return cd;
+   }
+
+/*
+ * il_dflt - generate code for a defaulting conversion that always defaults.
+ */
+struct code *il_dflt(typcd, src, dflt, dest)
+int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+   {
+   struct code *cd;
+   int sym_indx;
+
+   sym_indx = src->u[0].n;
+
+   if (typcd == TypCDbl) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(PrmDbl, 0, src, sym_indx, dest, cd, 1);  /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypCInt || typcd == TypECInt) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(PrmInt, 0, src, sym_indx, dest, cd, 1);  /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypTStr || typcd == str_typ) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypCStr) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(AsgnCStr(";
+      cnv_dest(0, 1, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ", ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      "), 1)";
+      }
+   else if (typcd == TypTCset || typcd == cset_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(BlkLoc(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ") = (union block *)&";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", ";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                      ".dword = D_Cset, 1)";
+      }
+   else if (typcd == TypEInt || typcd == int_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(IntVal(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ") = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", ";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                     ".dword = D_Integer, 1)";
+      }
+   else if (typcd == real_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "((BlkLoc(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                ") = (union block *)alcreal(";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                     ")) == NULL ? (fatalerr(0,NULL), 0) : (";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                     ".dword = D_Real, 1))";
+      }
+
+   return cd;
+   }
+
+/*
+ * cnv_dest - output the destination of a conversion.
+ */
+static void cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i)
+int loc;
+int is_cstr;
+struct il_code *src;
+int sym_indx;
+struct il_c *dest;
+struct code *cd;
+int i;
+   {
+   if (dest == NULL) {
+      /*
+       * Convert "in place", changing the location of a parameter if needed.
+       */
+      switch (loc) {
+         case PrmInt:
+            if (cur_symtab[sym_indx].itmp_indx < 0)
+               cur_symtab[sym_indx].itmp_indx = alc_itmp(intrnl_lftm);
+            cur_symtab[sym_indx].loc = itmp_loc(cur_symtab[sym_indx].itmp_indx);
+            break;
+         case PrmDbl:
+            if (cur_symtab[sym_indx].dtmp_indx < 0)
+               cur_symtab[sym_indx].dtmp_indx = alc_dtmp(intrnl_lftm);
+            cur_symtab[sym_indx].loc = dtmp_loc(cur_symtab[sym_indx].dtmp_indx);
+            break;
+         }
+      il_var(src, cd, i);
+      if (is_cstr)
+         cur_symtab[sym_indx].loc = loc_cpy(cur_symtab[sym_indx].loc,M_CharPtr);
+      }
+   else {
+      if (is_cstr && dest->il_c_type == ILC_Mod && dest->next == NULL &&
+         dest->n != RsltIndx && cur_symtab[dest->n].loc->mod_access != M_None) {
+            /*
+             * We are converting to a C string. The destination variable
+             *  is not defined as a simple descriptor, but must be accessed
+             *  as such for this conversion.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            cd->ValLoc(i) = loc_cpy(cur_symtab[dest->n].loc, M_None);
+            }
+      else 
+         sub_ilc(dest, cd, i);
+      }
+
+   }
+
+/*
+ * il_copy - produce code for an optimized "conversion" that always succeeds
+ *   and just copies a value from one place to another.
+ */
+struct code *il_copy(dest, src)
+struct il_c *dest;
+struct val_loc *src;
+   {
+   struct code *cd;
+
+   cd = alc_ary(5);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) = "(";
+   sub_ilc(dest, cd, 1);
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) = " = ";
+   cd->ElemTyp(3) = A_ValLoc;
+   cd->ValLoc(3) = src;
+   cd->ElemTyp(4) = A_Str;
+   cd->Str(4) = ", 1)";
+   return cd;
+   }
+
+/*
+ * loc_cpy - make a copy of a reference to a value location, but change
+ *  the way the location is accessed.
+ */
+struct val_loc *loc_cpy(loc, mod_access)
+struct val_loc *loc;
+int mod_access;
+   {
+   struct val_loc *new_loc;
+
+   if (loc == NULL)
+      return NULL;
+   new_loc = NewStruct(val_loc);
+   *new_loc = *loc;
+   new_loc->mod_access = mod_access;
+   return new_loc;
+   }
+
+/*
+ * gen_tcase - generate in-line code for a type_case statement.
+ */
+static int gen_tcase(il, has_dflt)
+struct il_code *il;
+int has_dflt;
+   {
+   struct case_anlz case_anlz;
+
+   /*
+    * We can only get here if the type_case statement can be implemented
+    *  with a no more than one type check. Determine how simple the
+    *  code can be.
+    */
+   findcases(il, has_dflt, &case_anlz);
+   if (case_anlz.il_then == NULL) {
+      if (case_anlz.il_else == NULL)
+         return 1;
+      else
+         return gen_il(case_anlz.il_else);
+      }
+   else
+      return gen_if(typ_chk(il->u[0].fld, case_anlz.typcd), case_anlz.il_then,
+         case_anlz.il_else, sav_locs());
+   }
+
+/*
+ * gen_if - generate code to test a condition that might be true
+ *  of false. Determine if execution can continue past this if statement.
+ */
+static int gen_if(cond_cd, il_then, il_else, locs)
+struct code *cond_cd;
+struct il_code *il_then;
+struct il_code *il_else;
+struct val_loc **locs;
+   {
+   struct val_loc **locs1;
+   struct code *lbl_then;
+   struct code *lbl_end;
+   struct code *else_loc;
+   struct code *cd;
+   int fall_thru;
+
+   lbl_then = oper_lbl("then");
+   lbl_end = oper_lbl("end if");
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd->Cond = cond_cd;
+   cd->ThenStmt = mk_goto(lbl_then);
+   cd_add(cd);
+   else_loc = cur_fnc->cursor;
+   cd_add(lbl_then);
+   fall_thru = gen_il(il_then);
+   cd_add(lbl_end);
+   locs1 = sav_locs();
+   rstr_locs(locs);
+   cur_fnc->cursor = else_loc;  /* go back for the else clause */
+   fall_thru |= gen_il(il_else);
+   cd_add(mk_goto(lbl_end));
+   cur_fnc->cursor = lbl_end;
+   mrg_locs(locs1);
+   return fall_thru;
+   }
diff --git a/src/iconc/ivalues.c b/src/iconc/ivalues.c
new file mode 100644
index 0000000..4fbb288
--- /dev/null
+++ b/src/iconc/ivalues.c
@@ -0,0 +1,51 @@
+/*
+ * ivalues.c - routines for manipulating Icon values.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+
+/*
+ * iconint - convert the string representation of an Icon integer to a C long. 
+ *   Return -1 if the number is too big and large integers are supported.
+ */
+long iconint(image)
+char *image;
+   {
+   register int c;
+   register int r;
+   register char *s;
+   long n, n1;
+   int overflow;
+
+   s = image;
+   overflow = 0;
+   n = 0L;
+   while ((c = *s++) >= '0' && c <= '9') {
+      n1 = n * 10 + (c - '0');
+      if (n != n1 / 10)
+         overflow = 1;
+      n = n1;
+      }
+   if (c == 'r' || c == 'R') {
+      r = n;
+      n = 0L;
+      while ((c = *s++) != '\0') {
+         n1 = n * r + tonum(c);
+         if (n != n1 / r)
+            overflow = 1;
+         n = n1;
+         }
+      }
+   if (overflow)
+      if (largeints)
+         n = -1;
+      else
+         tfatal("large integer option required", image);
+   return n;
+   }
diff --git a/src/iconc/lifetime.c b/src/iconc/lifetime.c
new file mode 100644
index 0000000..9a4a7b5
--- /dev/null
+++ b/src/iconc/lifetime.c
@@ -0,0 +1,496 @@
+/*
+ * lifetime.c - perform liveness analysis to determine lifetime of intermediate
+ *    results.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static void arg_life (nodeptr n, long min_result, long max_result,
+                          int resume, int frst_arg, int nargs, nodeptr resumer,
+                          nodeptr *failer, int *gen);
+
+static int postn = -1; /* relative position in execution order (all neg) */
+
+/*
+ * liveness - compute lifetimes of intermediate results.
+ */
+void liveness(n, resumer, failer, gen)
+nodeptr n;
+nodeptr resumer;
+nodeptr *failer;
+int *gen;
+   {
+   struct loop {
+      nodeptr resumer;
+      int gen;
+      nodeptr lifetime;
+      int every_cntrl;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop = NULL;
+   nodeptr failer1;
+   nodeptr failer2;
+   int gen1 = 0;
+   int gen2 = 0;
+   struct node *cases;
+   struct node *clause;
+   long min_result;  /* minimum result sequence length */
+   long max_result;  /* maximum result sequence length */
+   int resume;	     /* flag - resumption possible after last result */
+
+   n->postn = postn--;
+
+   switch (n->n_type) {
+      case N_Activat:
+         /*
+          * Activation can fail or succeed.
+           */
+         arg_life(n, 0L, 1L, 0, 1, 2, resumer, failer, gen);
+         break;
+
+      case N_Alt:
+         Tree1(n)->lifetime = n->lifetime;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, &failer2, &gen2);
+         liveness(Tree0(n), resumer, &failer1, &gen1);
+         *failer = failer2;
+         *gen = 1;
+         break;
+
+      case N_Apply:
+         /* 
+          * Assume operation can suspend or fail.
+          */
+         arg_life(n, 0L, UnbndSeq, 1, 0, 2, resumer, failer, gen);
+         break;
+
+      case N_Augop:
+         /*
+          * Impl0(n) is assignment. Impl1(n) is the augmented operation.
+          */
+         min_result = Impl0(n)->min_result * Impl1(n)->min_result;
+         max_result = Impl0(n)->max_result * Impl1(n)->max_result;
+         resume = Impl0(n)->resume | Impl1(n)->resume;
+         arg_life(n, min_result, max_result, resume, 2, 2, resumer, failer,
+            gen);
+         break;
+
+      case N_Bar:
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree0(n), resumer, failer, &gen1);
+         *gen = 1;
+         break;
+
+      case N_Break:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for break", NULL);
+            return;
+            }
+         Tree0(n)->lifetime = cur_loop->lifetime;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         liveness(Tree0(n), loop_sav->resumer, &failer1, &gen1);
+         cur_loop = loop_sav;
+         cur_loop->gen |= gen1;
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Case:
+         *failer = resumer;
+         *gen = 0;
+
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             *  Body.
+             */
+            Tree1(clause)->lifetime = n->lifetime;
+            liveness(Tree1(clause), resumer, &failer2, &gen2);
+            if (resumer == NULL && failer2 != NULL)
+               *failer = n;
+            *gen |= gen2;
+      
+            /*
+             * The expression being compared can be resumed.
+             */
+            Tree0(clause)->lifetime = clause;
+            liveness(Tree0(clause), clause, &failer1, &gen1);
+            }
+
+         if (Tree2(n) == NULL) {
+            if (resumer == NULL)
+               *failer = n;
+            }
+         else {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);  /* default */
+            if (resumer == NULL && failer2 != NULL)
+               *failer = n;
+            *gen |= gen2;
+            }
+
+         /*
+          * control clause is bounded
+          */
+         Tree0(n)->lifetime = n;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         if (failer1 != NULL && *failer == NULL)
+            *failer = failer1;
+         break;
+
+      case N_Create:
+         Tree0(n)->lifetime = n;
+         loop_sav = cur_loop;
+         cur_loop = NULL;        /* check for invalid break and next */
+         liveness(Tree0(n), n, &failer1, &gen1);
+         cur_loop = loop_sav;
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Cset:
+      case N_Empty:
+      case N_Id: 
+      case N_Int:
+      case N_Real:
+      case N_Str:
+         *failer = resumer;
+         *gen = 0;
+         break;
+
+      case N_Field:
+         Tree0(n)->lifetime = n;
+         liveness(Tree0(n), resumer, failer, gen);
+         break;
+
+      case N_If:
+         Tree1(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, failer, gen);
+         if (Tree2(n)->n_type != N_Empty) {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);
+            if (failer2 != NULL) {
+               if (*failer == NULL)
+                  *failer = failer2;
+               else {
+                 if ((*failer)->postn < failer2->postn)
+                   *failer = failer2;
+                 if ((*failer)->postn < n->postn)
+                   *failer = n;
+                 }
+               }
+            *gen |= gen2;
+            }
+         /*
+          * control clause is bounded
+          */
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         if (Tree2(n)->n_type == N_Empty && failer1 != NULL && *failer == NULL)
+            *failer = failer1;
+         break;
+
+      case N_Invok:
+         /*
+          * Assume operation can suspend and fail.
+          */
+         arg_life(n, 0L, UnbndSeq, 1, 1, Val0(n) + 1, resumer, failer, gen);
+         break;
+
+      case N_InvOp:
+         arg_life(n, Impl1(n)->min_result, Impl1(n)->max_result,
+            Impl1(n)->resume, 2, Val0(n), resumer, failer, gen);
+         break;
+
+      case N_InvProc:
+         if (Proc1(n)->ret_flag & DoesFail)
+             min_result = 0L;
+         else
+             min_result = 1L;
+         if (Proc1(n)->ret_flag & DoesSusp) {
+             max_result = UnbndSeq;
+             resume = 1;
+             }
+         else {
+             max_result = 1L;
+             resume = 0;
+             }
+         arg_life(n, min_result, max_result, resume, 2, Val0(n), resumer,
+            failer, gen);
+         break;
+
+      case N_InvRec:
+         arg_life(n, err_conv ? 0L : 1L, 1L, 1, 2, Val0(n), resumer, failer,
+            gen);
+         break;
+
+      case N_Limit:
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree0(n), resumer, &failer1, &gen1);
+         Tree1(n)->lifetime = n;
+         liveness(Tree1(n), failer1 == NULL ? n : failer1, &failer2, &gen2);
+         *failer = failer2;
+         *gen = gen1 | gen2;
+         break;
+
+      case N_Loop: {
+         loop_info.prev = cur_loop;
+         loop_info.resumer = resumer;
+         loop_info.gen = 0;
+         loop_info.every_cntrl = 0;
+         loop_info.lifetime = n->lifetime;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+               /*
+                * The body is bounded. The control clause is resumed
+                *  by the control structure.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer2, &gen2);
+               loop_info.every_cntrl = 1;
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), n, &failer1, &gen1);
+               break;
+
+            case REPEAT:
+               /*
+                * The body is bounded.
+                */
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), NULL, &failer1, &gen1);
+               break;
+
+            case SUSPEND:
+               /*
+                * The body is bounded. The control clause is resumed
+                *  by the control structure.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer2, &gen2);
+               loop_info.every_cntrl = 1;
+               Tree1(n)->lifetime = n;
+               liveness(Tree1(n), n, &failer1, &gen1);
+               break;
+
+            case WHILE:
+            case UNTIL:
+               /*
+                * The body and the control clause are each bounded.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer1, &gen1);
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), NULL, &failer1, &gen1);
+               break;
+            }
+         *failer = (resumer == NULL ? n : resumer); /* assume a loop can fail */
+         *gen = cur_loop->gen;
+         cur_loop = cur_loop->prev;
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for next", NULL);
+            return;
+            }
+         if (cur_loop->every_cntrl)
+             *failer = n;
+         else
+             *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Not:
+         /*
+          * The expression is bounded.
+          */
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         *failer = (resumer == NULL ? n : resumer);
+         *gen = 0;
+         break;
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)  {
+            /*
+             * The expression is bounded.
+             */
+            Tree1(n)->lifetime = n;
+            liveness(Tree1(n), NULL, &failer1, &gen1);
+            }
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            asgn_impl = optab[asgn_loc].binary;
+            arg_life(n, asgn_impl->min_result, asgn_impl->max_result,
+               asgn_impl->resume, 1, 2, resumer, failer, gen);
+            }
+         else {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);  /* body */
+            Tree1(n)->lifetime = n;
+            liveness(Tree1(n), failer2, &failer1, &gen1);  /* subject */ 
+            *failer = failer1;
+            *gen = gen1 | gen2;
+            }
+         }
+         break;
+
+      case N_Sect:
+         /*
+          * Impl0(n) is sectioning.
+          */
+         min_result = Impl0(n)->min_result;
+         max_result = Impl0(n)->max_result;
+         resume = Impl0(n)->resume;
+         if (Impl1(n) != NULL) {
+            /*
+             * Impl1(n) is plus or minus.
+             */
+            min_result *= Impl1(n)->min_result;
+            max_result *= Impl1(n)->max_result;
+            resume |= Impl1(n)->resume;
+            }
+         arg_life(n, min_result, max_result, resume, 2, 3, resumer, failer,
+            gen);
+         break;
+
+      case N_Slist:
+         /*
+          * expr1 is not bounded, expr0 is bounded.
+          */
+         Tree1(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, failer, gen);
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         break;
+
+      case N_SmplAsgn:
+         Tree3(n)->lifetime = n;
+         liveness(Tree3(n), resumer, failer, gen);     /* 2nd operand */
+         Tree2(n)->lifetime = n->lifetime;             /* may be result of := */
+         liveness(Tree2(n), *failer, &failer1, &gen1); /* 1st operand */
+         break;
+
+      case N_SmplAug:
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         arg_life(n, Impl1(n)->min_result, Impl1(n)->max_result,
+            Impl1(n)->resume, 2, 2, resumer, failer, gen);
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * arg_life - compute the lifetimes of an argument list.
+ */
+static void arg_life(n, min_result, max_result, resume, frst_arg, nargs,
+   resumer, failer, gen)
+nodeptr n;
+long min_result;  /* minimum result sequence length */
+long max_result;  /* maximum result sequence length */
+int resume;	  /* flag - resumption possible after last result */
+int frst_arg;
+int nargs;
+nodeptr resumer;
+nodeptr *failer;
+int *gen;
+   {
+   nodeptr failer1;
+   nodeptr failer2;
+   nodeptr lifetime;
+   int inv_fail;    /* failure after operation in invoked */
+   int reuse;
+   int gen2;
+   int i;
+
+   /*
+    * Determine what, if anything, can resume the rightmost argument.
+    */
+   if (resumer == NULL && min_result == 0)
+      failer1 = n;
+   else
+      failer1 = resumer;
+   if (failer1 == NULL)
+      inv_fail = 0;
+   else
+      inv_fail = 1;
+
+   /*
+    * If the operation can be resumed, variables internal to the operation
+    *  have and extended lifetime.
+    */
+   if (resumer != NULL && (max_result > 1 || max_result == UnbndSeq || resume))
+      n->intrnl_lftm = resumer;
+   else
+      n->intrnl_lftm = n;
+
+   /*
+    * Go through the parameter list right to left, propagating resumption
+    *  information, computing lifetimes, and determining whether anything
+    *  can generate.
+    */
+   lifetime = n;
+   reuse = 0;
+   *gen = 0;
+   for (i = frst_arg + nargs - 1; i >= frst_arg; --i) {
+      n->n_field[i].n_ptr->lifetime = lifetime;
+      n->n_field[i].n_ptr->reuse = reuse;
+      liveness(n->n_field[i].n_ptr, failer1, &failer2, &gen2);
+      if (resumer != NULL && gen2)
+         lifetime = resumer;
+      if (inv_fail && gen2)
+         reuse = 1;
+      failer1 = failer2;
+      *gen |= gen2;
+      }
+   *failer = failer1;
+   if (max_result > 1 || max_result == UnbndSeq)
+      *gen = 1;
+   }
diff --git a/src/iconc/types.c b/src/iconc/types.c
new file mode 100644
index 0000000..cd3a3ef
--- /dev/null
+++ b/src/iconc/types.c
@@ -0,0 +1,893 @@
+/*
+ * typinfer.c - routines to perform type inference.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+#ifdef TypTrc
+#ifdef HighResTime
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif					/* HighResTime */
+#endif					/* TypTrc */
+
+extern unsigned int null_bit;   /* bit for null type */
+extern unsigned int str_bit;    /* bit for string type */
+extern unsigned int cset_bit;   /* bit for cset type */
+extern unsigned int int_bit;    /* bit for integer type */
+extern unsigned int real_bit;   /* bit for real type */
+extern unsigned int n_icntyp;   /* number of non-variable types */
+extern unsigned int n_intrtyp;  /* number of types in intermediate values */
+extern unsigned int val_mask;   /* mask for non-var types in last int of type*/
+extern struct typ_info *type_array;
+
+/*
+ * free_struct_typinfo - frees a struct typinfo structure by placing
+ *    it one a list of free structures
+ */
+#ifdef OptimizeType
+extern struct typinfo *start_typinfo;
+extern struct typinfo *high_typinfo;
+extern struct typinfo *low_typinfo;
+extern struct typinfo *free_typinfo;
+
+void free_struct_typinfo(struct typinfo *typ)  {
+
+   typ->bits = (unsigned int *)free_typinfo;
+   free_typinfo = typ;
+}
+#endif					/* OptimizeType */
+
+/*
+ * alloc_typ - allocate a compressed type structure and initializes
+ *    the members to zero or NULL.
+ */
+#ifdef OptimizeType
+struct typinfo *alloc_typ(n_types)
+#else					/* OptimizeType */
+unsigned int *alloc_typ(n_types)
+#endif					/* OptimizeType */
+int n_types;
+{
+#ifdef OptimizeType
+   struct typinfo *typ;
+   int i;
+   unsigned int init = 0;
+
+   if ((free_typinfo == NULL) && (high_typinfo == low_typinfo))  {
+      /*
+       * allocate a large block of memory used to parcel out struct typinfo
+       *   structures from
+       */
+      start_typinfo = (struct typinfo *)alloc(sizeof(struct typinfo) * TYPINFO_BLOCK);
+      high_typinfo = start_typinfo;
+      low_typinfo = start_typinfo + TYPINFO_BLOCK;
+      free_typinfo = NULL;
+      typ = start_typinfo;
+      high_typinfo++;
+   }
+   else if (free_typinfo != NULL) {
+      /*
+       * get a typinfo stucture from the list of free structures
+       */
+      typ = free_typinfo;
+      free_typinfo = (struct typinfo *)free_typinfo->bits;
+   }
+   else  {
+      /*
+       * get a typinfo structure from the chunk of memory allocated
+       *   previously
+       */
+      typ = high_typinfo;
+      high_typinfo++;
+   }
+   typ->packed = n_types;
+   if (!do_typinfer)
+      typ->bits = alloc_mem_typ(n_types);
+   else
+      typ->bits= NULL;
+   return typ;
+#else					/* OptimizeType */
+   int n_ints;
+   unsigned int *typ;
+   int i;
+   unsigned int init = 0;
+
+   n_ints = NumInts(n_types);
+   typ = (unsigned int *)alloc((unsigned int)((n_ints)*sizeof(unsigned int)));
+
+   /*
+    * Initialization: if we are doing inference, start out assuming no types.
+    *  If we are not doing inference, assume any type.
+    */
+   if (!do_typinfer)
+      init = ~init;
+   for (i = 0; i < n_ints; ++i)
+     typ[i] = init;
+   return typ;
+#endif					/* OptimizeType */
+}
+
+/*
+ * alloc_mem_typ - actually allocates a full sized bit vector.
+ */
+#ifdef OptimizeType
+unsigned int *alloc_mem_typ(n_types)
+unsigned int n_types;
+{
+   int n_ints;
+   unsigned int *typ;
+   int i;
+   unsigned int init = 0;
+
+   n_ints = NumInts(n_types);
+   typ = (unsigned int *)alloc((unsigned int)((n_ints)*sizeof(unsigned int)));
+   if (!do_typinfer)
+      init = ~init;
+   for(i=0; i < n_ints ;++i)
+      typ[i] = init;
+   return typ;
+}
+#endif					/* OptimizeType */
+
+/*
+ * set_typ - set a particular type bit in a type bit vector.
+ */
+void set_typ(type, bit)
+#ifdef OptimizeType
+struct typinfo *type;
+#else					/* OptimizeType */
+unsigned int *type;
+#endif					/* OptimizeType */
+unsigned int bit;
+{
+   unsigned int indx;
+   unsigned int mask;
+
+#ifdef OptimizeType
+   if (type->bits == NULL)  {
+      if (bit == null_bit)
+         type->packed |= NULL_T; 
+      else if (bit == real_bit)
+         type->packed |= REAL_T; 
+      else if (bit == int_bit)
+         type->packed |= INT_T; 
+      else if (bit == cset_bit)
+         type->packed |= CSET_T; 
+      else if (bit == str_bit)
+         type->packed |= STR_T; 
+      else {
+         /*
+          * if the bit to set is not one of the five builtin types
+          *   then allocate a whole bit vector, copy the packed
+          *   bits over, and set the requested bit
+          */
+         type->bits = alloc_mem_typ(DecodeSize(type->packed));
+         xfer_packed_types(type);
+         indx = bit / IntBits;
+         mask = 1;
+         mask <<= bit % IntBits;
+         type->bits[indx] |= mask;
+      }
+   }
+   else  {
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   type[indx] |= mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * clr_type - clear a particular type bit in a type bit vector.
+ */
+void clr_typ(type, bit)
+#ifdef OptimizeType
+struct typinfo *type;
+#else					/* OptimizeType */
+unsigned int *type;
+#endif					/* OptimizeType */
+unsigned int bit;
+{
+   unsigned int indx;
+   unsigned int mask;
+
+#ifdef OptimizeType
+   if (type->bits == NULL)  {
+      /*
+       * can only clear one of five builtin types
+       */
+      if (bit == null_bit)
+         type->packed &= ~NULL_T;
+      else if (bit == real_bit)
+         type->packed &= ~REAL_T;
+      else if (bit == int_bit)
+         type->packed &= ~INT_T;
+      else if (bit == cset_bit)
+         type->packed &= ~CSET_T;
+      else if (bit == str_bit)
+         type->packed &= ~STR_T;
+   }
+   else  {
+      /*
+       * build bit mask to clear requested type in full bit vector
+       */
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      type->bits[indx] &= ~mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   type[indx] &= ~mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * has_type - determine if a bit vector representing types has any bits
+ *  set that correspond to a specific type code from the data base.  Also,
+ *  if requested, clear any such bits.
+ */
+int has_type(typ, typcd, clear)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int typcd;
+int clear;
+{
+   int frst_bit, last_bit;
+   int i;
+   int found;
+
+   found = 0;
+   bitrange(typcd, &frst_bit, &last_bit);
+   for (i = frst_bit; i < last_bit; ++i) {
+      if (bitset(typ, i)) {
+         found = 1;
+         if (clear)
+            clr_typ(typ, i);
+         }
+      }
+   return found;
+}
+
+/*
+ * other_type - determine if a bit vector representing types has any bits
+ *  set that correspond to a type *other* than specific type code from the
+ *  data base.
+ */
+int other_type(typ, typcd)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int typcd;
+   {
+   int frst_bit, last_bit;
+   int i;
+
+   bitrange(typcd, &frst_bit, &last_bit);
+   for (i = 0; i < frst_bit; ++i)
+      if (bitset(typ, i))
+         return 1;
+   for (i = last_bit; i < n_intrtyp; ++i)
+      if (bitset(typ, i))
+         return 1;
+   return 0;
+   }
+
+/*
+ * bitrange - determine the range of bit positions in a type bit vector
+ *  that correspond to a type code from the data base.
+ */
+void bitrange(typcd, frst_bit, last_bit)
+int typcd;
+int *frst_bit;
+int *last_bit;
+   {
+   if (typcd == TypVar) {
+      /*
+       * All variable types.
+       */
+      *frst_bit = n_icntyp;
+      *last_bit = n_intrtyp;
+      }
+   else {
+      *frst_bit = type_array[typcd].frst_bit;
+      *last_bit = *frst_bit + type_array[typcd].num_bits;
+      }
+   }
+
+/*
+ * typcd_bits - set the bits of a bit vector corresponding to a type
+ *  code from the data base.
+ */
+void typcd_bits(typcd, typ)
+int typcd;
+struct type *typ;
+   {
+   int frst_bit;
+   int last_bit;
+   int i;
+
+   if (typcd == TypEmpty)
+      return;  /* Do nothing.  */
+
+   if (typcd == TypAny) {
+      /*
+       * Set bits corresponding to first-class types.
+       */
+#ifdef OptimizeType
+      /*
+       * allocate a full bit vector and copy over packed types first
+       */
+      if (typ->bits->bits == NULL)   {
+          typ->bits->bits = alloc_mem_typ(DecodeSize(typ->bits->packed));
+          xfer_packed_types(typ->bits);
+      }
+      for (i = 0; i < NumInts(n_icntyp) - 1; ++i)
+         typ->bits->bits[i] |= ~(unsigned int)0;
+      typ->bits->bits[i] |= val_mask;
+#else					/* OptimizeType */
+      for (i = 0; i < NumInts(n_icntyp) - 1; ++i)
+         typ->bits[i] |= ~(unsigned int)0;
+      typ->bits[i] |= val_mask;
+#endif					/* OptimizeType */
+      return;
+      }
+
+   bitrange(typcd, &frst_bit, &last_bit);
+#ifdef OptimizeType
+   if (last_bit > DecodeSize(typ->bits->packed)) /* bad abstract type computation */
+      return;
+#endif					/* OptimizeType */
+   for (i = frst_bit; i < last_bit; ++i)
+      set_typ(typ->bits, i);
+   }
+
+/*
+ * bitset - determine if a specific bit in a bit vector is set.
+ */
+int bitset(typ, bit)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int bit;
+{
+   int mask;
+   int indx;
+
+#ifdef OptimizeType
+   if (typ->bits == NULL)  {
+      /*
+       * check to see if the requested bit is set in the packed representation
+       *   if the requested bit is not one of the five builtins then the
+       *   lookup fails no matter what
+       */
+      if (bit == null_bit)
+         return (typ->packed & NULL_T);
+      else if (bit == real_bit)
+         return (typ->packed & REAL_T);
+      else if (bit == int_bit)
+         return (typ->packed & INT_T);
+      else if (bit == cset_bit)
+         return (typ->packed & CSET_T);
+      else if (bit == str_bit)
+         return (typ->packed & STR_T);
+      else 
+         return 0;
+   }
+   else  {
+      /*
+       * create a mask to check to see if the requested type bit is
+       *   set on
+       */
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      return typ->bits[indx] & mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   return typ[indx] & mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * is_empty - determine if a type bit vector is empty.
+ */
+int is_empty(typ)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+{
+   int i;
+
+#ifdef OptimizeType
+   if (typ->bits == NULL)  {
+      /*
+       * if any bits are set on then the vector is not empty
+       */
+      if (DecodePacked(typ->packed))
+         return 0;
+      else
+         return 1;
+   }
+   else  {
+      for (i = 0; i < NumInts(n_intrtyp); ++i) {
+          if (typ->bits[i] != 0)
+             return 0;
+          }
+      return 1;
+   }
+#else					/* OptimizeType */
+   for (i = 0; i < NumInts(n_intrtyp); ++i) {
+       if (typ[i] != 0)
+          return 0;
+       }
+   return 1;
+#endif					/* OptimizeType */
+}
+
+/*
+ * xfer_packed_types - transfers the packed type representation
+ *   to a full length bit vector representation in the same
+ *   struct typinfo structure.
+ */
+#ifdef OptimizeType
+void xfer_packed_types(type)
+struct typinfo *type;
+{
+   unsigned int indx, mask;
+
+   /*
+    * for each IF statement built a mask to set each of the five builtins
+    *   if they are present in the packed representation
+    */
+   if (type->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      mask = 1;
+      mask <<= null_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      mask = 1;
+      mask <<= real_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      mask = 1;
+      mask <<= int_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      mask = 1;
+      mask <<= cset_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      mask = 1;
+      mask <<= str_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+}
+
+/*
+ * xfer_packed_to_bits - sets those type bits from the src typinfo structure
+ *     to the dest typinfo structure AND the src is a packed representation
+ *     while the dest is a bit vector. Returns the number of new bits that
+ *     were set in the destination.
+ */
+int xfer_packed_to_bits(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, mask, old, rnsize;
+   int changes[5] = {-1,-1,-1,-1,-1};
+   int ix, membr = 0, i;
+
+   ix = 0;
+   rnsize = NumInts(nsize);
+   /*
+    * for each possible type set in the packed vector, create a mask
+    *   and apply it to the dest.  check to see if there was actually
+    *   a change in the dest vector.
+    */
+   if (src->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= null_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               /*
+                * checks to see if the bit just set happens to be in the
+                *   same word as any other of the five builtins. if they
+                *   are then we only want to count this as one change 
+                */
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= real_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= int_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= cset_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= str_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   return ix;
+}
+
+/*
+ * and_bits_to_packed - performs a bitwise AND of two typinfo structures
+ *    taking into account of packed or full bit representation.
+ */
+void and_bits_to_packed(src, dest, size)
+struct typinfo *src;
+struct typinfo *dest;
+int size;
+{
+   unsigned int indx, mask, val, destsz;
+   int  i;
+
+   if ((src->bits == NULL) && (dest->bits == NULL)) 
+      /* Both are packed */
+      dest->packed &= (0xFF000000 | src->packed);
+   else if ((src->bits == NULL) && (dest->bits != NULL))  {
+      /*
+       * built a bit mask for each type in the src and AND it too
+       *  the bit vector in dest
+       */
+      for (i=0; i < NumInts(size) ;i++) {
+         val = get_bit_vector(src,i);
+         dest->bits[i] &= val; 
+      }
+   }
+   else if ((src->bits != NULL) && (dest->bits == NULL))  {
+      /*
+       * because an AND is being performed only those bits in the dest
+       *  have the possibility of remaining set (i.e. five builtins)
+       *  therefore if the bit is set in the packed check to see if 
+       *  it is also set in the full vector, if so then set it in the
+       *  resulting vector, otherwise don't
+       */
+      destsz = DecodeSize(dest->packed);
+      mask = 1; val = 0;
+      if (dest->packed & NULL_T) { 
+         mask <<= (null_bit % IntBits);
+         if (src->bits[(null_bit/IntBits)] & mask)
+            val |= NULL_T;
+      }
+      mask = 1;
+      if (dest->packed & REAL_T) { 
+         mask <<= (real_bit % IntBits);
+         if (src->bits[(real_bit/IntBits)] & mask)
+            val |= REAL_T;
+      }
+      mask = 1;
+      if (dest->packed & INT_T) {
+         mask <<= (int_bit % IntBits);
+         if (src->bits[(int_bit/IntBits)] & mask)
+            val |= INT_T;
+      }
+      mask = 1;
+      if (dest->packed & CSET_T) {
+         mask <<= (cset_bit % IntBits);
+         if (src->bits[(cset_bit/IntBits)] & mask)
+            val |= CSET_T;
+      }
+      mask = 1;
+      if (dest->packed & STR_T) { 
+         mask <<= (str_bit % IntBits);
+         if (src->bits[(str_bit/IntBits)] & mask)
+            val |= STR_T;
+      }
+      dest->packed = val | destsz;
+   }
+   else
+      for (i=0; i < NumInts(size) ;i++)
+         dest->bits[i] &= src->bits[i];
+}
+
+
+/*
+ * get_bit_vector - returns a bit mask from the selected word of a bit
+ *    vector.  e.g. if pos == 2, then check to see if any of the five
+ *    builtins fall in the second word of a normal bit vector, if so
+ *    create a bit mask with those types that fall in that word.
+ */
+
+unsigned int get_bit_vector(src, pos)
+struct typinfo *src;
+int pos;
+{
+   unsigned int val = 0, mask;
+
+   val = 0;
+   if ((src->packed & NULL_T) && ((null_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= null_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & REAL_T) && ((real_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= real_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & INT_T) && ((int_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= int_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & CSET_T) && ((cset_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= cset_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & STR_T) && ((str_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= str_bit % IntBits;
+      val |= mask; 
+   }
+   return val;
+}
+
+
+/*
+ * clr_packed - clears all bits within the nsize-th word for a packed
+ *     representation.
+ */
+
+void clr_packed(src, nsize)
+struct typinfo *src;
+int nsize;
+{
+   unsigned int rnsize;
+
+   rnsize = NumInts(nsize);
+   if ((null_bit / IntBits) < rnsize)
+      src->packed &= ~NULL_T;
+   if ((real_bit / IntBits) < rnsize)
+      src->packed &= ~REAL_T;
+   if ((int_bit / IntBits) < rnsize)
+      src->packed &= ~INT_T;
+   if ((cset_bit / IntBits) < rnsize)
+      src->packed &= ~CSET_T;
+   if ((str_bit / IntBits) < rnsize)
+      src->packed &= ~STR_T;
+}
+
+/*
+ * cpy_packed_to_packed - copies the packed bits from one bit vector
+ *     to another.
+ */
+
+void cpy_packed_to_packed(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, rnsize;
+
+   rnsize = NumInts(nsize);
+   /*
+    * for each of the possible builtin types, check to see if the bit is
+    *  set in the src and if present set it in the dest.
+    */
+   dest->packed = DecodeSize(dest->packed);
+   if (src->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= NULL_T; 
+   }
+   if (src->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= REAL_T; 
+   }
+   if (src->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= INT_T; 
+   }
+   if (src->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= CSET_T; 
+   }
+   if (src->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= STR_T; 
+   }
+}
+
+
+/*
+ * mrg_packed_to_packed - merges the packed type bits of a src and dest
+ *     bit vector.
+ */
+int mrg_packed_to_packed(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, rnsize;
+   int changes[5] = {-1,-1,-1,-1,-1};
+   int ix = 0, membr = 0, i;
+
+   rnsize = NumInts(nsize);
+   /*
+    * for each of the five possible types in the src, check to see if it
+    *  is set in the src and not set in the dest.  if so then set it in
+    *  the dest vector.
+    */
+   if ((src->packed & NULL_T) && !(dest->packed & NULL_T))  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize) {
+         dest->packed |= NULL_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & REAL_T) && !(dest->packed & REAL_T))  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= REAL_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & INT_T) && !(dest->packed & INT_T)){
+      indx = int_bit / IntBits;
+      if (indx < rnsize) {
+         dest->packed |= INT_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & CSET_T) && !(dest->packed & CSET_T))  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= CSET_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & STR_T) && !(dest->packed & STR_T))  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= STR_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   return ix;
+}
+#endif					/* OptimizeType */
diff --git a/src/iconc/typinfer.c b/src/iconc/typinfer.c
new file mode 100644
index 0000000..8a96e23
--- /dev/null
+++ b/src/iconc/typinfer.c
@@ -0,0 +1,5189 @@
+/*
+ * typinfer.c - routines to perform type inference.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+#ifdef TypTrc
+#ifdef HighResTime
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif					/* HighResTime */
+#endif					/* TypTrc */
+
+/*
+ * Information about co-expressions is keep on a list.
+ */
+struct t_coexpr {
+   nodeptr n;               /* code for co-expression */
+   int typ_indx;            /* relative type number (index) */
+   struct store *in_store;  /* store entry into co-expression via activation */
+   struct store *out_store; /* store at end of co-expression */
+#ifdef OptimizeType
+   struct typinfo *act_typ;   /* types passed via co-expression activation */
+   struct typinfo *rslt_typ;  /* types resulting from "co-expression return" */
+#else					/* OptimizeType */
+   unsigned int *act_typ;   /* types passed via co-expression activation */
+   unsigned int *rslt_typ;  /* types resulting from "co-expression return" */
+#endif					/* OptimizeType */
+   int iteration;
+   struct t_coexpr *next;
+   };
+
+struct t_coexpr *coexp_lst;
+
+#ifdef TypTrc
+extern int typealloc;		/* flag to account for allocation */
+extern long typespace;		/* amount of space for type inference */
+#endif					/* TypTrc */
+
+struct symtyps *cur_symtyps; /* maps run-time routine symbols to types */
+
+/*
+ * argtyps is the an array of types large enough to accommodate the argument
+ *  list of any operation.
+ */
+struct argtyps {
+   struct argtyps *next;
+#ifdef OptimizeType
+   struct typinfo *types[1];  /* actual size is max_prm */
+#else					/* OptimizeType */
+   unsigned int *types[1];  /* actual size is max_prm */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * prototypes for static functions.
+ */
+#ifdef OptimizeType
+void         and_bits_to_packed (struct typinfo *src, 
+                                     struct typinfo *dest, int size);
+struct typinfo *alloc_typ   (int n_types);
+unsigned int   *alloc_mem_typ   (unsigned int n_types);
+int             bitset      (struct typinfo *typ, int bit);
+void         clr_typ     (struct typinfo *type, unsigned int bit);
+void         clr_packed   (struct typinfo *src, int nsize);
+void         cpy_packed_to_packed (struct typinfo *src,
+				     struct typinfo *dest, int nsize);
+static void         deref_lcl   (struct typinfo *src,
+                                     struct typinfo *dest);
+static int             findloops   ( struct node *n, int resume,
+                                     struct typinfo *rslt_type);
+static void         gen_inv     (struct typinfo *prc_typ, nodeptr n);
+int             has_type    (struct typinfo *typ, int typcd, int clear);
+static void         infer_impl  (struct implement *impl,
+                                     nodeptr n, struct symtyps *symtyps,
+                                     struct typinfo *rslt_typ);
+int             is_empty    (struct typinfo *typ);
+int             mrg_packed_to_packed (struct typinfo *src,
+				     struct typinfo *dest, int nsize);
+int             other_type  (struct typinfo *typ, int typcd);
+static void         set_ret     (struct typinfo *typ);
+void         set_typ     (struct typinfo *type, unsigned int bit);
+void         typcd_bits  (int typcd, struct type *typ);
+static void         typ_deref   (struct typinfo *src,
+                                     struct typinfo *dest, int chk);
+int             xfer_packed_to_bits (struct typinfo *src,
+                                     struct typinfo *dest, int nsize);
+#else					/* OptimizeType */
+unsigned int   *alloc_typ   (int n_types);
+int             bitset      (unsigned int *typ, int bit);
+void         clr_typ     (unsigned int *type, unsigned int bit);
+static void         deref_lcl   (unsigned int *src, unsigned int *dest);
+static int             findloops   ( struct node *n, int resume,
+                                     unsigned int *rslt_type);
+static void         gen_inv     (unsigned int *prc_typ, nodeptr n);
+int             has_type    (unsigned int *typ, int typcd, int clear);
+static void         infer_impl  (struct implement *impl,
+                                     nodeptr n, struct symtyps *symtyps,
+                                     unsigned int *rslt_typ);
+int             is_empty    (unsigned int *typ);
+int             other_type  (unsigned int *typ, int typcd);
+static void         set_ret     (unsigned int *typ);
+void         set_typ     (unsigned int *type, unsigned int bit);
+void         typcd_bits  (int typcd, struct type *typ);
+static void         typ_deref (unsigned int *src, unsigned int *dest, int chk);
+#endif					/* OptimizeType */
+
+static void         abstr_new   (struct node *n, struct il_code *il);
+static void         abstr_typ   (struct il_code *il, struct type *typ);
+static struct store   *alloc_stor  (int stor_sz, int n_types);
+static void         chk_succ    (int ret_flag, struct store *susp_stor);
+static struct store   *cpy_store   (struct store *source);
+static int             eval_cond   (struct il_code *il);
+static void         free_argtyp (struct argtyps *argtyps);
+static void         free_store  (struct store *store);
+static void         free_wktyp  (struct type *typ);
+static void         find_new    (struct node *n);
+static struct argtyps *get_argtyp  (void);
+static struct store   *get_store   (int clear);
+static struct type    *get_wktyp   (void);
+static void         infer_act   (nodeptr n);
+static void         infer_con   (struct rentry *rec, nodeptr n);
+static int             infer_il    (struct il_code *il);
+static void         infer_nd    (nodeptr n);
+static void         infer_prc   (struct pentry *proc, nodeptr n);
+static void         mrg_act     (struct t_coexpr *coexp,
+                                     struct store *e_store,
+                                     struct type *rslt_typ);
+static void         mrg_store   (struct store *source, struct store *dest);
+static void         side_effect (struct il_code *il);
+static struct symtyps *symtyps     (int nsyms);
+
+#ifdef TypTrc
+static void         prt_d_typ   (FILE *file, struct typinfo *typ);
+static void         prt_typ     (FILE *file, struct typinfo *typ);
+#endif					/* TypTrc */
+
+#define CanFail   1
+
+/*
+ * cur_coexp is non-null while performing type inference on code from a
+ *  create expression. If it is null, the possible current co-expressions
+ *  must be found from cur_proc.
+ */
+struct t_coexpr *cur_coexp = NULL;
+
+struct gentry **proc_map;    /* map procedure types to symbol table entries */
+struct rentry **rec_map;     /* map record types to record information */
+struct t_coexpr **coexp_map; /* map co-expression types to information */
+
+struct typ_info *type_array;
+
+static int num_new;   /* number of types supporting "new" abstract type comp */
+
+/*
+ * Data base component codes are mapped to type inferencing information 
+ *  using an array.
+ */
+struct compnt_info {
+   int frst_bit;        /* first bit in bit vector allocated to component */
+   int num_bits;        /* number of bits allocated to this component */
+   struct store *store; /* maps component "reference" to the type it holds */ 
+   };
+static struct compnt_info *compnt_array;
+
+static unsigned int frst_fld;   /* bit number of 1st record field */
+static unsigned int n_fld;      /* number of record fields */
+static unsigned int frst_gbl;   /* bit number of 1st global reference type */
+static unsigned int n_gbl;      /* number of global variables */
+static unsigned int n_nmgbl;    /* number of named global variables */
+static unsigned int frst_loc;   /* bit number of 1st local reference type */
+static unsigned int n_loc;      /* maximum number of locals in any procedure */
+
+static unsigned int nxt_bit;    /* next unassigned bit in bit vector */
+unsigned int n_icntyp;   /* number of non-variable types */
+unsigned int n_intrtyp;  /* number of types in intermediate values */
+static unsigned int n_rttyp;    /* number of types in runtime computations */
+unsigned int val_mask;   /* mask for non-var types in last int of type */
+
+unsigned int null_bit;   /* bit for null type */
+unsigned int str_bit;    /* bit for string type */
+unsigned int cset_bit;   /* bit for cset type */
+unsigned int int_bit;    /* bit for integer type */
+unsigned int real_bit;   /* bit for real type */
+
+static struct store *fld_stor;   /* record fields */
+
+static int *cur_new;      /* allocated types for current operation */
+
+static struct store *succ_store = NULL; /* current success store */
+static struct store *fail_store = NULL; /* current failure store */
+
+static struct store *dummy_stor;
+static struct store *store_pool = NULL; /* free list of store structs */
+
+static struct type *type_pool = NULL;          /* free list of type structs */
+static struct type cur_rslt = {0, NULL, NULL}; /* result type of operation */
+
+static struct argtyps *argtyp_pool = NULL; /* free list of arg type arrays */
+static struct argtyps *arg_typs = NULL;    /* current arg type array */
+
+static int num_args; /* number of arguments for current operation */
+static int n_vararg; /* size of variable part of arg list to run-time routine */
+
+#ifdef OptimizeType
+static struct typinfo *any_typ; /* type bit vector with all bits on */
+struct typinfo *free_typinfo = NULL;
+struct typinfo *start_typinfo = NULL;
+struct typinfo *high_typinfo = NULL;
+struct typinfo *low_typinfo = NULL;
+#else					/* OptimizeType */
+static unsigned int *any_typ; /* type bit vector with all bits on */
+#endif					/* OptimizeType */
+
+long changed;  /* number of changes to type information in this iteration */
+int iteration; /* iteration number for type inferencing */
+
+#ifdef TypTrc
+static FILE *trcfile = NULL;	/* output file pointer for tracing */
+static char *trcname = NULL;	/* output file name for tracing */
+static char *trc_indent = "";
+#endif					/* TypTrc */
+
+
+/*
+ * typeinfer - infer types of operands. If "do_typinfer" is set, actually
+ *   do abstract interpretation, otherwise assume any type for all operands.
+ */
+void typeinfer()
+   {
+   struct gentry *gptr;
+   struct lentry *lptr;
+   nodeptr call_main;
+   struct pentry *p;
+   struct rentry *rec;
+   struct t_coexpr *coexp;
+   struct store *init_store;
+   struct store *f_store;
+#ifdef OptimizeType
+   struct typinfo *type;
+#else					/* OptimizeType */
+   unsigned int *type;
+#endif					/* OptimizeType */
+   struct implement *ip;
+   struct lentry **lhash;
+   struct lentry **vartypmap;
+   int i, j, k;
+   int size;
+   int flag;
+
+#ifdef TypTrc
+   /*
+    * Set up for type tracing.
+    */
+   long start_infer, end_infer;
+
+#ifdef HighResTime
+   struct rusage rusage;
+
+   getrusage(RUSAGE_SELF, &rusage);
+   start_infer = rusage.ru_utime.tv_sec*1000 + rusage.ru_utime.tv_usec/1000;
+#else					/* HighResTime */
+   start_infer = millisec();
+#endif					/* HighResTime */
+
+   typealloc = 1;		/* note allocation in this phase */
+
+   trcname = getenv("TYPTRC");
+
+   if (trcname != NULL && strlen(trcname) != 0) {
+
+      if (trcname[0] == '|') {
+         FILE *popen();
+
+         trcfile = popen(trcname+1, "w");
+         }
+      else
+
+      trcfile = fopen(trcname, "w");
+
+      if (trcfile == NULL) {
+         fprintf(stderr, "TYPTRC: cannot open %s\n", trcname);
+         fflush(stderr);
+         exit(EXIT_FAILURE);
+         }
+      }
+#endif					/* TypTrc */
+
+   /*
+    * Make sure max_prm is large enough for any run-time routine.
+    */
+   for (i = 0; i < IHSize; ++i)
+      for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+         if (ip->nargs > max_prm)
+           max_prm = ip->nargs;
+   for (i = 0; i < IHSize; ++i)
+      for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+         if (ip->nargs > max_prm)
+           max_prm = ip->nargs;
+
+   /*
+    * Allocate an arrays to map data base type codes and component codes 
+    *  to type inferencing information.
+    */
+   type_array = (struct typ_info *)alloc((unsigned int)(num_typs *
+      sizeof(struct typ_info)));
+   compnt_array = (struct compnt_info *)alloc((unsigned int)(num_cmpnts *
+      sizeof(struct compnt_info)));
+
+   /*
+    * Find those types that support the "new" abstract type computation
+    *  assign to them locations in the arrays of allocated types associated
+    *  with operation invocations. Also initialize the number of type bits.
+    *  Types with no subtypes have one bit. Types allocated with the the "new"
+    *  abstract have a default sub-type that is allocated here. Procedures
+    *  have a subtype to for string invocable operators. Co-expressions
+    *  have a subtype for &main. Records are handled below.
+    */
+   num_new = 0;
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].support_new)
+         type_array[i].new_indx = num_new++;
+      type_array[i].num_bits = 1;   /* reserve one type bit */
+      }
+   type_array[list_typ].num_bits = 2;  /* default & list for arg to main() */
+
+   cur_coexp = NewStruct(t_coexpr);
+   cur_coexp->n = NULL;
+   cur_coexp->next = NULL;
+   coexp_lst = cur_coexp;
+
+   if (do_typinfer) {
+      /*
+       * Go through the  syntax tree for each procedure locating program
+       *  points that may create structures at run time. Allocate the
+       *  appropriate structure type(s) to each such point.
+       */
+      for (p = proc_lst; p != NULL; p = p->next) {
+         if (p->nargs < 0)
+            p->arg_lst = type_array[list_typ].num_bits++; /* list for varargs */
+         find_new(Tree1(p->tree));  /* initial clause */
+         find_new(Tree2(p->tree));  /* body of procedure */
+         }
+      }
+
+   /*
+    * Allocate a type number for each record type (use record number for
+    *  offset) and a variable type number for each field.
+    */
+   n_fld = 0;
+   if (rec_lst == NULL) {
+      type_array[rec_typ].num_bits = 0;
+      rec_map = NULL;
+      }
+   else {
+      type_array[rec_typ].num_bits = rec_lst->rec_num + 1;
+      rec_map = (struct rentry **)alloc(
+         (unsigned int)((rec_lst->rec_num + 1)*sizeof(struct rentry *)));
+      for (rec = rec_lst; rec != NULL; rec = rec->next) {
+         rec->frst_fld = n_fld;
+         n_fld += rec->nfields;
+         rec_map[rec->rec_num] = rec;
+         }
+      }
+
+   /*
+    * Allocate type numbers to global variables. Don't count those procedure
+    *  variables that are no longer referenced in the syntax tree. Do count
+    *  static variables. Also allocate types to procedures, built-in functions,
+    *  record constructors.
+    */
+   n_gbl = 0; 
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (flag & F_SmplInv)
+            gptr->index = -1;   /* unused: set to something not a valid type */
+         else {
+            gptr->index = n_gbl++;
+            if (flag & (F_Proc | F_Record | F_Builtin))
+               gptr->init_type = type_array[proc_typ].num_bits++;
+            }
+         if (flag & F_Proc) {
+            for (lptr = gptr->val.proc->statics; lptr != NULL;lptr = lptr->next)
+               lptr->val.index = n_gbl++;
+            }
+         }
+   n_nmgbl = n_gbl;
+
+   /*
+    * Determine relative bit numbers for predefined variable types that
+    *  are treated as sets of global variables.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfGlbl)
+         type_array[i].frst_bit = n_gbl++; /* converted to absolute later */
+
+   proc_map = (struct gentry **)alloc(
+      (unsigned int)((type_array[proc_typ].num_bits)*sizeof(struct gentry *)));
+   proc_map[0] = NULL; /* proc type for string invocable operators */
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (!(flag & F_SmplInv) && (flag & (F_Proc | F_Record | F_Builtin)))
+            proc_map[gptr->init_type] = gptr;
+         }
+
+   /*
+    * Allocate type numbers to local variables. The same numbers are reused
+    *  in different procedures.
+    */
+   n_loc = 0;
+   for (p = proc_lst; p != NULL; p = p->next) {
+      i = Abs(p->nargs);
+      for (lptr = p->args; lptr != NULL; lptr = lptr->next)
+         lptr->val.index = --i;
+      i = Abs(p->nargs);
+      for (lptr = p->dynams; lptr != NULL; lptr = lptr->next)
+         lptr->val.index = i++;
+      n_loc = Max(n_loc, i);
+
+      /*
+       * produce a mapping from the variable types used in this procedure
+       *  to the corresponding symbol table entries.
+       */
+      if (n_gbl + n_loc == 0)
+         vartypmap = NULL;
+      else
+         vartypmap = (struct lentry **)alloc(
+            (unsigned int)((n_gbl + n_loc)*sizeof(struct lentry *)));
+      for (i = 0; i < n_gbl + n_loc; ++i)
+          vartypmap[i] = NULL; /* no entries for foreign statics */
+      p->vartypmap = vartypmap;
+      lhash = p->lhash;
+      for (i = 0; i < LHSize; ++i) {
+         for (lptr = lhash[i]; lptr != NULL; lptr = lptr->blink) {
+            switch (lptr->flag) {
+               case F_Global:
+                  gptr = lptr->val.global;
+                  if (!(gptr->flag & F_SmplInv))
+                     vartypmap[gptr->index] = lptr;
+                  break;
+               case F_Static:
+                  vartypmap[lptr->val.index] = lptr;
+                  break;
+               case F_Dynamic:
+               case F_Argument:
+                  vartypmap[n_gbl + lptr->val.index] = lptr;
+                  }
+            }
+         }
+      }
+
+   /*
+    * There is a component reference subtype for every subtype of the
+    *  associated aggregate type.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      compnt_array[i].num_bits = type_array[typecompnt[i].aggregate].num_bits;
+
+   /*
+    * Assign bits for non-variable (first-class) types.
+    */
+   nxt_bit = 0;
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfNone) {
+         type_array[i].frst_bit = nxt_bit;
+         nxt_bit += type_array[i].num_bits;
+         }
+
+   n_icntyp = nxt_bit; /* number of first-class types */
+
+   /*
+    * Load some commonly needed bit numbers into global variable.
+    */
+   null_bit = type_array[null_typ].frst_bit;
+   str_bit = type_array[str_typ].frst_bit;
+   cset_bit = type_array[cset_typ].frst_bit;
+   int_bit = type_array[int_typ].frst_bit;
+   real_bit = type_array[real_typ].frst_bit;
+
+   /*
+    * Assign bits for predefined variable types that are not treated as
+    *   sets of globals.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfCnst || icontypes[i].deref == DrfSpcl) {
+         type_array[i].frst_bit = nxt_bit;
+         nxt_bit += type_array[i].num_bits;
+         }
+
+   /*
+    * Assign bits to aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      if (typecompnt[i].var) {
+         compnt_array[i].frst_bit = nxt_bit;
+         nxt_bit += compnt_array[i].num_bits;
+         }
+
+   /*
+    * Assign bits to record fields and named variables.
+    */
+   frst_fld = nxt_bit;
+   nxt_bit += n_fld;
+   frst_gbl = nxt_bit;
+   nxt_bit += n_gbl;
+   frst_loc = nxt_bit;
+   nxt_bit += n_loc;
+
+   /*
+    * Convert from relative to ablsolute bit numbers for predefined variable
+    *  types that are treated as sets of global variables.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfGlbl)
+         type_array[i].frst_bit += frst_gbl;
+
+   n_intrtyp = nxt_bit; /* number of types for intermediate values */
+
+   /*
+    * Assign bits to aggregate compontents that are not variables. These
+    *  are the runtime system's internal descriptor reference types.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      if (!typecompnt[i].var) {
+         compnt_array[i].frst_bit = nxt_bit;
+         nxt_bit += compnt_array[i].num_bits;
+         }
+
+   n_rttyp = nxt_bit; /* total size of type system */
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      /*
+       * Output a summary of the type system.
+       */
+      for (i = 0; i < num_typs; ++i) {
+         fprintf(trcfile, "%s", icontypes[i].id);
+         if (strcmp(icontypes[i].id, icontypes[i].abrv) != 0)
+            fprintf(trcfile, "(%s)", icontypes[i].abrv);
+         fprintf(trcfile, " sub-types: %d\n", type_array[i].num_bits);
+         }
+      }
+#endif					/* TypTrc */
+
+   /*
+    * The division between bits for first-class types and variables types
+    *  generally occurs in the middle of a word. Set up a mask for extracting
+    *  the first-class types from this word.
+    */
+   val_mask = 0;
+   i = n_icntyp - (NumInts(n_icntyp) - 1) * IntBits;
+   while (i--)
+      val_mask = (val_mask << 1) | 1;
+
+   if (do_typinfer) {
+      /*
+       * Create stores large enough for the component references. These
+       *  are global to the entire program, rather than being propagated
+       *  from node to node in the syntax tree.
+       */
+      for (i = 0; i < num_cmpnts; ++i) {
+         if (i == str_var)
+            size = n_intrtyp;
+         else
+            size = n_icntyp;
+         compnt_array[i].store = alloc_stor(compnt_array[i].num_bits, size);
+         }
+      fld_stor = alloc_stor(n_fld, n_icntyp);
+
+      dummy_stor = get_store(0);
+
+      /*
+       * First list is arg to main: a list of strings.
+       */
+      set_typ(compnt_array[lst_elem].store->types[1], str_typ);
+      }
+
+   /*
+    * Set up a type bit vector with all bits on.
+    */
+#ifdef OptimizeType
+   any_typ = alloc_typ(n_rttyp);
+   any_typ->bits = alloc_mem_typ(DecodeSize(any_typ->packed));
+   for (i = 0; i < NumInts(n_rttyp); ++i)
+      any_typ->bits[i] = ~(unsigned int)0;
+#else					/* OptimizeType */
+   any_typ = alloc_typ(n_rttyp);
+   for (i = 0; i < NumInts(n_rttyp); ++i)
+      any_typ[i] = ~(unsigned int)0;
+#endif					/* OptimizeType */
+
+   /*
+    *  Initialize stores and return values for procedures. Also initialize
+    *   flag indicating whether the procedure can be executed.
+    */
+   call_main = NULL;
+   for (p = proc_lst; p != NULL; p = p->next) {
+      if (do_typinfer) {
+         p->iteration = 0;
+         p->ret_typ = alloc_typ(n_intrtyp);
+         p->coexprs = alloc_typ(n_icntyp);
+         p->in_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (p->ret_flag & DoesSusp)
+            p->susp_store = alloc_stor(n_gbl, n_icntyp);
+         else
+            p->susp_store = NULL;
+         for (i = Abs(p->nargs); i < n_loc; ++i)
+            set_typ(p->in_store->types[n_gbl + i], null_bit);
+         if (p->nargs < 0)
+            set_typ(p->in_store->types[n_gbl + Abs(p->nargs) - 1],
+               type_array[list_typ].frst_bit + p->arg_lst);
+         if (strcmp(p->name, "main") == 0) {
+            /*
+             * create a the initial call to main with one list argument.
+             */
+            call_main = invk_main(p);
+            call_main->type = alloc_typ(n_intrtyp);
+            Tree2(call_main)->type = alloc_typ(n_intrtyp);
+            set_typ(Tree2(call_main)->type, type_array[list_typ].frst_bit + 1);
+            call_main->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            }
+         p->out_store = alloc_stor(n_gbl, n_icntyp);
+         p->reachable = 0;
+         }
+      else
+         p->reachable = 1;
+      /*
+       * Analyze the code of the procedure to determine where to place stores
+       *  that survive iterations of type inferencing. Note, both the initial
+       *  clause and the body of the procedure are bounded.
+       */
+      findloops(Tree1(p->tree), 0, NULL);
+      findloops(Tree2(p->tree), 0, NULL);
+      }
+
+   /*
+    * If type inferencing is suppressed, we have set up very conservative
+    *   type information and will do no inferencing.
+    */
+   if (!do_typinfer)
+      return;
+
+   if (call_main == NULL)
+      return;         /* no main procedure, cannot continue */
+   if (tfatals > 0)
+      return;         /* don't do inference if there are fatal errors */
+
+   /*
+    * Construct mapping from co-expression types to information
+    *  about the co-expressions and finish initializing the information.
+    */
+   i = type_array[coexp_typ].num_bits;
+   coexp_map = (struct t_coexpr **)alloc(
+      (unsigned int)(i * sizeof(struct t_coexpr *)));
+   for (coexp = coexp_lst; coexp != NULL; coexp = coexp->next) {
+       coexp_map[--i] = coexp;
+       coexp->typ_indx = i;
+       coexp->in_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+       coexp->out_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+       coexp->act_typ = alloc_typ(n_intrtyp);
+       coexp->rslt_typ = alloc_typ(n_intrtyp);
+       coexp->iteration = 0;
+       }
+
+   /*
+    * initialize globals
+    */
+   init_store = get_store(1);
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (!(flag & F_SmplInv)) {
+            type = init_store->types[gptr->index];
+            if (flag & (F_Proc | F_Record | F_Builtin))
+               set_typ(type, type_array[proc_typ].frst_bit + gptr->init_type);
+            else
+               set_typ(type, null_bit);
+            }
+         }
+
+   /*
+    * Initialize types for predefined variable types.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      type = NULL;
+      switch (icontypes[i].deref) {
+         case DrfGlbl:
+            /*
+             * Treated as a global variable.
+             */
+            type = init_store->types[type_array[i].frst_bit - frst_gbl];
+            break;
+         case DrfCnst:
+            /*
+             * Type doesn't change so keep one copy.
+             */
+            type = alloc_typ(n_intrtyp);
+            type_array[i].typ = type;
+            break;
+         }
+      if (type != NULL) {
+          /*
+           * Determine which types are in the initial type for this variable.
+           */
+          for (j = 0; j < num_typs; ++j) {
+             if (icontypes[i].typ[j] != '.') {
+                for (k = 0; k < type_array[j].num_bits; ++k)
+                   set_typ(type, type_array[j].frst_bit + k);
+                }
+             }
+          }
+      }
+
+   f_store = get_store(1);
+
+   /*
+    * Type inferencing iterates over the program until a fixed point is
+    *  reached.
+    */
+   changed = 1L;    /* force first iteration */
+   iteration = 0;
+   if (verbose > 1)
+      fprintf(stderr, "type inferencing: ");
+
+   while (changed > 0L) {
+     changed = 0L;
+     ++iteration;
+
+#ifdef TypTrc
+     if (trcfile != NULL)
+        fprintf(trcfile, "**** iteration %d ****\n", iteration);
+#endif					/* TypTrc */
+
+     /*
+      * Start at the implicit initial call to the main procedure. Inferencing
+      *  walks the call graph from here.
+      */
+     succ_store = cpy_store(init_store);
+     fail_store = f_store;
+     infer_nd(call_main);
+
+     /*
+      * If requested, monitor the progress of inferencing.
+      */
+     switch (verbose) {
+        case 0:
+        case 1:
+           break;
+        case 2:
+           fprintf(stderr, ".");
+           break;
+        default: /* > 2 */
+           if (iteration != 1)
+              fprintf(stderr, ", ");
+           fprintf(stderr, "%ld", changed);
+        }
+     }
+
+   /*
+    * Type inferencing is finished, complete any diagnostic output.
+    */
+   if (verbose > 1)
+      fprintf(stderr, "\n");
+
+#ifdef TypTrc
+     if (trcfile != NULL) {
+
+#ifdef HighResTime
+        getrusage(RUSAGE_SELF, &rusage);
+        end_infer = rusage.ru_utime.tv_sec*1000 + rusage.ru_utime.tv_usec/1000;
+#else					/* HighResTime */
+        end_infer = millisec();
+#endif					/* HighResTime */
+        fprintf(trcfile, "\n**** inferencing time: %ld milliseconds\n", 
+           end_infer - start_infer);
+        fprintf(trcfile, "\n**** inferencing space: %ld bytes\n",typespace);
+        fclose(trcfile);
+        }
+   typealloc = 0;
+#endif					/* TypTrc */
+   }
+
+/*
+ * find_new - walk the syntax tree allocating structure types where
+ *  operations create new structures.
+ */
+static void find_new(n)
+struct node *n;
+   {
+   struct t_coexpr *coexp;
+   struct node *cases;
+   struct node *clause;
+   int nargs;
+   int i;
+
+   n->new_types = NULL;
+   switch (n->n_type) {
+      case N_Cset:
+      case N_Empty:
+      case N_Id:
+      case N_Int:
+      case N_Next:
+      case N_Real:
+      case N_Str:
+         break;
+
+      case N_Bar:
+      case N_Break:
+      case N_Field:
+      case N_Not:
+         find_new(Tree0(n));
+         break;
+
+      case N_Alt:
+      case N_Apply:
+      case N_Limit:
+      case N_Slist:
+         find_new(Tree0(n));
+         find_new(Tree1(n));
+         break;
+
+      case N_Activat:
+         find_new(Tree1(n));
+         find_new(Tree2(n));
+         break;
+
+      case N_If:
+         find_new(Tree0(n));  /* control clause */
+         find_new(Tree1(n));  /* then clause */
+         find_new(Tree2(n));  /* else clause, may be N_Empty */
+         break;
+
+      case N_Create:
+         /*
+          * Allocate a sub-type for the co-expressions created here.
+          */
+         n->new_types = (int *)alloc((unsigned int)(sizeof(int)));
+         n->new_types[0] = type_array[coexp_typ].num_bits++;
+         coexp = NewStruct(t_coexpr);
+         coexp->n = Tree0(n);
+         coexp->next = coexp_lst;
+         coexp_lst = coexp;
+         find_new(Tree0(n));
+         break;
+
+      case N_Augop:
+         abstr_new(n, Impl0(n)->in_line);  /* assignment */
+         abstr_new(n, Impl1(n)->in_line);  /* the operation */
+         find_new(Tree2(n));              /* 1st operand */
+         find_new(Tree3(n));              /* 2nd operand */
+         break;
+
+      case N_Case:
+         find_new(Tree0(n));  /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            find_new(Tree0(clause));   /* value of clause */
+            find_new(Tree1(clause));   /* body of clause */
+            }
+         if (Tree2(n) != NULL)
+            find_new(Tree2(n));  /* deflt */
+         break;
+
+      case N_Invok:
+         nargs = Val0(n);                  /* number of arguments */
+         find_new(Tree1(n));               /* thing being invoked */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_InvOp:
+         /*
+          * This is a call to an operation, this is what we must
+          *  check for "new" abstract type computation.
+          */
+         nargs = Val0(n);                    /* number of arguments */
+         abstr_new(n, Impl1(n)->in_line);     /* operation */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_InvProc:
+      case N_InvRec:
+         nargs = Val0(n);                    /* number of arguments */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_Loop:
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+            case WHILE:
+            case UNTIL:
+               find_new(Tree1(n));   /* control clause */
+               find_new(Tree2(n));   /* do clause - may be N_Empty*/
+               break;
+
+            case REPEAT:
+               find_new(Tree1(n));   /* clause */
+               break;
+            }
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)
+            find_new(Tree1(n));    /* value - may be N_Empty */
+         break;
+
+      case N_Scan:
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK)
+            abstr_new(n, optab[asgn_loc].binary->in_line);
+         find_new(Tree1(n));   /* subject */ 
+         find_new(Tree2(n));   /* body */
+         break;
+
+      case N_Sect:
+         abstr_new(n, Impl0(n)->in_line);     /* sectioning */
+         if (Impl1(n) != NULL)
+            abstr_new(n, Impl1(n)->in_line);  /* plus, minus, or nothing */
+         find_new(Tree2(n));                 /* 1st operand */
+         find_new(Tree3(n));                 /* 2nd operand */
+         find_new(Tree4(n));                 /* 3rd operand */
+         break;
+
+      case N_SmplAsgn:
+      case N_SmplAug:
+         find_new(Tree3(n));
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * abstr_new - find the abstract clauses in the implementation of an operation.
+ *  If they indicate that the operations creates structures, allocate a
+ *  type for the structures and associate it with the node in the syntax tree.
+ */
+static void abstr_new(n, il)
+struct node *n;
+struct il_code *il;
+   {
+   int i;
+   int num_cases, indx;
+   struct typ_info *t_info;
+
+   if (il == NULL)
+      return;
+
+   switch (il->il_type) {
+      case IL_New:
+         /*
+          * We have found a "new" construct in an abstract type computation.
+          *  Make sure an array has been created to hold the types allocated
+          *  to this call, then allocate the indicated type if one has not
+          *  already been allocated.
+          */
+         if (n->new_types == NULL) {
+            n->new_types = (int *)alloc((unsigned int)(num_new * sizeof(int)));
+            for (i = 0; i < num_new; ++i)
+               n->new_types[i] = -1;
+            }
+         t_info = &type_array[il->u[0].n];     /* index by type code */
+         if (n->new_types[t_info->new_indx] < 0) {
+             n->new_types[t_info->new_indx] = t_info->num_bits++;
+#ifdef TypTrc
+             if (trcfile != NULL)
+                fprintf(trcfile, "%s (%d,%d) %s\n", n->n_file, n->n_line,
+                   n->n_col, icontypes[il->u[0].n].id);
+#endif					/* TypTrc */
+             }
+         i = il->u[1].n;            /* num args */
+         indx = 2;
+         while (i--)
+            abstr_new(n, il->u[indx++].fld);
+         break;
+
+      case IL_If1:
+         abstr_new(n, il->u[1].fld);
+         break;
+
+      case IL_If2:
+         abstr_new(n, il->u[1].fld);
+         abstr_new(n, il->u[2].fld);
+         break;
+
+      case IL_Tcase1:
+         num_cases = il->u[1].n;
+         indx = 2;
+         for (i = 0; i < num_cases; ++i) {
+            indx += 2;                        /* skip type info */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         break;
+
+      case IL_Tcase2:
+         num_cases = il->u[1].n;
+         indx = 2;
+         for (i = 0; i < num_cases; ++i) {
+            indx += 2;                        /* skip type info */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         abstr_new(n, il->u[indx].fld);       /* default */
+         break;
+
+      case IL_Lcase:
+         num_cases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < num_cases; ++i) {
+            ++indx;		              /* skip selection num */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         abstr_new(n, il->u[indx].fld);       /* default */
+         break;
+
+      case IL_Acase:
+         abstr_new(n, il->u[2].fld);          /* C_integer action */
+         if (largeints) 
+            abstr_new(n, il->u[3].fld);       /* integer action */
+         abstr_new(n, il->u[4].fld);          /* C_double action */
+         break;
+
+      case IL_Abstr:
+      case IL_Inter:
+      case IL_Lst:
+      case IL_TpAsgn:
+      case IL_Union:
+         abstr_new(n, il->u[0].fld);
+         abstr_new(n, il->u[1].fld);
+         break;
+
+      case IL_Compnt:
+      case IL_Store:
+      case IL_VarTyp:
+         abstr_new(n, il->u[0].fld);
+         break;
+
+      case IL_Block:
+      case IL_Call:
+      case IL_Const:  /* should have been replaced by literal node */
+      case IL_Err1:
+      case IL_Err2:
+      case IL_IcnTyp:
+      case IL_Subscr:
+      case IL_Var:
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * alloc_stor - allocate a store with empty types.
+ */
+static struct store *alloc_stor(stor_sz, n_types)
+int stor_sz;
+int n_types;
+   {
+   struct store *stor;
+   int i;
+
+   /*
+    * If type inferencing is disabled, we don't actually make use of
+    *  any stores, but the initialization code asks for them anyway.
+    */
+   if (!do_typinfer)
+      return NULL;
+
+#ifdef OptimizeType
+   stor = (struct store *)alloc((unsigned int)(sizeof(struct store) +
+      ((stor_sz - 1) * sizeof(struct typinfo *))));
+   stor->next = NULL;
+   stor->perm = 1;
+   for (i = 0; i < stor_sz; ++i) {
+      stor->types[i] = (struct typinfo *)alloc_typ(n_types);
+      }
+#else					/* OptimizeType */
+   stor = (struct store *)alloc((unsigned int)(sizeof(struct store) +
+      ((stor_sz - 1) * sizeof(unsigned int *))));
+   stor->next = NULL;
+   stor->perm = 1;
+   for (i = 0; i < stor_sz; ++i) {
+      stor->types[i] = (unsigned int *)alloc_typ(n_types);
+      }
+#endif					/* OptimizeType */
+
+   return stor;
+   }
+
+/*
+ * findloops - find both explicit loops and implicit loops caused by
+ *  goal-directed evaluation. Allocate stores for them. Determine which
+ *  expressions cannot fail (used to eliminate dynamic store allocation
+ *  for some bounded expressions). Allocate stores for 'if' and 'case'
+ *  expressions that can be resumed. Initialize expression types.
+ *  The syntax tree is walked in reverse execution order looking for
+ *  failure and for generators.
+ */
+static int findloops(n, resume, rslt_type)
+struct node *n;
+int resume;
+#ifdef OptimizeType
+struct typinfo *rslt_type;
+#else					/* OptimizeType */
+unsigned int *rslt_type;
+#endif					/* OptimizeType */
+   {
+   struct loop {
+      int resume;
+      int can_fail;
+      int every_cntrl;
+#ifdef OptimizeType
+      struct typinfo *type;
+#else					/* OptimizeType */
+      unsigned int *type;
+#endif					/* OptimizeType */
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop = NULL;
+   struct node *cases;
+   struct node *clause;
+   int can_fail;
+   int nargs, i;
+
+   n->store = NULL;
+   if (!do_typinfer)
+      rslt_type = any_typ;
+
+   switch (n->n_type) {
+      case N_Activat:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+         /*
+          * Assume activation can fail.
+          */
+         can_fail = findloops(Tree2(n), 1, NULL);
+         can_fail = findloops(Tree1(n), can_fail, NULL);
+         n->symtyps = symtyps(2);
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGAT)
+            n->symtyps->next = symtyps(2);
+         break;
+
+      case N_Alt:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = findloops(Tree0(n), resume, rslt_type) |
+            findloops(Tree1(n), resume, rslt_type);
+         break;
+
+      case N_Apply:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         /* 
+          * Assume operation can suspend or fail.
+          */
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = findloops(Tree1(n), 1, NULL);
+         can_fail = findloops(Tree0(n), can_fail, NULL);
+         n->symtyps = symtyps(max_sym);
+         break;
+
+      case N_Augop:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+         can_fail = resume;
+         /*
+          * Impl0(n) is assignment.
+          */
+         if (resume && Impl0(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl0(n)->ret_flag))
+            can_fail = 1;
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         if (can_fail && Impl1(n)->ret_flag & DoesSusp && n->store == NULL)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         can_fail = findloops(Tree3(n), can_fail, NULL);  /* operand 2 */
+         can_fail = findloops(Tree2(n), can_fail, NULL);  /* operand 1 */
+         n->type = Tree2(n)->type;
+         Typ4(n) = alloc_typ(n_intrtyp);
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         n->symtyps->next = symtyps(n_arg_sym(Impl0(n)));
+         break;
+
+      case N_Bar:
+         can_fail = findloops(Tree0(n), resume, rslt_type);
+         n->type = Tree0(n)->type;
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         break;
+
+      case N_Break:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for break", NULL);
+            return 0;
+            }
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         loop_sav->can_fail |= findloops(Tree0(n), loop_sav->resume,
+            loop_sav->type);
+         cur_loop = loop_sav;
+         can_fail = 0;
+         break;
+
+      case N_Case:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+
+         /*
+          * control clause is bounded
+          */
+         can_fail = findloops(Tree0(n), 0, NULL);
+
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             * The expression being compared can be resumed.
+             */
+            findloops(Tree0(clause), 1, NULL);
+
+            /*
+             *  Body.
+             */
+            can_fail |= findloops(Tree1(clause), resume, rslt_type);
+            }
+
+         if (Tree2(n) == NULL)
+            can_fail = 1;
+         else
+            can_fail |= findloops(Tree2(n), resume, rslt_type);  /* default */
+         break;
+
+      case N_Create:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         findloops(Tree0(n), 1, NULL);                  /* co-expression code */
+        /*
+         * precompute type
+         */
+        i= type_array[coexp_typ].frst_bit;
+        if (do_typinfer)
+            i += n->new_types[0];
+         set_typ(n->type, i);
+         can_fail = resume;
+         break;
+
+      case N_Cset:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, type_array[cset_typ].frst_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Empty:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, null_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Id: {
+         struct lentry *var;
+
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         /*
+          * Precompute type
+          */
+         var = LSym0(n);
+         if (var->flag & F_Global)
+            set_typ(n->type, frst_gbl + var->val.global->index);
+         else if (var->flag & F_Static)
+            set_typ(n->type, frst_gbl + var->val.index);
+         else
+            set_typ(n->type, frst_loc + var->val.index);
+         can_fail = resume;
+         }
+         break;
+
+      case N_Field:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = findloops(Tree0(n), resume, NULL);
+         n->symtyps = symtyps(1);
+         break;
+
+      case N_If:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+         /*
+          * control clause is bounded
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = findloops(Tree1(n), resume, rslt_type);
+         if (Tree2(n)->n_type == N_Empty)
+            can_fail = 1;
+         else {
+            if (resume)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            can_fail |= findloops(Tree2(n), resume, rslt_type);
+            }
+         break;
+
+      case N_Int:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, int_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Invok:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                    /* number of arguments */
+         /*
+          * Assume operation can suspend and fail.
+          */
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = 1;
+         for (i = nargs; i >= 0; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         n->symtyps = symtyps(max_sym);
+         break;
+
+      case N_InvOp:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                           /* number of arguments */
+         if (resume && Impl1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         break;
+
+      case N_InvProc:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);             /* number of arguments */
+         if (resume && Proc1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (Proc1(n)->ret_flag & DoesFail)
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         break;
+
+      case N_InvRec:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                               /* number of args */
+         if (err_conv)
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         break;
+
+      case N_Limit:
+         findloops(Tree0(n), resume, rslt_type);
+         can_fail = findloops(Tree1(n), 1, NULL);
+         n->type = Tree0(n)->type;
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         n->symtyps = symtyps(1);
+         break;
+
+      case N_Loop: {
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         loop_info.prev = cur_loop;
+         loop_info.resume = resume;
+         loop_info.can_fail = 0;
+         loop_info.every_cntrl = 0;
+         loop_info.type = n->type;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+               /*
+                * The control clause can be resumed. The body is bounded.
+                */
+               loop_info.every_cntrl = 1;
+               can_fail = findloops(Tree1(n), 1, NULL);
+               loop_info.every_cntrl = 0;
+               findloops(Tree2(n), 0, NULL);
+               break;
+
+            case REPEAT:
+               /*
+                * The loop needs a saved store. The body is bounded.
+                */
+               findloops(Tree1(n), 0, NULL);
+               can_fail = 0;
+               break;
+
+            case WHILE:
+               /*
+                * The loop needs a saved store. The control
+                *  clause and the body are each bounded.
+                */
+               can_fail = findloops(Tree1(n), 0, NULL);
+               findloops(Tree2(n), 0, NULL);
+               break;
+
+            case UNTIL:
+               /*
+                * The loop needs a saved store. The control
+                *  clause and the body are each bounded.
+                */
+               findloops(Tree1(n), 0, NULL);
+               findloops(Tree2(n), 0, NULL);
+               can_fail = 1;
+               break;
+            }
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (do_typinfer && resume)
+            n->store->next = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail |= cur_loop->can_fail;
+         cur_loop = cur_loop->prev;
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for next", NULL);
+            return 1;
+            }
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = cur_loop->every_cntrl;
+         break;
+
+      case N_Not:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, null_bit); /* precompute type */
+         /*
+          * The expression is bounded.
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = 1;
+         break;
+
+      case N_Real:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, real_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Ret:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         if (Val0(Tree0(n)) == RETURN)  {
+            /*
+             * The expression is bounded.
+             */
+            findloops(Tree1(n), 0, NULL);
+            }
+         can_fail = 0;
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         n->symtyps = symtyps(1);
+         can_fail = resume;
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            asgn_impl = optab[asgn_loc].binary;
+            if (resume && asgn_impl->ret_flag & DoesSusp)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            if (MightFail(asgn_impl->ret_flag))
+               can_fail = 1;
+            n->symtyps->next = symtyps(n_arg_sym(asgn_impl));
+            }
+         can_fail = findloops(Tree2(n), can_fail, NULL);  /* body */
+         can_fail = findloops(Tree1(n), can_fail, NULL);  /* subject */ 
+         }
+         break;
+
+      case N_Sect:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = resume;
+         /*
+          * Impl0(n) is sectioning.
+          */
+         if (resume && Impl0(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl0(n)->ret_flag))
+            can_fail = 1;
+         n->symtyps = symtyps(n_arg_sym(Impl0(n)));
+         if (Impl1(n) != NULL) {
+            /*
+             * Impl1(n) is plus or minus
+             */
+            if (can_fail && Impl1(n)->ret_flag & DoesSusp && n->store == NULL)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            if (MightFail(Impl1(n)->ret_flag))
+               can_fail = 1;
+            n->symtyps->next = symtyps(n_arg_sym(Impl1(n)));
+            }
+         can_fail = findloops(Tree4(n), can_fail, NULL); /* operand 3 */
+         can_fail = findloops(Tree3(n), can_fail, NULL); /* operand 2 */
+         can_fail = findloops(Tree2(n), can_fail, NULL); /* operand 1 */
+         break;
+
+      case N_Slist:
+         /*
+          * 1st expression is bounded.
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = findloops(Tree1(n), resume, rslt_type);
+         n->type = Tree1(n)->type;
+         break;
+
+      case N_SmplAsgn:
+         can_fail = findloops(Tree3(n), resume, NULL);  /* 2nd operand */
+         findloops(Tree2(n), can_fail, rslt_type);      /* variable */
+         n->type = Tree2(n)->type;
+         break;
+
+      case N_SmplAug:
+         can_fail = resume;
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         if (resume && Impl1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         can_fail = findloops(Tree3(n), can_fail, NULL); /* 2nd operand */
+         findloops(Tree2(n), can_fail, rslt_type);       /* variable */
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         n->type = Tree2(n)->type;
+         Typ4(n) = alloc_typ(n_intrtyp);
+         break;
+
+      case N_Str:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, str_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   if (can_fail)
+      n->flag = CanFail;
+   else
+      n->flag = 0;
+   return can_fail;
+   }
+
+/*
+ * symtyps - determine the number of entries needed for a symbol table
+ *  that maps argument indexes to types for an operation in the
+ *  data base. Allocate the symbol table.
+ */
+static struct symtyps *symtyps(nsyms)
+int nsyms;
+   {
+   struct symtyps *tab;
+
+   if (nsyms == 0)
+      return NULL;
+
+#ifdef OptimizeType
+   tab = (struct symtyps *)alloc((unsigned int)(sizeof(struct symtyps) +
+      (nsyms - 1) * sizeof(struct typinfo *)));
+#else					/* OptimizeType */
+   tab = (struct symtyps *)alloc((unsigned int)(sizeof(struct symtyps) +
+      (nsyms - 1) * sizeof(int *)));
+#endif					/* OptimizeType */
+   tab->nsyms = nsyms;
+   tab->next = NULL;
+   while (nsyms)
+      tab->types[--nsyms] = alloc_typ(n_intrtyp);
+   return tab;
+   }
+
+/*
+ * infer_proc - perform type inference on a call to an Icon procedure.
+ */
+static void infer_prc(proc, n)
+struct pentry *proc;
+nodeptr n;
+   {
+   struct store *s_store;
+   struct store *f_store;
+   struct store *store;
+   struct pentry *sv_proc;
+   struct t_coexpr *sv_coexp;
+   struct lentry *lptr;
+   nodeptr n1;
+   int i;
+   int nparams;
+   int coexp_bit;
+
+   /*
+    * Determine what co-expressions the procedure might be called from.
+    */
+   if (cur_coexp == NULL)
+      ChkMrgTyp(n_icntyp, cur_proc->coexprs, proc->coexprs)
+   else {
+      coexp_bit = type_array[coexp_typ].frst_bit + cur_coexp->typ_indx;
+      if (!bitset(proc->coexprs, coexp_bit)) {
+         ++changed;
+         set_typ(proc->coexprs, coexp_bit);
+         }
+      }
+
+   proc->reachable = 1; /* this procedure can be called */
+
+   /*
+    * If this procedure can suspend, there may be backtracking paths
+    *  to this invocation. If so, propagate types of globals from the
+    *  backtracking paths to the suspends of the procedure and propagate
+    *  types of locals to the success store of the call.
+    */
+   if (proc->ret_flag & DoesSusp && n->store != NULL) {
+      for (i = 0; i < n_gbl; ++i)
+         ChkMrgTyp(n_icntyp, n->store->types[i], proc->susp_store->types[i])
+      for (i = 0; i < n_loc; ++i)
+         MrgTyp(n_icntyp, n->store->types[n_gbl + i], succ_store->types[n_gbl +
+            i])
+      }
+
+   /*
+    * Merge the types of global variables into the "in store" of the
+    *  procedure. Because the body of the procedure may already have
+    *  been processed for this pass, the "changed" flag must be set if
+    *  there is a change of type in the store. This will insure that
+    *  there will be another iteration in which to propagate the change
+    *  into the body.
+    */
+   store = proc->in_store;
+   for (i = 0; i < n_gbl; ++i)
+      ChkMrgTyp(n_icntyp, succ_store->types[i], store->types[i])
+
+#ifdef TypTrc
+   /*
+    * Trace the call.
+    */
+   if (trcfile != NULL)
+      fprintf(trcfile, "%s (%d,%d) %s%s(", n->n_file, n->n_line, n->n_col,
+         trc_indent, proc->name);
+#endif					/* TypTrc */
+
+   /*
+    * Get the types of the arguments, starting with the non-varargs part.
+    */
+   nparams = proc->nargs;               /* number of parameters */
+   if (nparams < 0)
+      nparams = -nparams - 1;
+   for (i = 0; i < num_args && i < nparams; ++i) {
+      typ_deref(arg_typs->types[i], store->types[n_gbl + i], 1);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         /*
+          * Trace the argument type to the call.
+          */
+         if (i > 0)
+            fprintf(trcfile, ", ");
+         prt_d_typ(trcfile, arg_typs->types[i]);
+         }
+#endif					/* TypTrc */
+
+      }
+
+   /*
+    * Get the type of the varargs part of the argument list.
+    */
+   if (proc->nargs < 0)
+      while (i < num_args) {
+         typ_deref(arg_typs->types[i],
+            compnt_array[lst_elem].store->types[proc->arg_lst], 1);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            /*
+             * Trace the argument type to the call.
+             */
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_d_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++i;
+         }
+
+   /*
+    * Missing arguments have the null type.
+    */
+   while (i < nparams) {
+      set_typ(store->types[n_gbl + i], null_bit);
+      ++i;
+      }
+
+#ifdef TypTrc
+   if (trcfile != NULL)
+      fprintf(trcfile, ")\n");
+   {
+      char *trc_ind_sav = trc_indent;
+      trc_indent = "";  /* staring a new procedure, don't indent tracing */
+#endif					/* TypTrc */
+
+   /*
+    * only perform type inference on the body of a procedure
+    *  once per iteration
+    */
+   if (proc->iteration < iteration) {
+      proc->iteration = iteration;
+      s_store = succ_store;
+      f_store = fail_store;
+      sv_proc = cur_proc;
+      succ_store = cpy_store(proc->in_store);
+      cur_proc = proc;
+      sv_coexp = cur_coexp;
+      cur_coexp = NULL;     /* we are not in a create expression */
+      /*
+       * Perform type inference on the initial clause. Static variables
+       *  are initialized to null on this path.
+       */
+      for (lptr = proc->statics; lptr != NULL; lptr = lptr->next)
+         set_typ(succ_store->types[lptr->val.index], null_bit);
+      n1 = Tree1(proc->tree);
+      if (n1->flag & CanFail) {
+         /*
+          * The initial clause can fail. Because it is bounded, we need
+          *  a new failure store that we can merge into the success store
+          *  at the end of the clause.
+          */
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(n1);
+         mrg_store(store, succ_store);
+         free_store(store);
+         }
+      else
+         infer_nd(n1);
+      /*
+       * Perform type inference on the body of procedure. Execution may
+       *  pass directly to it without executing initial clause.
+       */
+      mrg_store(proc->in_store, succ_store);
+      n1 = Tree2(proc->tree);
+      if (n1->flag & CanFail) {
+         /*
+          * The body can fail. Because it is bounded, we need a new failure
+          *  store that we can merge into the success store at the end of
+          *  the procedure.
+          */
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(n1);
+         mrg_store(store, succ_store);
+         free_store(store);
+         }
+      else
+         infer_nd(n1);
+      set_ret(NULL);  /* implicit fail */
+      free_store(succ_store);
+      succ_store = s_store;
+      fail_store = f_store;
+      cur_proc = sv_proc;
+      cur_coexp = sv_coexp;
+      }
+
+#ifdef TypTrc
+      trc_indent = trc_ind_sav;
+   }
+#endif					/* TypTrc */
+
+   /*
+    * Get updated types for global variables at the end of the call.
+    */
+   store = proc->out_store;
+   for (i = 0; i < n_gbl; ++i)
+      CpyTyp(n_icntyp, store->types[i], succ_store->types[i]);
+
+   /*
+    * If the procedure can fail, merge variable types into the failure
+    *  store.
+    */
+   if (proc->ret_flag & DoesFail)
+      mrg_store(succ_store, fail_store);
+
+   /*
+    * The return type of the procedure is the result type of the call.
+    */
+   MrgTyp(n_intrtyp, proc->ret_typ, n->type);
+   }
+
+/*
+ * cpy_store - make a copy of a store.
+ */
+static struct store *cpy_store(source)
+struct store *source;
+   {
+   struct store *dest;
+   int stor_sz;
+   int i;
+
+   if (source == NULL) 
+      dest = get_store(1);
+   else {
+      stor_sz = n_gbl + n_loc;
+      dest = get_store(0);
+      for (i = 0; i < stor_sz; ++i)
+         CpyTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   return dest;
+   }
+
+/*
+ * mrg_store - merge the source store into the destination store.
+ */
+static void mrg_store(source, dest)
+struct store *source;
+struct store *dest;
+   {
+   int i;
+
+   if (source == NULL)
+      return;
+
+   /*
+    * Is this store included in the state that must be checked for a fixed
+    *  point?
+    */
+   if (dest->perm) {
+      for (i = 0; i < n_gbl + n_loc; ++i)
+         ChkMrgTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   else {
+      for (i = 0; i < n_gbl + n_loc; ++i)
+         MrgTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   }
+
+/*
+ * set_ret - Save return type and the store for global variables.
+ */
+static void set_ret(typ)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+   {
+   int i;
+
+   /*
+    * Merge the return type into the type of the procedure, dereferencing
+    *  locals in the process.
+    */
+   if (typ != NULL)
+      deref_lcl(typ, cur_proc->ret_typ);
+
+   /*
+    * Update the types that variables may have upon exit of the procedure.
+    */
+   for (i = 0; i < n_gbl; ++i)
+      MrgTyp(n_icntyp, succ_store->types[i], cur_proc->out_store->types[i]);
+   }
+
+/*
+ * deref_lcl - dereference local variable sub-types.
+ */
+static void deref_lcl(src, dest)
+#ifdef OptimizeType
+struct typinfo *src;
+struct typinfo *dest;
+#else					/* OptimizeType */
+unsigned int *src;
+unsigned int *dest;
+#endif					/* OptimizeType */
+   {
+   int i, j;
+   int ref_gbl;
+   int frst_stv;
+   int num_stv;
+   struct store *stv_stor;
+   struct type *wktyp;
+
+   /*
+    * Make a copy of the type to be dereferenced.
+    */
+   wktyp = get_wktyp();
+   CpyTyp(n_intrtyp, src, wktyp->bits);
+
+   /*
+    * Determine which variable types must be dereferenced.  Merge the
+    *  dereferenced type into the return type and delete the variable
+    *  type. Start with simple local variables.
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(wktyp->bits, frst_loc + i)) {
+         MrgTyp(n_icntyp, succ_store->types[n_gbl + i], wktyp->bits)
+         clr_typ(wktyp->bits, frst_loc + i);
+         }
+
+   /*
+    * Check for substring trapped variables. If a sub-string trapped
+    *  variable references a local, add "string" to the return type.
+    *  If a sub-string trapped variable references a global, leave the
+    *  trapped variable in the return type.
+    * It is theoretically possible for a sub-string trapped variable type to
+    *  reference both a local and a global. When the trapped variable type
+    *  is returned to the calling procedure, the local is re-interpreted
+    *  as a local of that procedure. This is a "valid" overestimate of
+    *  of the semantics of the return. Because this is unlikely to occur
+    *  in real programs, the overestimate is of no practical consequence.
+    */
+   num_stv = type_array[stv_typ].num_bits;
+   frst_stv = type_array[stv_typ].frst_bit;
+   stv_stor = compnt_array[str_var].store;
+   for (i = 0; i < num_stv; ++i) {
+      if (bitset(wktyp->bits, frst_stv + i)) {
+         /*
+          * We have found substring trapped variable i, see whether it
+          *  references locals or globals. Globals include structure
+          *  element references.
+          */
+         for (j = 0; j < n_loc; ++j)
+            if (bitset(stv_stor->types[i], frst_loc + j)) {
+               set_typ(wktyp->bits, str_bit);
+               break;
+               }
+         ref_gbl = 0;
+         for (j = n_icntyp; j < frst_loc; ++j)
+            if (bitset(stv_stor->types[i], j)) {
+               ref_gbl = 1;
+               break;
+               }
+         /*
+          * Keep the trapped variable only if it references globals.
+          */
+         if (!ref_gbl)
+            clr_typ(wktyp->bits, frst_stv + i);
+         }
+      }
+
+   /*
+    * Merge the types into the destination.
+    */
+   MrgTyp(n_intrtyp, wktyp->bits, dest);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      prt_typ(trcfile, wktyp->bits);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+
+   free_wktyp(wktyp);
+   }
+
+/*
+ * get_store - get a store large enough to hold globals and locals.
+ */
+static struct store *get_store(clear)
+int clear;
+   {
+   struct store *store;
+   int store_sz;
+   int i;
+
+   /*
+    * Warning, stores for all procedures must be the same size. In some
+    *  situations involving sub-string trapped variables (for example
+    *  when using the "default" trapped variable) a referenced local variable
+    *  type may be interpreted in a procedure to which it does not belong.
+    *  This represents an impossible execution and type inference may
+    *  "legally" produce any results for this part of the abstract
+    *  interpretation. As long as the store is large enough to include any
+    *  such "impossible" variables, type inference will do something legal.
+    *  Note that n_loc is the maximum number of locals in any procedure,
+    *  so store_sz is large enough.
+    */
+   store_sz = n_gbl + n_loc;
+   if ((store = store_pool) == NULL) {
+     store = alloc_stor(store_sz, n_icntyp);
+     store->perm = 0;
+     }
+   else {
+      store_pool = store_pool->next;
+      /*
+       * See if the variables in the store should be initialized to the
+       *  empty type.
+       */
+      if (clear)
+         for (i = 0; i < store_sz; ++i)
+            ClrTyp(n_icntyp, store->types[i]);
+      }
+   return store;
+   }
+
+static void free_store(store)
+struct store *store;
+   {
+   store->next = store_pool;
+   store_pool = store;
+   }
+
+/*
+ * infer_nd - perform type inference on a subtree of the syntax tree.
+ */
+static void infer_nd(n)
+nodeptr n;
+   {
+   struct node *cases;
+   struct node *clause;
+   struct store *s_store;
+   struct store *f_store;
+   struct store *store;
+   struct loop {
+      struct store *succ_store;
+      struct store *fail_store;
+      struct store *next_store;
+      struct store *susp_store;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop;
+   struct argtyps *sav_argtyp;
+   int sav_nargs;
+   struct type *wktyp;
+   int i;
+
+   switch (n->n_type) {
+      case N_Activat:
+         infer_act(n);
+         break;
+
+      case N_Alt:
+         f_store = fail_store;
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(Tree0(n));              /* 1st alternative */
+
+         /*
+          * "Correct" type inferencing of alternation has a performance
+          *  problem. Propagating stores through nested alternation
+          *  requires as many iterations as the depth of the nesting.
+          *  This is solved by adding two edges to the flow graph. These
+          *  represent impossible execution paths but this does not
+          *  affect the soundness of type inferencing and, in "real"
+          *  programs, does not affect the preciseness of its inference.
+          *  One edge is directly from the 1st alternative to the 2nd.
+          *  The other is a backtracking edge immediately back into
+          *  the alternation from the 1st alternative.
+          */
+         mrg_store(succ_store, store); /* imaginary edge to 2nd alternative */
+
+         if (n->store != NULL) {
+            mrg_store(succ_store, n->store); /* imaginary backtracking edge */
+            mrg_store(n->store, fail_store);
+            }
+         s_store = succ_store;
+         succ_store = store;
+         fail_store = f_store;
+         infer_nd(Tree1(n));              /* 2nd alternative */
+         mrg_store(s_store, succ_store);
+         free_store(s_store);
+         if (n->store != NULL)
+            mrg_store(n->store, fail_store);
+         fail_store = n->store;
+#ifdef TypTrc
+         MrgTyp(n_intrtyp, Tree0(n)->type, n->type);
+         MrgTyp(n_intrtyp, Tree1(n)->type, n->type);
+#else					/* TypTrc */
+         /*
+          * Type is computed by sub-expressions directly into n->type.
+          */
+#endif					/* TypTrc */
+         break;
+
+      case N_Apply: {
+         struct type *lst_types;
+         int frst_lst;
+         int num_lst;
+         struct store *lstel_stor;
+
+         infer_nd(Tree0(n));          /* thing being invoked */
+         infer_nd(Tree1(n));          /* list */
+
+         frst_lst = type_array[list_typ].frst_bit;
+         num_lst = type_array[list_typ].num_bits;
+         lstel_stor = compnt_array[lst_elem].store;
+
+         /*
+          * All that is available is a "summary" of the types of the
+          *  elements of the list. Each argument to the invocation
+          *  could be any type in the summary. Set up a maximum length
+          *  argument list.
+          */
+         lst_types = get_wktyp();
+         typ_deref(Tree1(n)->type, lst_types->bits, 0);
+         wktyp = get_wktyp();
+         for (i = 0; i < num_lst; ++i)
+            if (bitset(lst_types->bits, frst_lst + i))
+               MrgTyp(n_icntyp, lstel_stor->types[i], wktyp->bits);
+         bitset(wktyp->bits, null_bit); /* arg list extension might be done */
+
+         sav_nargs = num_args;
+         sav_argtyp = arg_typs;
+         num_args = max_prm;
+         arg_typs = get_argtyp();
+         for (i = 0; i < max_prm; ++i)
+            arg_typs->types[i] = wktyp->bits;
+         gen_inv(Tree0(n)->type, n);   /* inference on general invocation */
+
+         free_wktyp(wktyp);
+         free_wktyp(lst_types);
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         }
+         break;
+
+      case N_Augop:
+         infer_nd(Tree2(n));   /* 1st operand */
+         infer_nd(Tree3(n));   /* 2nd operand */
+         /*
+          * Perform type inference on the operation.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = 2;
+         arg_typs->types[0] = Tree2(n)->type;
+         arg_typs->types[1] = Tree3(n)->type;
+         infer_impl(Impl1(n), n, n->symtyps, Typ4(n));
+         chk_succ(Impl1(n)->ret_flag, n->store);
+         /*
+          * Perform type inference on the assignment.
+          */
+         arg_typs->types[1] = Typ4(n);
+         infer_impl(Impl0(n), n, n->symtyps->next, n->type);
+         chk_succ(Impl0(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Bar:
+         /*
+          * This operation intercepts failure and has an associated
+          *  resumption store.  If backtracking reaches this operation
+          *  execution may either continue backward or proceed forward
+          *  again.
+          */ 
+         mrg_store(n->store, fail_store);
+         mrg_store(n->store, succ_store);
+         fail_store = n->store;
+         infer_nd(Tree0(n));
+         /*
+          * Type is computed by operand.
+          */
+        break;
+
+      case N_Break:
+         /*
+          * The success and failure stores for the operand of break are
+          *  those associated with the enclosing loop.
+          */
+         fail_store = cur_loop->fail_store;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         infer_nd(Tree0(n));
+         cur_loop = loop_sav;
+         mrg_store(succ_store, cur_loop->succ_store);
+         if (cur_loop->susp_store != NULL)
+            mrg_store(cur_loop->susp_store, fail_store);
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Result of break is empty type. Result type of expression
+          *  is computed directly into result type of loop.
+          */
+         break;
+
+      case N_Case:
+         f_store = fail_store;
+         s_store = get_store(1);
+         infer_nd(Tree0(n));     /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             * Set up a failure store to capture the effects of failure
+             *  of the selection clause.
+             */
+            store = get_store(1);
+            fail_store = store;
+            infer_nd(Tree0(clause));             /* value of clause */
+
+            /*
+             * Create the effect of the possible failure of the comparison
+             *  of the selection value to the control value.
+             */
+            mrg_store(succ_store, fail_store);
+
+            /*
+             * The success and failure stores and the result of the body
+             *  of the clause are those of the whole case expression.
+             */
+            fail_store = f_store;
+            infer_nd(Tree1(clause));             /* body of clause */
+            mrg_store(succ_store, s_store);
+            free_store(succ_store);
+            succ_store = store;
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store);  /* 'case' can be resumed */
+#ifdef TypTrc
+            MrgTyp(n_intrtyp, Tree1(clause)->type, n->type);
+#else					/* TypTrc */
+            /*
+             * Type is computed by case clause directly into n->type.
+            */
+#endif					/* TypTrc */
+            }
+
+         /*
+          * Check for default clause.
+          */
+         if (Tree2(n) == NULL)
+            mrg_store(succ_store, f_store);
+         else {
+            fail_store = f_store;
+            infer_nd(Tree2(n));                  /* default */
+            mrg_store(succ_store, s_store);
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store);  /* 'case' can be resumed */
+#ifdef TypTrc
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+#else					/* TypTrc */
+            /*
+             * Type is computed by default clause directly into n->type.
+             */
+#endif					/* TypTrc */
+            }
+         free_store(succ_store);
+         succ_store = s_store;
+         if (n->store != NULL)
+            fail_store = n->store;
+         break;
+
+      case N_Create:
+         /*
+          * Record initial values of local variables for coexpression.
+          */
+         store = coexp_map[n->new_types[0]]->in_store;
+         for (i = 0; i < n_loc; ++i)
+            ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+               store->types[n_gbl + i])
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Cset:
+      case N_Empty:
+      case N_Id:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Field: {
+         struct fentry *fp;
+         struct par_rec *rp;
+         int frst_rec;
+
+         if ((fp = flookup(Str0(Tree1(n)))) == NULL) {
+            break;  /* error message printed elsewhere */
+            }
+
+         /*
+          * Determine the record types.
+          */
+         infer_nd(Tree0(n));
+         typ_deref(Tree0(n)->type, n->symtyps->types[0], 0);
+
+         /*
+          * For each record containing this field, get the tupe of
+          *  the field in that record.
+          */
+         frst_rec = type_array[rec_typ].frst_bit;
+         for (rp = fp->rlist; rp != NULL; rp = rp->next) {
+            if (bitset(n->symtyps->types[0], frst_rec + rp->rec->rec_num))
+               set_typ(n->type, frst_fld + rp->rec->frst_fld + rp->offset);
+            }
+         }
+         break;
+
+      case N_If:
+         f_store = fail_store;
+         if (Tree2(n)->n_type != N_Empty) {
+            /*
+             * If there is an else clause, we must set up a failure store
+             *  to capture the effects of failure of the control clause.
+             */
+            store = get_store(1);
+            fail_store = store;
+            }
+
+         infer_nd(Tree0(n));           /* control clause */
+
+         /*
+          * If the control clause succeeds, execution passes into the
+          *  then clause with the failure store for the entire if expression.
+          */
+         fail_store = f_store;
+         infer_nd(Tree1(n));           /* then clause */
+
+         if (Tree2(n)->n_type != N_Empty) {
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store); /* 'if' expr can be resumed */
+            s_store = succ_store;
+
+            /*
+             * The entering success store of the else clause is the failure
+             *  store of the control clause. The failure store is that of
+             *  the entire if expression.
+             */
+            succ_store = store;
+            fail_store = f_store;
+            infer_nd(Tree2(n));        /* else clause */
+
+            if (n->store != NULL) {
+               mrg_store(n->store, fail_store); /* 'if' expr can be resumed */
+               fail_store = n->store;
+               }
+
+            /*
+             * Join the exiting success stores of the then and else clauses.
+             */
+            mrg_store(s_store, succ_store);
+            free_store(s_store);
+            }
+
+#ifdef TypTrc
+         MrgTyp(n_intrtyp, Tree1(n)->type, n->type);
+         if (Tree2(n)->n_type != N_Empty)
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+#else					/* TypTrc */
+         /*
+          * Type computed by 'then' and 'else' clauses directly into n->type.
+          */
+#endif					/* TypTrc */
+         break;
+
+      case N_Invok:
+         /*
+          * General invocation.
+          */
+         infer_nd(Tree1(n));          /* thing being invoked */
+
+         /*
+          * Perform type inference on all the arguments and copy the
+          *  results into the argument type array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * If this is mutual evaluation, get the type of the last argument,
+          *  otherwise do inference on general invocation.
+          */
+         if (Tree1(n)->n_type == N_Empty) {
+            MrgTyp(n_intrtyp, arg_typs->types[num_args - 1], n->type);
+            }
+         else
+            gen_inv(Tree1(n)->type, n);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvOp:
+         /*
+          * Invocation of a run-time operation. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * Perform inference on operation invocation.
+          */
+         infer_impl(Impl1(n), n, n->symtyps, n->type);
+         chk_succ(Impl1(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvProc:
+         /*
+          * Invocation of a procedure. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * Perform inference on the procedure invocation.
+          */
+         infer_prc(Proc1(n), n);
+         chk_succ(Proc1(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvRec:
+         /*
+          * Invocation of a record constructor. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         infer_con(Rec1(n), n); /* inference on constructor invocation */
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Limit:
+         infer_nd(Tree1(n));                 /* limit */
+         typ_deref(Tree1(n)->type, n->symtyps->types[0], 0);
+         mrg_store(succ_store, fail_store);  /* limit might be 0 */
+         mrg_store(n->store, fail_store);    /* resumption may bypass expr */
+         infer_nd(Tree0(n));                 /* expression */
+         if (fail_store != NULL)
+            mrg_store(n->store, fail_store); /* expression may be resumed */
+         fail_store = n->store;
+         /*
+          * Type is computed by expression being limited.
+          */
+         break;
+
+      case N_Loop: {
+         /*
+          * Establish stores used by break and next.
+          */
+         loop_info.prev = cur_loop;
+         loop_info.succ_store = get_store(1);
+         loop_info.fail_store = fail_store;
+         loop_info.next_store = NULL;
+         loop_info.susp_store = n->store->next;
+         cur_loop = &loop_info;
+
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+               infer_nd(Tree1(n));              /* control clause */
+               f_store = fail_store;
+
+               /*
+                * Next in the do clause resumes the control clause as
+                *  does success of the do clause.
+                */
+               loop_info.next_store = fail_store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, f_store);
+               break;
+
+            case REPEAT:
+               /*
+                * The body of the loop can be entered by entering the
+                *  loop, by executing a next in the body, or by having
+                *  the loop succeed or fail. n->store captures all but
+                *  the first case, which is covered by the initial success
+                *  store.
+                */
+               fail_store = n->store;
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               infer_nd(Tree1(n));
+               mrg_store(succ_store, n->store);
+               break;
+
+            case SUSPEND:
+               infer_nd(Tree1(n));              /* value */
+#ifdef TypTrc
+              if (trcfile != NULL)
+                  fprintf(trcfile, "%s (%d,%d) suspend ", n->n_file, n->n_line,
+                     n->n_col);
+#endif					/* TypTrc */
+
+               set_ret(Tree1(n)->type); /* set return type of procedure */
+
+               /*
+                * Get changes to types of global variables from
+                *  resumption.
+                */
+               store = cur_proc->susp_store;
+               for (i = 0; i < n_gbl; ++i)
+                  CpyTyp(n_icntyp, store->types[i], succ_store->types[i]);
+
+               /*
+                * Next in the do clause resumes the control clause as
+                *  does success of the do clause.
+                */
+               f_store = fail_store;
+               loop_info.next_store = fail_store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, f_store);
+               break;
+
+            case WHILE:
+               /*
+                * The control clause can be entered by entering the loop,
+                *  executing a next expression, or by having the do clause
+                *  succeed or fail. n->store captures all but the first case,
+                *  which is covered by the initial success store.
+                */
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               infer_nd(Tree1(n));              /* control clause */
+               fail_store = n->store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, n->store);
+               break;
+
+            case UNTIL:
+               /*
+                * The control clause can be entered by entering the loop,
+                *  executing a next expression, or by having the do clause
+                *  succeed or fail. n->store captures all but the first case,
+                *  which is covered by the initial success store.
+                */
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               f_store = fail_store;
+               /*
+                * Set up a failure store to capture the effects of failure
+                *  of the control clause.
+                */
+               store = get_store(1);
+               fail_store = store;
+               infer_nd(Tree1(n));              /* control clause */
+               mrg_store(succ_store, f_store);
+               free_store(succ_store);
+               succ_store = store;
+               fail_store = n->store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, n->store);
+               break;
+            }
+         free_store(succ_store);
+         succ_store = loop_info.succ_store;
+         if (n->store->next != NULL)
+             fail_store = n->store->next;
+         cur_loop = cur_loop->prev;
+         /*
+          * Type is computed by break expressions.
+          */
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop->next_store == NULL)
+            mrg_store(succ_store, fail_store);   /* control clause of every */
+         else
+            mrg_store(succ_store, cur_loop->next_store);
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Result is empty type.
+          */
+         break;
+
+      case N_Not:
+         /*
+          * Set up a failure store to capture the effects of failure
+          *  of the negated expression, it becomes the success store
+          *  of the entire expression.
+          */
+         f_store = fail_store;
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(Tree0(n));
+         mrg_store(succ_store, f_store); /* if success, then fail */
+         free_store(succ_store);
+         succ_store = store;
+         fail_store = f_store;
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN) {
+            if (Tree1(n)->flag & CanFail) {
+               /*
+                * Set up a failure store to capture the effects of failure
+                *  of the returned expression and the corresponding procedure
+                *  failure.
+                */
+               store = get_store(1);
+               fail_store = store;
+               infer_nd(Tree1(n));    /* return value */
+               mrg_store(store, succ_store);
+               free_store(store);
+               }
+            else
+               infer_nd(Tree1(n));    /* return value */
+
+#ifdef TypTrc
+           if (trcfile != NULL)
+               fprintf(trcfile, "%s (%d,%d) return ", n->n_file, n->n_line,
+               n->n_col);
+#endif					/* TypTrc */
+
+            set_ret(Tree1(n)->type);
+            }
+         else {  /* fail */
+            set_ret(NULL);
+
+#ifdef TypTrc
+           if (trcfile != NULL) 
+               fprintf(trcfile, "%s (%d,%d) fail\n", n->n_file, n->n_line,
+               n->n_col);
+#endif					/* TypTrc */
+
+            }
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Empty type.
+          */
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         infer_nd(Tree1(n));   /* subject */ 
+         typ_deref(Tree1(n)->type, n->symtyps->types[0], 0);
+         infer_nd(Tree2(n));   /* body */
+
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            /*
+             * Perform type inference on the assignment.
+             */
+            asgn_impl = optab[asgn_loc].binary;
+            sav_argtyp = arg_typs;
+            sav_nargs = num_args;
+            arg_typs = get_argtyp();
+            num_args = 2;
+            arg_typs->types[0] = Tree1(n)->type;
+            arg_typs->types[1] = Tree2(n)->type;
+            infer_impl(asgn_impl, n, n->symtyps->next, n->type);
+            chk_succ(asgn_impl->ret_flag, n->store);
+            free_argtyp(arg_typs);
+            arg_typs = sav_argtyp;
+            num_args = sav_nargs;
+            }
+         else
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+         }
+         break;
+
+      case N_Sect:
+         infer_nd(Tree2(n));     /* 1st operand */
+         infer_nd(Tree3(n));     /* 2nd operand */
+         infer_nd(Tree4(n));     /* 3rd operand */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         if (Impl1(n) != NULL) {
+            /*
+             * plus or minus.
+             */
+            num_args = 2;
+            arg_typs->types[0] = Tree3(n)->type;
+            arg_typs->types[1] = Tree4(n)->type;
+            wktyp = get_wktyp();
+            infer_impl(Impl1(n), n, n->symtyps->next, wktyp->bits);
+            chk_succ(Impl1(n)->ret_flag, n->store);
+            arg_typs->types[2] = wktyp->bits;
+            }
+         else
+            arg_typs->types[2] = Tree4(n)->type;
+         num_args = 3;
+         arg_typs->types[0] = Tree2(n)->type;
+         arg_typs->types[1] = Tree3(n)->type;
+         /*
+          * sectioning 
+          */
+         infer_impl(Impl0(n), n, n->symtyps, n->type);
+         chk_succ(Impl0(n)->ret_flag, n->store);
+         if (Impl1(n) != NULL)
+           free_wktyp(wktyp);
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Slist:
+         f_store = fail_store;
+         if (Tree0(n)->flag & CanFail) {
+            /*
+             * Set up a failure store to capture the effects of failure
+             *  of the first operand; this is merged into the
+             *  incoming success store of the second operand.
+             */
+            store = get_store(1);
+            fail_store = store;
+            infer_nd(Tree0(n));
+            mrg_store(store, succ_store);
+            free_store(store);
+            }
+         else
+            infer_nd(Tree0(n));
+         fail_store = f_store;
+         infer_nd(Tree1(n));
+         /*
+          * Type is computed by second operand.
+          */
+         break;
+
+      case N_SmplAsgn: {
+         /*
+          * Optimized assignment to a named variable.
+          */
+         struct lentry *var;
+         int indx;
+
+         infer_nd(Tree3(n));
+         var = LSym0(Tree2(n));
+         if (var->flag & F_Global)
+            indx = var->val.global->index;
+         else if (var->flag & F_Static)
+            indx = var->val.index;
+         else
+            indx = n_gbl + var->val.index;
+         ClrTyp(n_icntyp, succ_store->types[indx]);
+         typ_deref(Tree3(n)->type, succ_store->types[indx], 0);
+
+#ifdef TypTrc
+         /*
+          * Trace assignment.
+          */
+         if (trcfile != NULL) {
+            fprintf(trcfile, "%s (%d,%d) %s%s := ", n->n_file, n->n_line,
+               n->n_col, trc_indent, var->name);
+            prt_d_typ(trcfile, Tree3(n)->type);
+            fprintf(trcfile, "\n");
+            }
+#endif					/* TypTrc */
+         /*
+          * Type is precomputed.
+          */
+         }
+         break;
+
+      case N_SmplAug: {
+         /*
+          * Optimized augmented assignment to a named variable.
+          */
+         struct lentry *var;
+         int indx;
+
+         /*
+          * Perform type inference on the operation.
+          */
+         infer_nd(Tree3(n));            /* 2nd operand */
+
+         /*
+          * Set up type array for arguments of operation.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = 2;
+         arg_typs->types[0] = Tree2(n)->type;  /* type was precomputed */
+         arg_typs->types[1] = Tree3(n)->type;
+
+         /*
+          * Perform inference on the operation.
+          */
+         infer_impl(Impl1(n), n, n->symtyps, Typ4(n));
+         chk_succ(Impl1(n)->ret_flag, n->store);
+
+         /*
+          * Perform assignment to the variable.
+          */
+         var = LSym0(Tree2(n));
+         if (var->flag & F_Global)
+            indx = var->val.global->index;
+         else if (var->flag & F_Static)
+            indx = var->val.index;
+         else
+            indx = n_gbl + var->val.index;
+         ClrTyp(n_icntyp, succ_store->types[indx]);
+         typ_deref(Typ4(n), succ_store->types[indx], 0);
+
+#ifdef TypTrc
+         /*
+          * Trace assignment.
+          */
+         if (trcfile != NULL) {
+            fprintf(trcfile, "%s (%d,%d) %s%s := ", n->n_file, n->n_line,
+               n->n_col, trc_indent, var->name);
+            prt_d_typ(trcfile, Typ4(n));
+            fprintf(trcfile, "\n");
+            }
+#endif					/* TypTrc */
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+
+         /*
+          * Type is precomputed.
+          */
+         }
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * infer_con - perform type inference for the invocation of a record
+ *  constructor.
+ */
+static void infer_con(rec, n)
+struct rentry *rec;
+nodeptr n;
+   {
+   int fld_indx;
+   int nfields;
+   int i;
+
+#ifdef TypTrc
+   if (trcfile != NULL)
+      fprintf(trcfile, "%s (%d,%d) %s%s(", n->n_file, n->n_line, n->n_col,
+         trc_indent, rec->name);
+#endif					/* TypTrc */
+
+   /*
+    * Dereference argument types into appropriate entries of field store.
+    */
+   fld_indx = rec->frst_fld;
+   nfields = rec->nfields;
+   for (i = 0; i < num_args && i < nfields; ++i) {
+      typ_deref(arg_typs->types[i], fld_stor->types[fld_indx++], 1);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         if (i > 0)
+            fprintf(trcfile, ", ");
+         prt_d_typ(trcfile, arg_typs->types[i]);
+         }
+#endif					/* TypTrc */
+
+      }
+
+   /*
+    * If there are too few arguments, add null type to appropriate entries
+    *  of field store.
+    */
+   while (i < nfields) {
+      if (!bitset(fld_stor->types[fld_indx], null_bit)) {
+         ++changed;
+         set_typ(fld_stor->types[fld_indx], null_bit);
+         }
+      ++fld_indx;
+      ++i;
+      }
+
+   /*
+    * return record type
+    */
+   set_typ(n->type, type_array[rec_typ].frst_bit + rec->rec_num);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, ")  =>>  ");
+      prt_typ(trcfile, n->type);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * infer_act - perform type inference on coexpression activation.
+ */
+static void infer_act(n)
+nodeptr n;
+   {
+   struct implement *asgn_impl;
+   struct store *s_store;
+   struct store *f_store;
+   struct store *e_store;
+   struct store *store;
+   struct t_coexpr *sv_coexp;
+   struct t_coexpr *coexp;
+   struct type *rslt_typ;
+   struct argtyps *sav_argtyp;
+   int frst_coexp;
+   int num_coexp;
+   int sav_nargs;
+   int i;
+   int j;
+
+#ifdef TypTrc
+   FILE *trc_save;
+#endif					/* TypTrc */
+
+   num_coexp = type_array[coexp_typ].num_bits;
+   frst_coexp = type_array[coexp_typ].frst_bit;
+
+   infer_nd(Tree1(n));   /* value to transmit */ 
+   infer_nd(Tree2(n));   /* coexpression */
+
+   /*
+    * Dereference the two arguments. Note that only locals in the
+    *  transmitted value are dereferenced.
+    */
+
+#ifdef TypTrc
+   trc_save = trcfile;
+   trcfile = NULL;  /* don't trace value during dereferencing */
+#endif					/* TypTrc */
+
+   deref_lcl(Tree1(n)->type, n->symtyps->types[0]);
+
+#ifdef TypTrc
+   trcfile = trc_save;
+#endif					/* TypTrc */
+
+   typ_deref(Tree2(n)->type, n->symtyps->types[1], 0);
+
+   rslt_typ = get_wktyp();
+
+   /*
+    * Set up a store for the end of the activation and propagate local
+    *  variables across the activation; the activation may succeed or
+    *  fail.
+    */
+   e_store = get_store(1);
+   for (i = 0; i < n_loc; ++i)
+      CpyTyp(n_icntyp, succ_store->types[n_gbl + i], e_store->types[n_gbl + i])
+   if (fail_store->perm) {
+      for (i = 0; i < n_loc; ++i)
+         ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+            fail_store->types[n_gbl + i])
+         }
+    else {
+      for (i = 0; i < n_loc; ++i)
+         MrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+            fail_store->types[n_gbl + i])
+      }
+
+
+   /*
+    * Go through all the co-expressions that might be activated,
+    *  perform type inference on them, and transmit stores along
+    *  the execution paths induced by the activation.
+    */
+   s_store = succ_store;
+   f_store = fail_store;
+   for (j = 0; j < num_coexp; ++j) {
+      if (bitset(n->symtyps->types[1], frst_coexp + j)) {
+         coexp = coexp_map[j];
+         /*
+          * Merge the types of global variables into the "in store" of the
+          *  co-expression. Because the body of the co-expression may already
+          *  have been processed for this pass, the "changed" flag must be
+          *  set if there is a change of type in the store. This will insure
+          *  that there will be another iteration in which to propagate the
+          *  change into the body.
+          */
+         store = coexp->in_store;
+         for (i = 0; i < n_gbl; ++i)
+            ChkMrgTyp(n_icntyp, s_store->types[i], store->types[i])
+
+         ChkMrgTyp(n_intrtyp, n->symtyps->types[0], coexp->act_typ)
+
+         /*
+          * Only perform type inference on the body of a co-expression
+          *  once per iteration. The main co-expression has no body.
+          */
+         if (coexp->iteration < iteration & coexp->n != NULL) {
+            coexp->iteration = iteration;
+            succ_store = cpy_store(coexp->in_store);
+            fail_store = coexp->out_store;
+            sv_coexp = cur_coexp;
+            cur_coexp = coexp;
+            infer_nd(coexp->n);
+
+            /*
+             * Dereference the locals in the value resulting from
+             *  the execution of the co-expression body.
+             */
+
+#ifdef TypTrc
+            if (trcfile != NULL)
+               fprintf(trcfile, "%s (%d,%d) %sC%d  =>>  ", coexp->n->n_file,
+                  coexp->n->n_line, coexp->n->n_col, trc_indent, j);
+#endif					/* TypTrc */
+
+            deref_lcl(coexp->n->type, coexp->rslt_typ);
+
+            mrg_store(succ_store, coexp->out_store);
+            free_store(succ_store);
+            cur_coexp = sv_coexp;
+            }
+
+         /*
+          * Get updated types for global variables, assuming the co-expression
+          *  fails or returns by completing.
+          */
+         store = coexp->out_store;
+         for (i = 0; i < n_gbl; ++i)
+            MrgTyp(n_icntyp, store->types[i], e_store->types[i]);
+         if (f_store->perm) {
+            for (i = 0; i < n_gbl; ++i)
+               ChkMrgTyp(n_icntyp, store->types[i], f_store->types[i]);
+            }
+          else {
+            for (i = 0; i < n_gbl; ++i)
+               MrgTyp(n_icntyp, store->types[i], f_store->types[i]);
+            }
+         MrgTyp(n_intrtyp, coexp->rslt_typ, rslt_typ->bits)
+         }
+      }
+
+   /*
+    * Control may return from the activation if another co-expression
+    *  activates the current one. If we are in a create expression,
+    *  cur_coexp is the current co-expression, otherwise the current
+    *  procedure may be called within several co-expressions.
+    */
+   if (cur_coexp == NULL) {
+      for (j = 0; j < num_coexp; ++j)
+         if (bitset(cur_proc->coexprs, frst_coexp + j))
+            mrg_act(coexp_map[j], e_store, rslt_typ);
+      }
+   else
+      mrg_act(cur_coexp, e_store, rslt_typ);
+
+   free_store(s_store);
+   succ_store = e_store;
+   fail_store = f_store;
+
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) %s", n->n_file, n->n_line, n->n_col,
+         trc_indent);
+      prt_typ(trcfile, n->symtyps->types[0]);
+      fprintf(trcfile, " @ ");
+      prt_typ(trcfile, n->symtyps->types[1]);
+      fprintf(trcfile, "  =>>  ");
+      prt_typ(trcfile, rslt_typ->bits);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+
+   if (optab[Val0(Tree0(n))].tok.t_type == AUGAT) {
+      /*
+       * Perform type inference on the assignment.
+       */
+      asgn_impl = optab[asgn_loc].binary;
+      sav_argtyp = arg_typs;
+      sav_nargs = num_args;
+      arg_typs = get_argtyp();
+      num_args = 2;
+      arg_typs->types[0] = Tree1(n)->type;
+      arg_typs->types[1] = rslt_typ->bits;
+      infer_impl(asgn_impl, n, n->symtyps->next, n->type);
+      chk_succ(asgn_impl->ret_flag, n->store);
+      free_argtyp(arg_typs);
+      arg_typs = sav_argtyp;
+      num_args = sav_nargs;
+      }
+   else
+      ChkMrgTyp(n_intrtyp, rslt_typ->bits, n->type)
+
+   free_wktyp(rslt_typ);
+   }
+
+/*
+ * mrg_act - merge entry information for the co-expression to the
+ *  the ending store and result type for the activation being
+ *  analyzed.
+ */
+static void mrg_act(coexp, e_store, rslt_typ)
+struct t_coexpr *coexp;
+struct store *e_store;
+struct type *rslt_typ;
+   {
+   struct store *store;
+   int i;
+
+   store = coexp->in_store;
+   for (i = 0; i < n_gbl; ++i)
+      MrgTyp(n_icntyp, store->types[i], e_store->types[i]);
+
+   MrgTyp(n_intrtyp, coexp->act_typ, rslt_typ->bits)
+   }
+
+/*
+ * typ_deref - perform dereferencing in the abstract type realm.
+ */
+static void typ_deref(src, dest, chk)
+#ifdef OptimizeType
+struct typinfo *src;
+struct typinfo *dest;
+#else					/* OptimizeType */
+unsigned int *src;
+unsigned int *dest;
+#endif					/* OptimizeType */
+int chk;
+   {
+   struct store *tblel_stor;
+   struct store *tbldf_stor;
+   struct store *ttv_stor;
+   struct store *store;
+   unsigned int old;
+   int num_tbl;
+   int frst_tbl;
+   int num_bits;
+   int frst_bit;
+   int i;
+   int j;
+   int ret;
+/*
+   if (src->bits == NULL) {
+      src->bits = alloc_mem_typ(src->size);
+      xfer_packed_types(src);
+   }
+   if (dest->bits == NULL) {
+      dest->bits = alloc_mem_typ(dest->size);
+      xfer_packed_types(dest);
+   }
+*/
+   /*
+    * copy values to destination
+    */
+#ifdef OptimizeType
+   if ((src->bits != NULL) && (dest->bits != NULL))  {
+       for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+          old = dest->bits[i];
+          dest->bits[i] |= src->bits[i];
+          if (chk && (old != dest->bits[i]))
+             ++changed;
+       }
+       old = dest->bits[i];
+       dest->bits[i] |= src->bits[i] & val_mask;  /* mask out variables */
+       if (chk && (old != dest->bits[i]))
+          ++changed;
+    }
+    else if ((src->bits != NULL) && (dest->bits == NULL)) {
+       dest->bits = alloc_mem_typ(DecodeSize(dest->packed));
+       xfer_packed_types(dest);
+       for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+          old = dest->bits[i];
+          dest->bits[i] |= src->bits[i];
+          if (chk && (old != dest->bits[i]))
+             ++changed;
+          }
+       old = dest->bits[i];
+       dest->bits[i] |= src->bits[i] & val_mask;  /* mask out variables */
+       if (chk && (old != dest->bits[i]))
+          ++changed;
+    }  
+    else if ((src->bits == NULL) && (dest->bits != NULL))  {
+       ret = xfer_packed_to_bits(src, dest, n_icntyp);       
+       if (chk)
+          changed += ret;
+    }
+    else {
+       ret = mrg_packed_to_packed(src, dest, n_icntyp);
+       if (chk)
+          changed += ret;
+    }
+#else					/* OptimizeType */
+   for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+      old = dest[i];
+      dest[i] |= src[i];
+      if (chk && (old != dest[i]))
+         ++changed;
+      }
+   old = dest[i];
+   dest[i] |= src[i] & val_mask;  /* mask out variables */
+   if (chk && (old != dest[i]))
+      ++changed;
+#endif					/* OptimizeType */
+
+   /* 
+    * predefined variables whose types do not change.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].deref == DrfCnst) {
+         if (bitset(src, type_array[i].frst_bit))
+            if (chk)
+               ChkMrgTyp(n_icntyp, type_array[i].typ, dest)
+            else
+               MrgTyp(n_icntyp, type_array[i].typ, dest)
+         }
+      }
+
+
+   /*
+    * substring trapped variables
+    */
+   num_bits = type_array[stv_typ].num_bits;
+   frst_bit = type_array[stv_typ].frst_bit;
+   for (i = 0; i < num_bits; ++i)
+      if (bitset(src, frst_bit + i))
+         if (!bitset(dest, str_bit)) {
+            if (chk)
+               ++changed;
+            set_typ(dest, str_bit);
+            }
+
+   /*
+    * table element trapped variables
+    */
+   num_bits = type_array[ttv_typ].num_bits;
+   frst_bit = type_array[ttv_typ].frst_bit;
+   num_tbl = type_array[tbl_typ].num_bits;
+   frst_tbl = type_array[tbl_typ].frst_bit;
+   tblel_stor = compnt_array[tbl_val].store;
+   tbldf_stor = compnt_array[tbl_dflt].store;
+   ttv_stor = compnt_array[trpd_tbl].store;
+   for (i = 0; i < num_bits; ++i)
+      if (bitset(src, frst_bit + i))
+         for (j = 0; j < num_tbl; ++j)
+             if (bitset(ttv_stor->types[i], frst_tbl + j)) {
+                if (chk) {
+                   ChkMrgTyp(n_icntyp, tblel_stor->types[j], dest)
+                   ChkMrgTyp(n_icntyp, tbldf_stor->types[j], dest)
+                   }
+                else {
+                   MrgTyp(n_icntyp, tblel_stor->types[j], dest)
+                   MrgTyp(n_icntyp, tbldf_stor->types[j], dest)
+                   }
+                }
+
+   /*
+    * Aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      if (typecompnt[i].var) {
+         frst_bit = compnt_array[i].frst_bit;
+         num_bits = compnt_array[i].num_bits;
+         store = compnt_array[i].store;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(src, frst_bit + j))
+               if (chk)
+                  ChkMrgTyp(n_icntyp, store->types[j], dest)
+               else
+                  MrgTyp(n_icntyp, store->types[j], dest)
+            }
+         }
+      }
+
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(src, frst_fld + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, fld_stor->types[i], dest)
+         else
+            MrgTyp(n_icntyp, fld_stor->types[i], dest)
+      }
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_gbl; ++i)
+      if (bitset(src, frst_gbl + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, succ_store->types[i], dest)
+         else
+            MrgTyp(n_icntyp, succ_store->types[i], dest)
+      }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(src, frst_loc + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i], dest)
+         else
+            MrgTyp(n_icntyp, succ_store->types[n_gbl + i], dest)
+      }
+}
+
+/*
+ * infer_impl - perform type inference on a call to built-in operation
+ *   using the implementation entry from the data base.
+ */
+static void infer_impl(impl, n, symtyps, rslt_typ)
+struct implement *impl;
+nodeptr n;
+struct symtyps *symtyps;
+#ifdef OptimizeType
+struct typinfo *rslt_typ;
+#else					/* OptimizeType */
+unsigned int *rslt_typ;
+#endif					/* OptimizeType */
+   {
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int flag;
+   int nparms;
+   int i;
+   int j; 
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) %s", n->n_file, n->n_line, n->n_col,
+         trc_indent);
+      if (impl->oper_typ == 'K')
+         fprintf(trcfile, "&%s", impl->name);
+      else
+         fprintf(trcfile, "%s(", impl->name);
+      }
+#endif					/* TypTrc */
+   /*
+    * Set up the "symbol table" of dereferenced and undereferenced
+    *  argument types as needed by the operation.
+    */
+   nparms = impl->nargs;
+   j = 0;
+   for (i = 0; i < num_args && i < nparms; ++i) {
+      if (impl->arg_flgs[i] & RtParm) {
+         CpyTyp(n_intrtyp, arg_typs->types[i], symtyps->types[j]);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++j;
+         }
+      if (impl->arg_flgs[i] & DrfPrm) {
+         typ_deref(arg_typs->types[i], symtyps->types[j], 0);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (impl->arg_flgs[i] & RtParm)
+               fprintf(trcfile, "->");
+            else if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_d_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++j;
+         }
+      }
+   if (nparms > 0) {
+      /*
+       * Check for varargs. Merge remaining arguments into the
+       *  type of the variable part of the parameter list.
+       */
+      flag = impl->arg_flgs[nparms - 1];
+      if (flag & VarPrm) {
+         n_vararg = num_args - nparms + 1;
+         if (n_vararg < 0)
+            n_vararg = 0;
+         typ = symtyps->types[j - 1];
+         while (i < num_args) {
+            if (flag & RtParm) {
+               MrgTyp(n_intrtyp, arg_typs->types[i], typ)
+
+#ifdef TypTrc
+               if (trcfile != NULL) {
+                  if (i > 0)
+                     fprintf(trcfile, ", ");
+                  prt_typ(trcfile, arg_typs->types[i]);
+                  }
+#endif					/* TypTrc */
+
+              }
+            else {
+               typ_deref(arg_typs->types[i], typ, 0);
+
+#ifdef TypTrc
+               if (trcfile != NULL) {
+                  if (i > 0)
+                     fprintf(trcfile, ", ");
+                  prt_d_typ(trcfile, arg_typs->types[i]);
+                  }
+#endif					/* TypTrc */
+
+              }
+            ++i;
+            }
+         nparms -= 1; /* Don't extend with nulls into variable part */
+         }
+      }
+   while (i < nparms) {
+      if (impl->arg_flgs[i] & RtParm)
+         set_typ(symtyps->types[j++], null_bit); /* Extend args with nulls */
+      if (impl->arg_flgs[i] & DrfPrm)
+         set_typ(symtyps->types[j++], null_bit); /* Extend args with nulls */
+      ++i;
+      }
+
+   /*
+    * If this operation can suspend, there may be backtracking paths
+    *  to this invocation. Merge type information from those paths
+    *  into the current store.
+    */
+   if (impl->ret_flag & DoesSusp)
+      mrg_store(n->store, succ_store);
+
+   cur_symtyps = symtyps;
+   cur_rslt.bits = rslt_typ;
+   cur_rslt.size = n_intrtyp;
+   cur_new = n->new_types;
+   infer_il(impl->in_line); /* perform inference on operation */
+
+   if (MightFail(impl->ret_flag))
+      mrg_store(succ_store, fail_store);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      if (impl->oper_typ != 'K')
+         fprintf(trcfile, ")");
+      fprintf(trcfile, "  =>>  ");
+      prt_typ(trcfile, rslt_typ);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * chk_succ - check to see if the operation can succeed. In particular,
+ *   see if it can suspend. Change the succ_store and failure store
+ *   appropriately.
+ */
+static void chk_succ(ret_flag, susp_stor)
+int ret_flag;
+struct store *susp_stor;
+   {
+   if (ret_flag & DoesSusp) {
+       if (susp_stor != NULL && (ret_flag & DoesRet))
+          mrg_store(susp_stor, fail_store); /* "pass along" failure */
+       fail_store = susp_stor;
+       }
+   else if (!(ret_flag & DoesRet)) {
+      free_store(succ_store);
+      succ_store = get_store(1);
+      fail_store = dummy_stor;    /* shouldn't be used */
+      }
+   }
+
+/*
+ * infer_il - perform type inference on a piece of code within built-in
+ *   operation and determine whether execution can get past it.
+ */
+static int infer_il(il)
+struct il_code *il;
+   {
+   struct il_code *il1;
+   int condition;
+   int case_fnd;
+   int ncases;
+   int may_fallthru;
+   int indx;
+   int i;
+
+   if (il == NULL)
+      return 1;
+
+   switch (il->il_type) {
+      case IL_Const:  /* should have been replaced by literal node */
+         return 0;
+
+      case IL_If1:
+         condition = eval_cond(il->u[0].fld);
+         may_fallthru = (condition & MaybeFalse);
+         if (condition & MaybeTrue)
+            may_fallthru |= infer_il(il->u[1].fld);
+         return may_fallthru;
+
+      case IL_If2:
+         condition = eval_cond(il->u[0].fld);
+         may_fallthru = 0;
+         if (condition & MaybeTrue)
+            may_fallthru |= infer_il(il->u[1].fld);
+         if (condition & MaybeFalse)
+            may_fallthru |= infer_il(il->u[2].fld);
+         return may_fallthru;
+
+      case IL_Tcase1:
+         type_case(il, infer_il, NULL);
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Tcase2:
+         indx = type_case(il, infer_il, NULL);
+         if (indx != -1)
+            infer_il(il->u[indx].fld);         /* default */
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Lcase:
+         ncases = il->u[0].n;
+         indx = 1;
+         case_fnd = 0;
+         for (i = 0; i < ncases && !case_fnd; ++i) {
+            if (il->u[indx++].n == n_vararg) {   /* selection number */
+               infer_il(il->u[indx].fld);        /* action */
+               case_fnd = 1;
+               }
+            ++indx;
+            }
+         if (!case_fnd)
+            infer_il(il->u[indx].fld);        /* default */
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Acase: {
+         int maybe_int;
+         int maybe_dbl;
+
+         eval_arith((int)il->u[0].fld->u[0].n, (int)il->u[1].fld->u[0].n,
+             &maybe_int, &maybe_dbl);
+         if (maybe_int) {
+            infer_il(il->u[2].fld);          /* C_integer action */
+            if (largeints) 
+               infer_il(il->u[3].fld);       /* integer action */
+            }
+         if (maybe_dbl)
+            infer_il(il->u[4].fld);          /* C_double action */
+         return 1;      /* no point in trying very hard here */
+         }
+
+      case IL_Err1:
+      case IL_Err2:
+         return 0;
+
+      case IL_Block:
+         return il->u[0].n;
+
+      case IL_Call:
+         return ((il->u[3].n & DoesFThru) != 0);
+
+      case IL_Lst:
+         if (infer_il(il->u[0].fld))
+             return infer_il(il->u[1].fld);
+         else
+             return 0;
+
+      case IL_Abstr:
+         /*
+          * Handle side effects.
+          */
+         il1 = il->u[0].fld;
+         if (il1 != NULL) {
+             while (il1->il_type == IL_Lst) {
+                side_effect(il1->u[1].fld);
+                il1 = il1->u[0].fld;
+                }
+             side_effect(il1);
+             }
+
+         /*
+          * Set return type.
+          */
+         abstr_typ(il->u[1].fld, &cur_rslt);
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * side_effect - perform a side effect from an abstract clause of a
+ *  built-in operation.
+ */
+static void side_effect(il)
+struct il_code *il;
+   {
+   struct type *var_typ;
+   struct type *val_typ;
+   struct store *store;
+   int num_bits;
+   int frst_bit;
+   int i, j;
+
+   /*
+    * il is IL_TpAsgn, get the variable type and value type, and perform
+    *  the side effect.
+    */
+   var_typ = get_wktyp();
+   val_typ = get_wktyp();
+   abstr_typ(il->u[0].fld, var_typ);    /* variable type */
+   abstr_typ(il->u[1].fld, val_typ);    /* value type */
+
+   /*
+    * Determine which types that can be assigned to are in the variable
+    *  type.
+    *
+    * Aggregate compontents.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      frst_bit = compnt_array[i].frst_bit;
+      num_bits = compnt_array[i].num_bits;
+      store = compnt_array[i].store;
+      for (j = 0; j < num_bits; ++j) {
+         if (bitset(var_typ->bits, frst_bit + j))
+            ChkMrgTyp(n_icntyp, val_typ->bits, store->types[j])
+         }
+      }
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(var_typ->bits, frst_fld + i))
+         ChkMrgTyp(n_icntyp, val_typ->bits, fld_stor->types[i]);
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_gbl; ++i)
+      if (bitset(var_typ->bits, frst_gbl + i))
+          MrgTyp(n_icntyp, val_typ->bits, succ_store->types[i]);
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(var_typ->bits, frst_loc + i))
+          MrgTyp(n_icntyp, val_typ->bits, succ_store->types[n_gbl + i]);
+
+
+   free_wktyp(var_typ);
+   free_wktyp(val_typ);
+   }
+
+/*
+ * abstr_typ - compute the type bits corresponding to an abstract type
+ *  from an abstract clause of a built-in operation.
+ */
+static void abstr_typ(il, typ)
+struct il_code *il;
+struct type *typ;
+   {
+   struct type *typ1;
+   struct type *typ2;
+   struct rentry *rec;
+   struct store *store;
+   struct compnt_info *compnts;
+   int num_bits;
+   int frst_bit;
+   int frst_cmpnt;
+   int num_comps;
+   int typcd;
+   int new_indx;
+   int i;
+   int j;
+   int indx;
+   int size;
+   int t_indx;
+#ifdef OptimizeType
+   struct typinfo *prmtyp;
+#else					/* OptimizeType */
+   unsigned int *prmtyp;
+#endif					/* OptimizeType */
+
+   if (il == NULL)
+       return;
+
+   switch (il->il_type) {
+      case IL_VarTyp:
+         /*
+          * type(<parameter>)
+          */
+         indx = il->u[0].fld->u[0].n; /* symbol table index of variable */
+         if (indx >= cur_symtyps->nsyms) {
+            prmtyp = any_typ;
+            size = n_rttyp;
+            }
+         else {
+            prmtyp = cur_symtyps->types[indx];
+            size = n_intrtyp;
+            }
+         if (typ->size < size)
+            size = typ->size;
+         MrgTyp(size, prmtyp, typ->bits);
+         break;
+
+      case IL_Store:
+         /*
+          * store[<type>]
+          */
+         typ1 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1); /* type to be "dereferenced" */
+
+         /*
+          * Dereference types that are Icon varaibles.
+          */
+         typ_deref(typ1->bits, typ->bits, 0);
+
+         /*
+          * "Dereference" aggregate compontents that are not Icon variables.
+          */
+         for (i = 0; i < num_cmpnts; ++i) {
+            if (!typecompnt[i].var) {
+               if (i == stv_typ) {
+                  /*
+                   * Substring trapped variable stores contain variable
+                   *  references, so the types are larger, but we cannot
+                   *  copy more than the destination holds.
+                   */
+                  size = n_intrtyp;
+                  if (typ->size < size)
+                    size = typ->size;
+                  }
+               else
+                  size = n_icntyp;
+               frst_bit = compnt_array[i].frst_bit;
+               num_bits = compnt_array[i].num_bits;
+               store = compnt_array[i].store;
+               for (j = 0; j < num_bits; ++j) {
+                  if (bitset(typ1->bits, frst_bit + j))
+                     MrgTyp(size, store->types[j], typ->bits);
+                  }
+               }
+            }
+
+         free_wktyp(typ1);
+         break;
+
+      case IL_Compnt:
+         /*
+          * <type>.<component>
+          */
+         typ1 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1); /* type */
+         i = il->u[1].n;
+         if (i == CM_Fields) {
+            /*
+             * The all_fields component must be handled differently
+             *  from the others.
+             */
+            frst_bit = type_array[rec_typ].frst_bit;
+            num_bits = type_array[rec_typ].num_bits;
+            for (i = 0; i < num_bits; ++i)
+               if (bitset(typ1->bits, frst_bit + i)) {
+                  rec = rec_map[i];
+                  for (j = 0; j < rec->nfields; ++j)
+                     set_typ(typ->bits, frst_fld + rec->frst_fld + j);
+                  }
+            }
+         else {
+            /*
+             * Use component information arrays to transform type bits to
+             *  the corresponding component bits.
+             */
+            frst_bit = type_array[typecompnt[i].aggregate].frst_bit;
+            num_bits = type_array[typecompnt[i].aggregate].num_bits;
+            frst_cmpnt = compnt_array[i].frst_bit;
+            if (!typecompnt[i].var && typ->size < n_rttyp)
+               break;   /* bad abstract type computation */ 
+            for (i = 0; i < num_bits; ++i)
+               if (bitset(typ1->bits, frst_bit + i))
+                  set_typ(typ->bits, frst_cmpnt + i);
+            free_wktyp(typ1);
+            }
+         break;
+
+      case IL_Union:
+         /*
+          * <type 1> ++ <type 2>
+          */
+         abstr_typ(il->u[0].fld, typ);
+         abstr_typ(il->u[1].fld, typ);
+         break;
+
+      case IL_Inter:
+         /*
+          * <type 1> ** <type 2>
+          */
+         typ1 = get_wktyp();
+         typ2 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1);
+         abstr_typ(il->u[1].fld, typ2);
+         size = n_rttyp;
+#ifdef OptimizeType
+         and_bits_to_packed(typ2->bits, typ1->bits, size);
+#else					/* OptimizeType */
+         for (i = 0; i < NumInts(size); ++i)
+            typ1->bits[i] &= typ2->bits[i];
+#endif					/* OptimizeType */
+         if (typ->size < size)
+            size = typ->size;
+         MrgTyp(size, typ1->bits, typ->bits);
+         free_wktyp(typ1);
+         free_wktyp(typ2);
+         break;
+
+      case IL_New:
+         /*
+          * new <type-name>(<type 1> , ...)
+          *
+          * If a type was not allocated for this node, use the default
+          *   one.
+          */
+         typ1 = get_wktyp();
+         typcd = il->u[0].n;      /* type code */
+         new_indx = type_array[typcd].new_indx;
+         t_indx = 0;                     /* default is first index of type */
+         if (cur_new != NULL && cur_new[new_indx] > 0)
+            t_indx = cur_new[new_indx];
+
+         /*
+          * This RTL expression evaluates to the "new" sub-type.
+          */
+         set_typ(typ->bits, type_array[typcd].frst_bit + t_indx);
+
+         /*
+          * Update stores for components based on argument types in the
+          *  "new" expression.
+          */
+         num_comps = icontypes[typcd].num_comps;
+         j = icontypes[typcd].compnts;
+         compnts = &compnt_array[j];
+         if (typcd == stv_typ) {
+            size = n_intrtyp;
+            }
+         else
+            size = n_icntyp;
+         for (i = 0; i < num_comps; ++i) {
+            ClrTyp(n_rttyp, typ1->bits);
+            abstr_typ(il->u[2 + i].fld, typ1);
+            ChkMrgTyp(size, typ1->bits, compnts[i].store->types[t_indx]);
+            }
+
+         free_wktyp(typ1);
+         break;
+
+      case IL_IcnTyp:
+         typcd_bits((int)il->u[0].n, typ);      /* type code */
+         break;
+      }
+   }
+
+/*
+ * eval_cond - evaluate the condition of in 'if' statement from a
+ *  built-in operation. The result can be both true and false because
+ *  of uncertainty and because more than one execution path may be
+ *  involved.
+ */
+static int eval_cond(il)
+struct il_code *il;
+   {
+   int cond1;
+   int cond2;
+
+   switch (il->il_type) {
+      case IL_Bang:
+         cond1 = eval_cond(il->u[0].fld);
+         cond2 = 0;
+         if (cond1 & MaybeTrue)
+            cond2 = MaybeFalse;
+         if (cond1 & MaybeFalse)
+            cond2 |= MaybeTrue;
+         return cond2;
+
+      case IL_And:
+         cond1 = eval_cond(il->u[0].fld);
+         cond2 = eval_cond(il->u[1].fld);
+         return (cond1 & cond2 & MaybeTrue) | ((cond1 | cond2) & MaybeFalse);
+
+      case IL_Cnv1:
+      case IL_Cnv2:
+         return eval_cnv((int)il->u[0].n, (int)il->u[1].fld->u[0].n,
+            0, NULL);
+
+      case IL_Def1:
+      case IL_Def2:
+         return eval_cnv((int)il->u[0].n, (int)il->u[1].fld->u[0].n,
+            1, NULL);
+
+      case IL_Is:
+         return eval_is((int)il->u[0].n, il->u[1].fld->u[0].n);
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * eval_cnv - evaluate the conversion of a variable to a specific type
+ *  to see if it may succeed or fail.
+ */
+int eval_cnv(typcd, indx, def, cnv_flags)
+int typcd;       /* type to convert to */
+int indx;        /* index into symbol table of variable */
+int def;         /* flag: conversion has a default value */
+int *cnv_flags;  /* return flag for detailed conversion information */
+   {
+   struct type *may_succeed;  /* types where conversion sometimes succeed */
+   struct type *must_succeed; /* types where conversion always succeeds */
+   struct type *must_cnv;     /* types where actual conversion is performed */
+   struct type *as_is;        /* types where value already has correct type */
+#ifdef OptimizeType
+   struct typinfo *typ;         /* possible types of the variable */
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int cond;
+   int i;
+#ifdef OptimizeType
+   unsigned int val1, val2;
+#endif					/* OptimizeType */
+
+   /*
+    * Conversions may succeed for strings, integers, csets, and reals.
+    *  Conversions may fail for any other types. In addition,
+    *  conversions to integer or real may fail for specific values.
+    */
+   if (indx >= cur_symtyps->nsyms)
+      return MaybeTrue | MaybeFalse;
+   typ = cur_symtyps->types[indx];
+
+   may_succeed = get_wktyp();
+   must_succeed = get_wktyp();
+   must_cnv = get_wktyp();
+   as_is = get_wktyp();
+
+   if (typcd == cset_typ || typcd == TypTCset) {
+      set_typ(as_is->bits, cset_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == str_typ || typcd == TypTStr) {
+      set_typ(as_is->bits, str_bit);
+
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == TypCStr) {
+      /*
+       * as_is is empty.
+       */
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == real_typ) {
+      set_typ(as_is->bits, real_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == TypCDbl) {
+      /*
+       * as_is is empty.
+       */
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == int_typ) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypCInt) {
+      /*
+       * Note that conversion from an integer to a C integer can be
+       *  done by changing the way the descriptor is accessed. It
+       *  is not considered a real conversion. Conversion may fail
+       *  even for integers if large integers are supported.
+       */
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      if (!largeints)
+         set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypEInt) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypECInt) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+
+      if (!largeints)
+         set_typ(must_succeed->bits, int_bit);
+      }
+
+   MrgTyp(n_icntyp, as_is->bits, may_succeed->bits);
+   MrgTyp(n_icntyp, must_cnv->bits, may_succeed->bits);
+   if (def) {
+      set_typ(may_succeed->bits, null_bit);
+      set_typ(must_succeed->bits, null_bit);
+      }
+
+   /*
+    * Determine if the conversion expression may evaluate to true or false.
+    */
+   cond = 0;
+
+/*
+   if (typ->bits == NULL) {
+      typ->bits = alloc_mem_typ(typ->size);
+      xfer_packed_types(typ);
+   }
+   if (may_succeed->bits->bits == NULL) {
+      may_succeed->bits->bits = alloc_mem_typ(may_succeed->bits->size);
+      xfer_packed_types(may_succeed->bits);
+   }
+   if (must_succeed->bits->bits == NULL) {
+      must_succeed->bits->bits = alloc_mem_typ(must_succeed->bits->size);
+      xfer_packed_types(must_succeed->bits);
+   }
+*/
+   for (i = 0; i < NumInts(n_intrtyp); ++i) {
+#ifdef OptimizeType
+      if ((typ->bits != NULL) && (may_succeed->bits->bits != NULL))  {
+         if (typ->bits[i] & may_succeed->bits->bits[i]) 
+            cond = MaybeTrue;
+      }
+      else if ((typ->bits == NULL) && (may_succeed->bits->bits != NULL)) {
+         val1 = get_bit_vector(typ, i);
+         if (val1 & may_succeed->bits->bits[i])
+            cond = MaybeTrue;
+      }
+      else if ((typ->bits != NULL) && (may_succeed->bits->bits == NULL)) {
+         val2 = get_bit_vector(may_succeed->bits, i);
+         if (typ->bits[i] & val2)
+            cond = MaybeTrue;
+      }
+      else {
+         val1 = get_bit_vector(typ, i);
+         val2 = get_bit_vector(may_succeed->bits, i);
+         if (val1 & val2)
+            cond = MaybeTrue;
+      }
+      if ((typ->bits != NULL) && (must_succeed->bits->bits != NULL))  {
+         if (typ->bits[i] & ~must_succeed->bits->bits[i]) 
+            cond |= MaybeFalse;
+      }
+      else if ((typ->bits == NULL) && (must_succeed->bits->bits != NULL)) {
+         val1 = get_bit_vector(typ, i);
+         if (val1 & ~must_succeed->bits->bits[i])
+            cond |= MaybeFalse;
+      }
+      else if ((typ->bits != NULL) && (must_succeed->bits->bits == NULL)) {
+         val2 = get_bit_vector(must_succeed->bits, i);
+         if (typ->bits[i] & ~val2) 
+            cond |= MaybeFalse;       
+      }
+      else { 
+         val1 = get_bit_vector(typ, i);
+         val2 = get_bit_vector(must_succeed->bits, i);
+         if (val1 & ~val2) 
+            cond |= MaybeFalse;       
+      }
+#else					/* OptimizeType */
+      if (typ[i] & may_succeed->bits[i])
+         cond = MaybeTrue;
+      if (typ[i] & ~must_succeed->bits[i])
+         cond |= MaybeFalse;
+#endif					/* OptimizeType */
+   }
+
+   /*
+    * See if more detailed information about the conversion is needed.
+    */
+   if (cnv_flags != NULL) {
+      *cnv_flags = 0;
+/*
+      if (as_is->bits == NULL) {
+         as_is->bits->bits = alloc_mem_typ(as_is->bits->size);
+         xfer_packed_types(as_is->bits);
+      }
+      if (must_cnv->bits->bits == NULL) {
+         must_cnv->bits->bits = alloc_mem_typ(must_cnv->bits->size);
+         xfer_packed_types(must_cnv->bits);
+      }
+*/
+      for (i = 0; i < NumInts(n_intrtyp); ++i) {
+#ifdef OptimizeType
+         if ((typ->bits != NULL) && (as_is->bits->bits != NULL)) {
+            if (typ->bits[i] & as_is->bits->bits[i]) 
+               *cnv_flags |= MayKeep;
+         }
+         else if ((typ->bits == NULL) && (as_is->bits->bits != NULL)) {
+            val1 = get_bit_vector(typ, i);
+            if (val1 & as_is->bits->bits[i])
+               *cnv_flags |= MayKeep;
+         }
+         else if ((typ->bits != NULL) && (as_is->bits->bits == NULL)) {
+            val2 = get_bit_vector(as_is->bits, i);
+            if (typ->bits[i] & val2)
+               *cnv_flags |= MayKeep;
+         }
+         else  {
+            val1 = get_bit_vector(typ, i);
+            val2 = get_bit_vector(as_is->bits, i);
+            if (val1 & val2)
+               *cnv_flags |= MayKeep;
+         }
+         if ((typ->bits != NULL) && (must_cnv->bits->bits != NULL))  {
+            if (typ->bits[i] & must_cnv->bits->bits[i]) 
+               *cnv_flags |= MayConvert;
+         }
+         else if ((typ->bits == NULL) && (must_cnv->bits->bits != NULL)) {
+            val1 = get_bit_vector(typ, i);
+            if (val1 & must_cnv->bits->bits[i])
+               *cnv_flags |= MayConvert;
+         }
+         else if ((typ->bits != NULL) && (must_cnv->bits->bits == NULL)) {
+            val2 = get_bit_vector(must_cnv->bits, i);
+            if (typ->bits[i] & val2)
+               *cnv_flags |= MayConvert;
+         }
+         else  {
+            val1 = get_bit_vector(typ, i);
+            val2 = get_bit_vector(must_cnv->bits, i);
+            if (val1 & val2)
+               *cnv_flags |= MayConvert;
+         }
+#else					/* OptimizeType */
+         if (typ[i] & as_is->bits[i])
+            *cnv_flags |= MayKeep;
+         if (typ[i] & must_cnv->bits[i])
+            *cnv_flags |= MayConvert;
+#endif					/* OptimizeType */
+         }
+      if (def && bitset(typ, null_bit))
+         *cnv_flags |= MayDefault;
+      }
+
+   free_wktyp(may_succeed);
+   free_wktyp(must_succeed);
+   free_wktyp(must_cnv);
+   free_wktyp(as_is);
+
+   return cond;
+   }
+
+/*
+ * eval_is - evaluate the result of an 'is' expression within a built-in
+ *  operation.
+ */
+int eval_is(typcd, indx)
+int typcd;
+int indx;
+   {
+   int cond;
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+
+   if (indx >= cur_symtyps->nsyms)
+      return MaybeTrue | MaybeFalse;
+   typ = cur_symtyps->types[indx];
+   if (has_type(typ, typcd, 0))
+      cond = MaybeTrue;
+   else
+      cond = 0;
+   if (other_type(typ, typcd))
+      cond |= MaybeFalse;
+   return cond;
+   }
+
+/*
+ * eval_arith - determine which cases of an arith_case may be taken based
+ *   on the types of its arguments.
+ */
+void eval_arith(indx1, indx2, maybe_int, maybe_dbl)
+int indx1;
+int indx2;
+int *maybe_int;
+int *maybe_dbl;
+   {
+#ifdef OptimizeType
+   struct typinfo *typ1;         /* possible types of first variable */
+   struct typinfo *typ2;         /* possible types of second variable */
+#else					/* OptimizeType */
+   unsigned int *typ1;         /* possible types of first variable */
+   unsigned int *typ2;         /* possible types of second variable */
+#endif					/* OptimizeType */
+   int int1 = 0;
+   int int2 = 0;
+   int dbl1 = 0;
+   int dbl2 = 0;
+
+   typ1 = cur_symtyps->types[indx1];
+   typ2 = cur_symtyps->types[indx2];
+
+   /*
+    * First see what might result if you do a convert to numeric on each
+    *  variable.
+    */
+   if (bitset(typ1, int_bit))
+      int1 = 1;
+   if (bitset(typ1, real_bit))
+      dbl1 = 1;
+   if (bitset(typ1, str_bit) || bitset(typ1, cset_bit)) {
+      int1 = 1;
+      dbl1 = 1;
+      }
+   if (bitset(typ2, int_bit))
+      int2 = 1;
+   if (bitset(typ2, real_bit))
+      dbl2 = 1;
+   if (bitset(typ2, str_bit) || bitset(typ2, cset_bit)) {
+      int2 = 1;
+      dbl2 = 1;
+      }
+
+   /*
+    * Use the conversion information to figure out what type of arithmetic
+    *  might be done.
+    */
+   if (int1 && int2)
+      *maybe_int = 1;
+   else
+      *maybe_int = 0;
+
+   *maybe_dbl = 0;
+   if (dbl1 && dbl2)
+      *maybe_dbl = 1;
+   else if (dbl1 && int2)
+      *maybe_dbl = 1;
+   else if (int1 && dbl2)
+      *maybe_dbl = 1;
+   }
+
+/*
+ * type_case - Determine which cases are selected in a type_case
+ *  statement. This routine is used by both type inference and
+ *  the code generator: a different fnc is passed in each case.
+ *  In addition, the code generator passes a case_anlz structure.
+ */
+int type_case(il, fnc, case_anlz)
+struct il_code *il;
+int (*fnc)();
+struct case_anlz *case_anlz;
+   {
+   int *typ_vect;
+   int i, j;
+   int num_cases;
+   int num_types;
+   int indx;
+   int sym_indx;
+   int typcd;
+   int use_dflt;
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int select;
+   struct type *wktyp;
+
+   /*
+    * Make a copy of the type of the variable the type case is
+    *  working on.
+    */
+   sym_indx = il->u[0].fld->u[0].n; /* symbol table index */
+   if (sym_indx >= cur_symtyps->nsyms)
+     typ = any_typ;  /* variable is not a parameter, don't know type */
+   else
+     typ = cur_symtyps->types[sym_indx];
+   wktyp = get_wktyp();
+   CpyTyp(n_intrtyp, typ, wktyp->bits);
+   typ = wktyp->bits;
+
+   /*
+    * Loop through all the case clauses.
+    */
+   num_cases = il->u[1].n;
+   indx = 2;
+   for (i = 0; i < num_cases; ++i) {
+      /*
+       * For each of the types selected by this clause, see if the variable's
+       *  type bit vector contains that type and delete the type from the
+       *  bit vector (so we know if we need the default when we are done).
+       */
+      num_types = il->u[indx++].n;
+      typ_vect = il->u[indx++].vect;
+      select = 0;
+      for (j = 0; j < num_types; ++j)
+         if (has_type(typ, typ_vect[j], 1)) {
+            typcd = typ_vect[j];
+            select += 1;
+            }
+
+      if (select > 0) {
+         fnc(il->u[indx].fld);       /* action */
+
+         /*
+          * If this routine was called by the code generator, we need to
+          *  return extra information.
+          */
+         if (case_anlz != NULL) {
+            ++case_anlz->n_cases;
+            if (select == 1) {
+               if (case_anlz->il_then == NULL) {
+                  case_anlz->typcd = typcd;
+                  case_anlz->il_then = il->u[indx].fld;
+                  }
+               else if (case_anlz->il_else == NULL)
+                  case_anlz->il_else = il->u[indx].fld;
+               }
+            else {
+               /*
+                * There is more than one possible type that will cause
+                *  us to select this case. It can only be used in the "else".
+                */
+               if (case_anlz->il_else == NULL)
+                  case_anlz->il_else = il->u[indx].fld;
+               else
+                  case_anlz->n_cases = 3; /* force no inlining. */
+               }
+            }
+         }
+      ++indx;
+      }
+
+   /*
+    * If there are types that have not been handled, indicate this by
+    *  returning the index of the default clause.
+    */
+   use_dflt = 0;
+   for (i = 0; i < n_intrtyp; ++i)
+      if (bitset(typ, i)) {
+         use_dflt = 1;
+         break;
+         }
+   free_wktyp(wktyp);
+   if (use_dflt)
+      return indx;
+   else
+      return -1;
+   }
+
+/*
+ * gen_inv - general invocation. The argument list is set up, perform
+ *  abstract interpretation on each possible things being invoked.
+ */
+static void gen_inv(typ, n)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+nodeptr n;
+   {
+   int ret_flag = 0;
+   struct store *s_store;
+   struct store *store;
+   struct gentry *gptr;
+   struct implement *ip;
+   struct type *prc_typ;
+   int frst_prc;
+   int num_prcs;
+   int i;
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) {\n", n->n_file, n->n_line, n->n_col);
+      trc_indent = "   ";
+      }
+#endif					/* TypTrc */
+
+   frst_prc = type_array[proc_typ].frst_bit;
+   num_prcs = type_array[proc_typ].num_bits;
+
+   /*
+    * Dereference the type of the thing being invoked.
+    */
+   prc_typ = get_wktyp();
+   typ_deref(typ, prc_typ->bits, 0);
+
+   s_store = succ_store;
+   store = get_store(1);
+
+   if (bitset(prc_typ->bits, str_bit) ||
+       bitset(prc_typ->bits, cset_bit) ||
+       bitset(prc_typ->bits, int_bit) ||
+       bitset(prc_typ->bits, real_bit)) {
+      /*
+       * Assume integer invocation; any argument may be the result type.
+       */
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         fprintf(trcfile, "%s (%d,%d) %s{i}(", n->n_file, n->n_line, n->n_col,
+            trc_indent);
+         }
+#endif					/* TypTrc */
+
+      for (i = 0; i < num_args; ++i) {
+         MrgTyp(n_intrtyp, arg_typs->types[i], n->type);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         }
+
+      /*
+       * Integer invocation may succeed or fail.
+       */
+      ret_flag |= DoesRet | DoesFail;
+      mrg_store(s_store, store);
+      mrg_store(s_store, fail_store);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         fprintf(trcfile, ")  =>>  ");
+         prt_typ(trcfile, n->type);
+         fprintf(trcfile, "\n");
+         }
+#endif					/* TypTrc */
+      }
+
+   if (bitset(prc_typ->bits, str_bit) ||
+       bitset(prc_typ->bits, cset_bit)) {
+      /*
+       * Assume string invocation; add all procedure types to the thing
+       *  being invoked.
+       */
+      for (i = 0; i < num_prcs; ++i)
+         set_typ(prc_typ->bits, frst_prc + i);
+      }
+
+   if (bitset(prc_typ->bits, frst_prc)) {
+      /*
+       * First procedure type represents all operators that are
+       *  available via string invocation. Scan the operator table
+       *  looking for those that are in the string invocation table.
+       *  Note, this is not particularly efficient or precise.
+       */
+      for (i = 0; i < IHSize; ++i)
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            if (ip->iconc_flgs & InStrTbl) {
+               succ_store = cpy_store(s_store);
+               infer_impl(ip, n, n->symtyps, n->type);
+               ret_flag |= ip->ret_flag;
+               mrg_store(succ_store, store);
+               free_store(succ_store);
+               }
+      }
+
+   /*
+    * Check for procedure, built-in, and record constructor types
+    *  and perform type inference on invocations of them.
+    */
+   for (i = 1; i < num_prcs; ++i)
+      if (bitset(prc_typ->bits, frst_prc + i)) {
+         succ_store = cpy_store(s_store);
+         gptr = proc_map[i];
+         switch (gptr->flag & (F_Proc | F_Builtin | F_Record)) {
+            case F_Proc:
+               infer_prc(gptr->val.proc, n);
+               ret_flag |= gptr->val.proc->ret_flag;
+               break;
+            case F_Builtin:
+               infer_impl(gptr->val.builtin, n, n->symtyps, n->type);
+               ret_flag |= gptr->val.builtin->ret_flag;
+               break;
+            case F_Record:
+               infer_con(gptr->val.rec, n);
+               ret_flag |= DoesRet | (err_conv ? DoesFail : 0);
+               break;
+            }
+         mrg_store(succ_store, store);
+         free_store(succ_store);
+         }
+
+   /*
+    * If error conversion is supported and a non-procedure value
+    *   might be invoked, assume the invocation can fail.
+    */
+   if (err_conv && other_type(prc_typ->bits, proc_typ))
+      mrg_store(s_store, fail_store);
+
+   free_store(s_store);
+   succ_store = store;
+   chk_succ(ret_flag, n->store);
+
+   free_wktyp(prc_typ);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) }\n", n->n_file, n->n_line, n->n_col);
+      trc_indent = "";
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * get_wktyp - get a dynamically allocated bit vector to use as a
+ *  work area for doing type computations.
+ */
+static struct type *get_wktyp()
+   {
+   struct type *typ;
+
+   if ((typ = type_pool) == NULL) {
+      typ = NewStruct(type);
+      typ->size = n_rttyp;
+      typ->bits = alloc_typ(n_rttyp);
+      }
+   else {
+      type_pool = type_pool->next;
+      ClrTyp(n_rttyp, typ->bits);
+      }
+   return typ;
+   }
+
+/*
+ * free_wktyp - free a dynamically allocated type bit vector.
+ */
+static void free_wktyp(typ)
+struct type *typ;
+   {
+   typ->next = type_pool;
+   type_pool = typ;
+   }
+
+#ifdef TypTrc
+
+/*
+ * ChkSep - supply a separating space if this is not the first item.
+ */
+#define ChkSep(n) (++n > 1 ? " " : "")
+
+/*
+ * prt_typ - print a type that can include variable references.
+ */
+static void prt_typ(file, typ)
+FILE *file;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+   {
+   struct gentry *gptr;
+   struct lentry *lptr;
+   char *name;
+   int i, j, k;
+   int n;
+   int frst_bit;
+   int num_bits;
+   char *abrv;
+
+   fprintf(trcfile, "{");
+   n = 0;
+   /*
+    * Go through the types and see any sub-types are present.
+    */
+   for (k = 0; k < num_typs; ++k) {
+      frst_bit = type_array[k].frst_bit;
+      num_bits = type_array[k].num_bits;
+      abrv = icontypes[k].abrv;
+      if (k == proc_typ) {
+         /*
+          * procedures, record constructors, and built-in functions.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i)) {
+               if (i == 0)
+                  fprintf(file, "%sops", ChkSep(n));
+               else {
+                  gptr = proc_map[i];
+                  switch (gptr->flag & (F_Proc | F_Builtin | F_Record)) {
+                     case F_Proc:
+                        fprintf(file, "%s%s:%s", ChkSep(n), abrv, gptr->name);
+                        break;
+                     case F_Builtin:
+                        fprintf(file, "%sfnc:%s", ChkSep(n), gptr->name);
+                        break;
+                     case F_Record:
+                        fprintf(file, "%sconstr:%s", ChkSep(n), gptr->name);
+                        break;
+                     }
+                  }
+               }
+         }
+      else if (k == rec_typ) {
+         /*
+          * records - include record name.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s:%s", ChkSep(n), abrv, rec_map[i]->name);
+         }
+      else if (icontypes[k].support_new | k == coexp_typ) {
+         /*
+          * A type with sub-types.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s%d", ChkSep(n), abrv, i);
+         }
+      else {
+         /*
+          * A type with no subtypes.
+          */
+         if (bitset(typ, frst_bit))
+            fprintf(file, "%s%s", ChkSep(n), abrv);
+         }
+      }
+
+   for (k = 0; k < num_cmpnts; ++k) {
+      if (typecompnt[k].var) {
+         /*
+          * Structure component that is a variable.
+          */
+         frst_bit = compnt_array[k].frst_bit;
+         num_bits = compnt_array[k].num_bits;
+         abrv = typecompnt[k].abrv;
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s%d", ChkSep(n), abrv, i);
+         }
+      }
+
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(typ, frst_fld + i))
+         fprintf(file, "%sfld%d", ChkSep(n), i);
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_nmgbl; ++i)
+      if (bitset(typ, frst_gbl + i)) {
+         name = NULL;
+         for (j = 0; j < GHSize && name == NULL; j++)
+            for (gptr = ghash[j]; gptr != NULL && name == NULL; 
+               gptr = gptr->blink)
+                  if (gptr->index == i)
+                     name = gptr->name;
+         for (lptr = cur_proc->statics; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         /*
+          * Static variables may be returned and dereferenced in a procedure
+          *  they don't belong to.
+          */
+         if (name == NULL)
+            name = "?static?";
+         fprintf(file, "%svar:%s", ChkSep(n), name);
+         }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(typ, frst_loc + i)) {
+         name = NULL;
+         for (lptr = cur_proc->args; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         for (lptr = cur_proc->dynams; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         /*
+          * Local variables types may appear in the wrong procedure due to
+          *  substring trapped variables and the inference of impossible
+          *  execution paths. Make sure we don't end up with a NULL name.
+          */
+         if (name == NULL)
+            name = "?";
+         fprintf(file, "%svar:%s", ChkSep(n), name);
+         }
+
+   fprintf(trcfile, "}");
+   }
+
+/*
+ * prt_d_typ - dereference a type and print it.
+ */
+static void prt_d_typ(file, typ)
+FILE *file;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+{
+   struct type *wktyp;
+
+   wktyp = get_wktyp();
+   typ_deref(typ, wktyp->bits, 0);
+   prt_typ(file, wktyp->bits);
+   free_wktyp(wktyp);
+}
+#endif					/* TypTrc */
+
+/*
+ * get_argtyp - get an array of pointers to type bit vectors for use
+ *  in constructing an argument list. The array is large enough for the
+ *  largest argument list.
+ */ 
+static struct argtyps *get_argtyp()
+   {
+   struct argtyps *argtyps;
+
+   if ((argtyps = argtyp_pool) == NULL)
+#ifdef OptimizeType
+     argtyps = (struct argtyps *)alloc((unsigned int)(sizeof(struct argtyps) +
+      ((max_prm - 1) * sizeof(struct typinfo *))));
+#else					/* OptimizeType */
+     argtyps = (struct argtyps *)alloc((unsigned int)(sizeof(struct argtyps) +
+      ((max_prm - 1) * sizeof(unsigned int *))));
+#endif					/* OptimizeType */
+   else 
+      argtyp_pool = argtyp_pool->next;
+   return argtyps;
+   }
+
+/*
+ * free_argtyp - free array of pointers to type bitvectors.
+ */
+static void free_argtyp(argtyps)
+struct argtyps *argtyps;
+   {
+   argtyps->next = argtyp_pool;
+   argtyp_pool = argtyps;
+   }
+
+/*
+ * varsubtyp - examine a type and determine what kinds of variable
+ *  subtypes it has and whether it has any non-variable subtypes.
+ *  If the type consists of a single named variable, return its symbol
+ *  table entry through the parameter "singl".
+ */
+int varsubtyp(typ, singl)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+struct lentry **singl;
+   {
+   struct store *stv_stor;
+   int subtypes;
+   int n_types;
+   int var_indx;
+   int frst_bit;
+   int num_bits;
+   int i, j;
+
+
+   subtypes = 0;
+   n_types = 0;
+   var_indx = -1;
+
+   /*
+    * check for non-variables.
+    */
+   for (i = 0; i < n_icntyp; ++i)
+      if (bitset(typ, i)) {
+         subtypes |= HasVal;
+         ++n_types;
+         }
+
+   /* 
+    * Predefined variable types.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].deref != DrfNone) {
+         frst_bit = type_array[i].frst_bit;
+         num_bits = type_array[i].num_bits;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(typ, frst_bit + j)) {
+               if (i == stv_typ) {
+                  /*
+                   * We have found substring trapped variable j, see whether it
+                   *  references locals or globals.
+                   */
+                  if (do_typinfer) {
+                     stv_stor = compnt_array[str_var].store;
+                     subtypes |= varsubtyp(stv_stor->types[j], NULL);
+                     }
+                  else
+                     subtypes |= HasLcl | HasPrm | HasGlb;
+                  }
+               else
+                  subtypes |= HasGlb;
+               ++n_types;
+               }
+            }
+         }
+      }
+
+   /*
+    * Aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      if (typecompnt[i].var) {
+         frst_bit = compnt_array[i].frst_bit;
+         num_bits = compnt_array[i].num_bits;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(typ, frst_bit + j)) {
+               subtypes |= HasGlb;
+               ++n_types;
+               }
+            }
+         }
+      }
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(typ, frst_fld + i)) {
+         subtypes |= HasGlb;
+         ++n_types;
+         }
+
+   /*
+    * global variables, including statics
+    */
+   for (i = 0; i < n_gbl; ++i) {
+      if (bitset(typ, frst_gbl + i)) {
+         subtypes |= HasGlb;
+         var_indx = i;
+         ++n_types;
+         }
+      }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i) {
+      if (bitset(typ, frst_loc + i)) {
+         if (i < Abs(cur_proc->nargs))
+            subtypes |= HasPrm;
+         else
+            subtypes |= HasLcl;
+         var_indx = n_gbl + i;
+         ++n_types;
+         }
+      }
+
+   if (singl != NULL) {
+      /*
+       *  See if the type consists of a single named variable.
+       */
+      if (n_types == 1 && var_indx != -1)
+         *singl = cur_proc->vartypmap[var_indx];
+      else
+         *singl = NULL;
+      }
+
+   return subtypes;
+   }
+
+/*
+ * mark_recs - go through the list of parent records for this field
+ *  and mark those that are in the type. Also gather information
+ *  to help generate better code.
+ */
+void mark_recs(fp, typ, num_offsets, offset, bad_recs)
+struct fentry *fp;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int *num_offsets;
+int *offset;
+int *bad_recs;
+   {
+   struct par_rec *rp;
+   struct type *wktyp;
+   int frst_rec;
+   
+   *num_offsets = 0;
+   *offset = -1;
+   *bad_recs = 0;
+
+   wktyp = get_wktyp();
+   CpyTyp(n_icntyp, typ, wktyp->bits);
+
+   /*
+    * For each record containing this field, see if the record is
+    *  in the type.
+    */
+   frst_rec = type_array[rec_typ].frst_bit;
+   for (rp = fp->rlist; rp != NULL; rp = rp->next) {
+      if (bitset(wktyp->bits, frst_rec + rp->rec->rec_num)) {
+         /*
+          * This record is in the type.
+          */
+         rp->mark = 1;
+         clr_typ(wktyp->bits, frst_rec + rp->rec->rec_num);
+         if (*offset != rp->offset) {
+            *offset = rp->offset;
+            *num_offsets += 1;
+            }
+        }
+      }
+
+   /*
+    * Are there any records that do not contain this field?
+    */
+   *bad_recs = has_type(wktyp->bits, rec_typ, 0);
+   free_wktyp(wktyp);
+   }
+
+/*
+ * past_prms - return true if execution might continue past the parameter
+ *  evaluation. If a parameter has no type, this will not happen.
+ */
+int past_prms(n)
+nodeptr n;
+   {
+   struct implement *impl;
+   struct symtyps *symtyps;
+   int nparms;
+   int nargs;
+   int flag;
+   int i, j;
+
+   nargs = Val0(n);
+   impl = Impl1(n);
+   symtyps = n->symtyps;
+   nparms = impl->nargs;
+
+   if (symtyps == NULL)
+      return 1;
+
+   j = 0;
+   for (i = 0; i < nparms; ++i) {
+      flag = impl->arg_flgs[i];
+      if (flag & VarPrm && i >= nargs)
+          break;       /* no parameters for variable part of arg list */
+      if (flag & RtParm) {
+         if (is_empty(symtyps->types[j]))
+            return 0;
+         ++j;
+         }
+      if (flag & DrfPrm) {
+         if (is_empty(symtyps->types[j]))
+            return 0;
+         ++j;
+         }
+      }
+   return 1;
+   }