Imported Upstream version 9.5.0upstream/9.5.0upstream

28 files changed, 0 insertions, 23362 deletions

diff --git a/src/iconc/Makefile b/src/iconc/Makefile
deleted file mode 100644
index bce6aa8..0000000
--- a/src/iconc/Makefile
+++ /dev/null
@@ -1,73 +0,0 @@
-#  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
deleted file mode 100644
index 108cd15..0000000
--- a/src/iconc/ccode.c
+++ /dev/null
@@ -1,4954 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 2d0cb6f..0000000
--- a/src/iconc/ccode.h
+++ /dev/null
@@ -1,252 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 5b86189..0000000
--- a/src/iconc/ccomp.c
+++ /dev/null
@@ -1,130 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 301a602..0000000
--- a/src/iconc/cglobals.h
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- *  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
deleted file mode 100644
index a48e621..0000000
--- a/src/iconc/cgrammar.c
+++ /dev/null
@@ -1,221 +0,0 @@
-/*
- * 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
deleted file mode 100644
index af4298f..0000000
--- a/src/iconc/chkinv.c
+++ /dev/null
@@ -1,545 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 8e7d657..0000000
--- a/src/iconc/clex.c
+++ /dev/null
@@ -1,18 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 6daf5c4..0000000
--- a/src/iconc/cmain.c
+++ /dev/null
@@ -1,424 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 720a495..0000000
--- a/src/iconc/cmem.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 8ca5bd1..0000000
--- a/src/iconc/codegen.c
+++ /dev/null
@@ -1,1918 +0,0 @@
-/*
- * 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
deleted file mode 100644
index b29986d..0000000
--- a/src/iconc/cparse.c
+++ /dev/null
@@ -1,1940 +0,0 @@
-# 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
deleted file mode 100644
index a32b982..0000000
--- a/src/iconc/cproto.h
+++ /dev/null
@@ -1,165 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 8e764e3..0000000
--- a/src/iconc/csym.c
+++ /dev/null
@@ -1,853 +0,0 @@
-/*
- * 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
deleted file mode 100644
index cf104af..0000000
--- a/src/iconc/csym.h
+++ /dev/null
@@ -1,380 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 1e95e98..0000000
--- a/src/iconc/ctoken.h
+++ /dev/null
@@ -1,111 +0,0 @@
-# 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
deleted file mode 100644
index 7d33ac5..0000000
--- a/src/iconc/ctrans.c
+++ /dev/null
@@ -1,184 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 3e03d06..0000000
--- a/src/iconc/ctrans.h
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- *  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
deleted file mode 100644
index 170a631..0000000
--- a/src/iconc/ctree.c
+++ /dev/null
@@ -1,777 +0,0 @@
-/*
- * 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
deleted file mode 100644
index d38d3c4..0000000
--- a/src/iconc/ctree.h
+++ /dev/null
@@ -1,200 +0,0 @@
-/*
- * 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
deleted file mode 100644
index fdd3e50..0000000
--- a/src/iconc/dbase.c
+++ /dev/null
@@ -1,196 +0,0 @@
-/*
- * 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
deleted file mode 100644
index b8c06e0..0000000
--- a/src/iconc/fixcode.c
+++ /dev/null
@@ -1,372 +0,0 @@
-/*
- * 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
deleted file mode 100644
index d4110f9..0000000
--- a/src/iconc/incheck.c
+++ /dev/null
@@ -1,802 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 234229c..0000000
--- a/src/iconc/inline.c
+++ /dev/null
@@ -1,2007 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 4fbb288..0000000
--- a/src/iconc/ivalues.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 9a4a7b5..0000000
--- a/src/iconc/lifetime.c
+++ /dev/null
@@ -1,496 +0,0 @@
-/*
- * 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
deleted file mode 100644
index cd3a3ef..0000000
--- a/src/iconc/types.c
+++ /dev/null
@@ -1,893 +0,0 @@
-/*
- * 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
deleted file mode 100644
index 8a96e23..0000000
--- a/src/iconc/typinfer.c
+++ /dev/null
@@ -1,5189 +0,0 @@
-/*
- * 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;
-   }