Initial upstream version 9.4.3upstream/9.4.3

252 files changed, 117118 insertions, 0 deletions

diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..2aaa971
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,31 @@
+#  Icon source Makefile, normally used only for cleanup.
+
+
+what:
+	@echo "What do you want to make?"
+
+Clean Pure:
+	cd iconc;	rm -f *.o iconc
+	cd common;	rm -f *.o doincl patchstr infer
+	cd preproc;	rm -f *.o pp
+	cd rtt;		rm -f *.o rtt
+	cd runtime;	rm -f *.o *.c rt.db rt.a rttcur.lst rttfull.lst iconx
+	cd icont;	rm -f *.o icont hdr.h ixhdr.hdr newhdr
+	cd wincap;	rm -f *.o *.a
+	cd xpm;		rm -f *.o *.a
+# force full runtime system rebuild
+	touch h/define.h
+	rm -f h/arch.h
+
+
+#  The following entry forces rebuilding of everthing from first-generation
+#  files, even files not normally recreated.  Doing this requires uncommenting
+#  some lines in common/Makefile, icont/Makefile, and iconc/Makefile.
+
+Force-rebuild: Clean
+	cd h; rm -f kdefs.h
+	cd common; rm -f *.o yacctok.h lextab.h icontype.h \
+		doincl fixgram mktoktab patchstr pscript typespec
+	cd icont; rm -f *.o icont mkkwd trash \
+		hdr.h keyword.h tgram.g ttoken.h tparse.c
+	cd iconc; rm -f *.o iconc cgram.g ctoken.h cparse.h
diff --git a/src/common/Makefile b/src/common/Makefile
new file mode 100644
index 0000000..bb5546a
--- /dev/null
+++ b/src/common/Makefile
@@ -0,0 +1,91 @@
+include ../../Makedefs
+
+
+OBJS =	long.o getopt.o time.o filepart.o identify.o strtbl.o rtdb.o\
+	munix.o literals.o rswitch.o alloc.o long.o getopt.o time.o\
+	xwindow.o dlrgint.o ipp.o
+
+common:		doincl $(OBJS) gpxmaybe
+
+doincl:		doincl.c ../h/arch.h
+		$(CC) $(CFLAGS) -o doincl doincl.c
+		-./doincl -o ../../bin/rt.h ../h/rt.h
+
+patchstr:	patchstr.c
+		$(CC) $(CFLAGS) -o patchstr patchstr.c
+
+gpxmaybe:
+		-if [ "x$(XL)" != "x" ]; then $(MAKE) $(GDIR); fi
+
+xpm:
+		cd ../xpm; $(MAKE) libXpm.a
+		cp -p ../xpm/libXpm.a ../../bin/libIgpx.a
+
+wincap:		
+		cd ../wincap; $(MAKE) libWincap.a
+		cp -u ../wincap/libWincap.a ../../bin/libIgpx.a
+
+$(OBJS): ../h/define.h ../h/arch.h ../h/config.h ../h/cstructs.h \
+	  ../h/typedefs.h ../h/mproto.h ../h/cpuconf.h
+
+../h/arch.h:	infer.c
+		$(CC) $(CFLAGS) -o infer infer.c
+		./infer >../h/arch.h
+
+identify.o: ../h/version.h
+
+ipp.o: ../h/features.h
+
+literals.o: ../h/esctab.h
+
+rtdb.o: ../h/version.h icontype.h
+
+dlrgint.o: ../h/rproto.h ../h/rexterns.h ../h/rmacros.h ../h/rstructs.h
+
+xwindow.o: ../h/graphics.h ../h/xwin.h
+
+#  for rswitch, $(CFLAGS) is deliberately omitted  (-O may cause problems)
+rswitch.o: ../h/define.h ../h/arch.h $(RSW)
+	$(CC) -c $(RSW)
+
+
+#  The following section is needed if changes are made to the Icon grammar,
+#  but it is not run as part of the normal installation process.  If it is
+#  needed, it is run by changing ../icont/Makefile and/or ../iconc/Makefile;
+#  see the comments there for details.  icont must be in the search path
+#  for this section to work.
+
+gfiles:			lextab.h yacctok.h fixgram pscript
+
+lextab.h yacctok.h:	tokens.txt op.txt mktoktab
+			./mktoktab
+
+mktoktab:		mktoktab.icn
+			icont -s mktoktab.icn
+
+fixgram:		fixgram.icn
+			icont -s fixgram.icn
+
+pscript:		pscript.icn
+			icont -s pscript.icn
+
+
+
+#  The following section is commented out because it does not need to be
+#  performed unless changes are made to typespec.txt. Such changes
+#  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 section would be attempted.
+#
+#  Note that if any changes are made to the file mentioned above, the
+#  comment characters at the beginning of the following lines should be
+#  removed.
+#
+#  Note that icont must be on your search path for this.
+#
+#
+#icontype.h: typespec.txt typespec
+#	typespec <typespec.txt >icontype.h
+#
+#typespec: typespec.icn
+#	icont typespec
diff --git a/src/common/alloc.c b/src/common/alloc.c
new file mode 100644
index 0000000..7a048b1
--- /dev/null
+++ b/src/common/alloc.c
@@ -0,0 +1,65 @@
+/*
+ * alloc.c -- allocation routines for the Icon compiler
+ */
+
+#include "../h/gsupport.h"
+
+#ifdef TypTrc
+   int typealloc = 0;		/* type allocation switch */
+   long typespace = 0;		/* type allocation amount */
+#endif					/* TypTrc */
+
+/*
+ * salloc - allocate and initialize string
+ */
+
+char *salloc(s)
+char *s;
+   {
+   register char *s1;
+
+   s1 = (char *)malloc(strlen(s) + 1);
+   if (s1 == NULL) {
+      fprintf(stderr, "salloc(%d): out of memory\n", (int)strlen(s) + 1);
+      exit(EXIT_FAILURE);
+      }
+   return strcpy(s1, s);
+   }
+
+/*
+ * alloc - allocate n bytes
+ */
+
+pointer alloc(n)
+unsigned int n;
+   {
+   register pointer a;
+
+#ifdef AllocTrace
+   static int sum = 0;
+#endif					/* AllocTrace */
+
+#ifdef TypTrc
+   if (typealloc)
+      typespace += (long)n;
+#endif					/* TypTrc */
+
+#ifdef AllocTrace
+   sum = sum + n;
+   if (sum > 5000) {
+      fprintf(stderr, ".");
+      fflush(stderr);
+      sum = 0;
+      };
+#endif					/* AllocTrace */
+
+   if (n == 0)				/* Work-around for 0 allocation */
+      n = 1;
+
+   a = calloc(n, sizeof(char));
+   if (a == NULL) {
+      fprintf(stderr, "alloc(%d): out of memory\n", (int)n);
+      exit(EXIT_FAILURE);
+      }
+   return a;
+   }
diff --git a/src/common/dlrgint.c b/src/common/dlrgint.c
new file mode 100644
index 0000000..3ca79d1
--- /dev/null
+++ b/src/common/dlrgint.c
@@ -0,0 +1,252 @@
+/*
+ * dlrgint.c - versions of "large integer" routines for compiled programs
+ *   that do not support large integers.
+ */
+#define COMPILER 1
+#include "../h/rt.h"
+
+/*
+ *****************************************************************
+ *
+ * Routines in the first set are only called when large integers
+ *  exist and thus these versions will never be called. They need
+ *  only have the correct signature and compile without error.
+ */
+
+/*
+ *  bignum -> file
+ */
+void bigprint(f, da)
+FILE *f;
+dptr da;
+   {
+   }
+
+/*
+ *  bignum -> real
+ */
+double bigtoreal(da)
+dptr da;
+   {
+   return 0.0;
+   }
+
+/*
+ *  bignum -> string
+ */
+int bigtos(da, dx)
+dptr da, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  da -> dx
+ */
+int cpbignum(da, dx)
+dptr da, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  da / db -> dx
+ */
+int bigdiv(da, db, dx)
+dptr da, db, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  da % db -> dx
+ */
+int bigmod(da, db, dx)
+dptr da, db, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  iand(da, db) -> dx
+ */
+int bigand(da, db, dx)
+dptr da, db, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  ior(da, db) -> dx
+ */
+int bigor(da, db, dx)
+dptr da, db, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  xor(da, db) -> dx
+ */
+int bigxor(da, db, dx)
+dptr da, db, dx;
+   {
+   return 0;
+   }
+
+/*
+ *  negative if da < db
+ *  zero if da == db
+ *  positive if da > db
+ */
+word bigcmp(da, db)
+dptr da, db;
+   {
+   return (word)0;
+   }
+
+/*
+ *  ?da -> dx
+ */
+int bigrand(da, dx)
+dptr da, dx;
+   {
+   return 0;
+   }
+
+/*
+ *************************************************************
+ *
+ * The following routines are called when overflow has occurred
+ *   during ordinary arithmetic.
+ */
+
+/*
+ *  da + db -> dx
+ */
+int bigadd(da, db, dx)
+dptr da, db;
+dptr dx;
+   {
+   t_errornumber = 203;
+   t_errorvalue = nulldesc;
+   t_have_val = 0;
+   return Error;
+   }
+
+/*
+ *  da * db -> dx
+ */
+int bigmul(da, db, dx)
+dptr da, db, dx;
+   {
+   t_errornumber = 203;
+   t_errorvalue = nulldesc;
+   t_have_val = 0;
+   return Error;
+   }
+
+/*
+ *  -i -> dx
+ */
+int bigneg(da, dx)
+dptr da, dx;
+   {
+   t_errornumber = 203;
+   t_errorvalue = nulldesc;
+   t_have_val = 0;
+   return Error;
+   }
+
+/*
+ *  da - db -> dx
+ */
+int bigsub(da, db, dx)
+dptr da, db, dx;
+   {
+   t_errornumber = 203;
+   t_errorvalue = nulldesc;
+   t_have_val = 0;
+   return Error;
+   }
+
+/*
+ * ********************************************************
+ *
+ * The remaining routines each requires different handling.
+ */
+
+/*
+ *  real -> bignum
+ */
+int realtobig(da, dx)
+dptr da, dx;
+   {
+   return Failed;  /* conversion cannot be done */
+   }
+
+/*
+ *  da ^ db -> dx
+ */
+int bigpow(da, db, dx)
+dptr da, db, dx;
+   {
+   C_integer r;
+   extern int over_flow;
+
+   /*
+    * Just do ordinary interger exponentiation and check for overflow.
+    */
+   r = iipow(IntVal(*da), IntVal(*db));
+   if (over_flow) {
+      k_errornumber = 203;
+      k_errortext = "";
+      k_errorvalue = nulldesc;
+      have_errval = 0;
+      return Error;
+      }
+   MakeInt(r, dx);
+   return Succeeded;
+   }
+
+/*
+ *  string -> bignum
+ */
+word bigradix(sign, r, s, end_s, result)
+int sign;                      /* '-' or not */
+int r;                          /* radix 2 .. 36 */
+char *s, *end_s;                        /* input string */
+union numeric *result;          /* output T_Integer or T_Lrgint */
+   {
+   /*
+    * Just do string to ordinary integer.
+    */
+   return radix(sign, r, s, end_s, result);
+   }
+
+/*
+ *  bigshift(da, db) -> dx
+ */
+int bigshift(da, db, dx)
+dptr da, db, dx;
+   {
+   uword ci;                  /* shift in 0s, even if negative */
+   C_integer cj;
+
+   /*
+    * Do an ordinary shift - note that db is always positive when this
+    *   routine is called.
+    */
+   ci = (uword)IntVal(*da);
+   cj = IntVal(*db);
+   /*
+    * Check for a shift of WordSize or greater; return an explicit 0 because
+    *  this is beyond C's defined behavior.  Otherwise shift as requested.
+    */
+   if (cj >= WordBits)
+      ci = 0;
+   else
+      ci <<= cj;
+   MakeInt(ci, dx);
+   return Succeeded;
+   }
diff --git a/src/common/doincl.c b/src/common/doincl.c
new file mode 100644
index 0000000..8f80c87
--- /dev/null
+++ b/src/common/doincl.c
@@ -0,0 +1,77 @@
+/*
+ * doincl.c -- expand include directives (recursively)
+ *
+ *  Usage:  doinclude [-o outfile] filename...
+ *
+ *  Doinclude copies a C source file, expanding non-system include directives.
+ *  For each line of the form
+ *	#include "filename"
+ *  the named file is interpolated; all other lines are copied verbatim.
+ *
+ *  No error is generated if a file cannot be opened.
+ */
+
+#include "../h/rt.h"
+
+void	doinclude	(char *fname);
+
+#define MAXLINE 500	/* maximum line length */
+
+FILE *outfile;		/* output file */
+
+int main(argc, argv)
+int argc;
+char *argv[];
+   {
+   char *progname = argv[0];
+
+   outfile = stdout;
+   if (argc > 3 && strcmp(argv[1], "-o") == 0) {
+      if ((outfile = fopen(argv[2], "w")) != NULL) {
+         argv += 2;
+         argc -= 2;
+         }
+      else {
+         perror(argv[2]);
+         exit(1);
+         }
+      }
+   if (argc < 2) {
+      fprintf(stderr, "usage: %s [-o outfile] filename...\n", progname);
+      exit(1);
+      }
+
+   fprintf(outfile,
+      "/***** do not edit -- this file was generated mechanically *****/\n\n");
+   while (--argc > 0)
+      doinclude(*++argv);
+   exit(0);
+   /*NOTREACHED*/
+   }
+
+void doinclude(fname)
+char *fname;
+   {
+   FILE *f;
+   char line[MAXLINE], newname[MAXLINE], *p;
+
+   fprintf(outfile, "\n\n/****************************************");
+   fprintf(outfile, "  from %s:  */\n\n", fname);
+   if ((f = fopen(fname, "r")) != NULL) {
+      while (fgets(line, MAXLINE, f))
+         if (sscanf(line, " # include \"%s\"", newname) == 1) {
+            for (p = newname; *p != '\0' && *p != '"'; p++)
+               ;
+            *p = '\0';				/* strip off trailing '"' */
+            doinclude(newname);			/* include file */
+            }
+         else
+            fputs(line, outfile);		/* not an include directive */
+      fclose(f);
+      }
+   else {
+      fprintf(outfile, "/* [file not found] */\n");
+      }
+   fprintf(outfile, "\n/****************************************");
+   fprintf(outfile, "   end %s   */\n", fname);
+   }
diff --git a/src/common/error.h b/src/common/error.h
new file mode 100644
index 0000000..0c5cb83
--- /dev/null
+++ b/src/common/error.h
@@ -0,0 +1,179 @@
+/*
+ * error.h -- routines for producing error messages.
+ *
+ * This source file contains the routines for issuing error messages.
+ * It is built by inclusion in ../icont/tlex.c and ../iconc/clex.c,
+ * with slight variations depending on whether "Iconc" is defined.
+ */
+
+/*
+ * Prototype.
+ */
+
+static	char	*mapterm	(int typ,struct node *val);
+
+/*
+ * yyerror produces syntax error messages.  tok is the offending token
+ *  (yychar), lval is yylval, and state is the parser's state.
+ *
+ * errtab is searched for the state, if it is found, the associated
+ *  message is produced; if the state isn't found, "syntax error"
+ *  is produced.
+ */
+void yyerror(tok, lval, state)
+int tok, state;
+nodeptr lval;
+   {
+   register struct errmsg *p;
+   int line;
+
+   if (lval == NULL)
+      line = 0;
+   else
+      line = Line(lval);
+
+   if (tok_loc.n_file)
+      fprintf(stderr, "File %s; ", tok_loc.n_file);
+   if (tok == EOFX)   /* special case end of file */
+      fprintf(stderr, "unexpected end of file\n");
+   else {
+      fprintf(stderr, "Line %d # ", line);
+      if (Col(lval))
+         fprintf(stderr, "\"%s\": ", mapterm(tok,lval));
+      for (p = errtab; p->e_state != state && p->e_state >= 0; p++) ;
+      fprintf(stderr, "%s\n", p->e_mesg);
+      }
+   tfatals++;
+   nocode++;
+   }
+
+/*
+ * mapterm finds a printable string for the given token type
+ *  and value.
+ */
+static char *mapterm(typ,val)
+int typ;
+nodeptr val;
+   {
+   register struct toktab *t;
+   register struct optab *ot;
+   register int i;
+
+   i = typ;
+   if (i == IDENT || i == INTLIT || i == REALLIT || i == STRINGLIT ||
+      i == CSETLIT)
+         return Str0(val);
+   for (t = toktab; t->t_type != 0; t++)
+      if (t->t_type == i)
+         return t->t_word;
+   for (ot = optab; ot->tok.t_type != 0; ot++)
+      if (ot->tok.t_type == i)
+         return ot->tok.t_word;
+   return "???";
+   }
+
+/*
+ * tfatal produces the translator error messages s1 and s2 (if nonnull).  The
+ *  location of the error is found in tok_loc.
+ */
+void tfatal(s1, s2)
+char *s1, *s2;
+   {
+
+   if (tok_loc.n_file)
+      fprintf(stderr, "File %s; ", tok_loc.n_file);
+   fprintf(stderr, "Line %d # ", tok_loc.n_line);
+   if (s2)
+      fprintf(stderr, "\"%s\": ", s2);
+   fprintf(stderr, "%s\n", s1);
+   tfatals++;
+   nocode++;
+   }
+
+/*
+ * nfatal produces the error messages s1 and s2 (if nonnull), and associates
+ *  it with source location of node.
+ */
+void nfatal(n, s1, s2)
+nodeptr n;
+char *s1, *s2;
+   {
+
+   if (n != NULL) {
+      fprintf(stderr, "File %s; ", File(n));
+      fprintf(stderr, "Line %d # ", Line(n));
+      }
+   if (s2)
+      fprintf(stderr, "\"%s\": ", s2);
+   fprintf(stderr, "%s\n", s1);
+   tfatals++;
+   nocode++;
+   }
+
+#ifdef Iconc
+/*
+ * twarn produces s1 and s2 (if nonnull) as translator warning messages.
+ *  The location of the error is found in tok_loc.
+ */
+void twarn(s1, s2)
+char *s1, *s2;
+   {
+
+   if (tok_loc.n_file)
+      fprintf(stderr, "File %s; ", tok_loc.n_file);
+   fprintf(stderr, "Line %d # ", tok_loc.n_line);
+   if (s2)
+      fprintf(stderr, "\"%s\": ", s2);
+   fprintf(stderr, "%s\n", s1);
+   twarns++;
+   }
+#endif					/* Iconc */
+
+/*
+ * tsyserr is called for fatal errors.  The message s is produced and the
+ *  translator exits.
+ */
+void tsyserr(s)
+char *s;
+   {
+
+
+   if (tok_loc.n_file)
+      fprintf(stderr, "File %s; ", tok_loc.n_file);
+   fprintf(stderr, "Line %d # %s\n", in_line, s);
+
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * quit - immediate exit with error message
+ */
+
+void quit(msg)
+char *msg;
+   {
+   quitf(msg,"");
+   }
+
+/*
+ * quitf - immediate exit with message format and argument
+ */
+void quitf(msg,arg)
+char *msg, *arg;
+   {
+   extern char *progname;
+
+   fprintf(stderr,"%s: ",progname);
+   fprintf(stderr,msg,arg);
+   fprintf(stderr,"\n");
+
+   #if !defined(Iconc)
+      {
+      extern char *ofile;
+      if (ofile)
+	 remove(ofile);			/* remove bad icode file */
+      }
+   #endif				/* !Iconc */
+
+   exit(EXIT_FAILURE);
+   }
diff --git a/src/common/filepart.c b/src/common/filepart.c
new file mode 100644
index 0000000..ab8049a
--- /dev/null
+++ b/src/common/filepart.c
@@ -0,0 +1,218 @@
+/*
+ * This file contains pathfind(), fparse(), makename(), and smatch().
+ */
+#include "../h/gsupport.h"
+
+static char *pathelem	(char *s, char *buf);
+static char *tryfile	(char *buf, char *dir, char *name, char *extn);
+
+/*
+ *  Define symbols for building file names.
+ *  1. Prefix: the characters that terminate a file name prefix
+ *  2. FileSep: the char to insert after a dir name, if any
+ *  3. DefPath: the default IPATH/LPATH
+ *  4. PathSep: allowable IPATH/LPATH separators
+ *
+ *  All platforms use POSIX forms of file paths.
+ *  MS Windows implementations canonize local forms before parsing.
+ */
+
+#define Prefix "/"
+#define FileSep '/'
+#define PathSep " :"
+#define DefPath ""
+
+/*
+ * pathfind(buf,path,name,extn) -- find file in path and return name.
+ *
+ *  pathfind looks for a file on a path, begining with the current
+ *  directory.  Details vary by platform, but the general idea is
+ *  that the file must be a readable simple text file.  pathfind
+ *  returns buf if it finds a file or NULL if not.
+ *
+ *  buf[MaxPath] is a buffer in which to put the constructed file name.
+ *  path is the IPATH or LPATH value, or NULL if unset.
+ *  name is the file name.
+ *  extn is the file extension (.icn or .u1) to be appended, or NULL if none.
+ */
+char *pathfind(buf, path, name, extn)
+char *buf, *path, *name, *extn;
+   {
+   char *s;
+   char pbuf[MaxPath];
+
+   if (tryfile(buf, (char *)NULL, name, extn))	/* try curr directory first */
+      return buf;
+   if (!path)				/* if no path, use default */
+      path = DefPath;
+
+   #if CYGWIN
+      s = alloca(cygwin_win32_to_posix_path_list_buf_size(path));
+      cygwin_win32_to_posix_path_list(path, s);
+   #else				/* CYGWIN */
+      s = path;
+   #endif				/* CYGWIN */
+
+   while ((s = pathelem(s, pbuf)) != 0)		/* for each path element */
+      if (tryfile(buf, pbuf, name, extn))	/* look for file */
+         return buf;
+   return NULL;				/* return NULL if no file found */
+   }
+
+/*
+ * pathelem(s,buf) -- copy next path element from s to buf.
+ *
+ *  Returns the updated pointer s.
+ */
+static char *pathelem(s, buf)
+char *s, *buf;
+   {
+   char c;
+
+   while ((c = *s) != '\0' && strchr(PathSep, c))
+      s++;
+   if (!*s)
+      return NULL;
+   while ((c = *s) != '\0' && !strchr(PathSep, c)) {
+      *buf++ = c;
+      s++;
+      }
+
+   #ifdef FileSep
+      /*
+       * We have to append a path separator here.
+       *  Seems like makename should really be the one to do that.
+       */
+      if (!strchr(Prefix, buf[-1])) {	/* if separator not already there */
+         *buf++ = FileSep;
+         }
+   #endif				/* FileSep */
+
+   *buf = '\0';
+   return s;
+   }
+
+/*
+ * tryfile(buf, dir, name, extn) -- check to see if file is readable.
+ *
+ *  The file name is constructed in buf from dir + name + extn.
+ *  findfile returns buf if successful or NULL if not.
+ */
+static char *tryfile(buf, dir, name, extn)
+char *buf, *dir, *name, *extn;
+   {
+   FILE *f;
+   makename(buf, dir, name, extn);
+   if ((f = fopen(buf, "r")) != NULL) {
+      fclose(f);
+      return buf;
+      }
+   else
+      return NULL;
+   }
+
+/*
+ * fparse - break a file name down into component parts.
+ *  Result is a pointer to a struct of static pointers good until the next call.
+ */
+struct fileparts *fparse(s)
+char *s;
+   {
+   static char buf[MaxPath+2];
+   static struct fileparts fp;
+   int n;
+   char *p, *q;
+
+   #if CYGWIN
+      char posix_s[_POSIX_PATH_MAX + 1];
+      cygwin_conv_to_posix_path(s, posix_s);
+      s = posix_s;
+   #endif				/* CYGWIN */
+
+   q = s;
+   fp.ext = p = s + strlen(s);
+   while (--p >= s) {
+      if (*p == '.' && *fp.ext == '\0')
+         fp.ext = p;
+      else if (strchr(Prefix,*p)) {
+         q = p+1;
+         break;
+         }
+      }
+
+   fp.dir = buf;
+   n = q - s;
+   strncpy(fp.dir,s,n);
+   fp.dir[n] = '\0';
+   fp.name = buf + n + 1;
+   n = fp.ext - q;
+   strncpy(fp.name,q,n);
+   fp.name[n] = '\0';
+   p = fp.ext;
+   fp.ext = fp.name + n + 1;
+   strcpy(fp.ext, p);
+
+   return &fp;
+   }
+
+/*
+ * makename - make a file name, optionally substituting a new dir and/or ext
+ */
+char *makename(dest,d,name,e)
+char *dest, *d, *name, *e;
+   {
+   struct fileparts fp;
+   fp = *fparse(name);
+   if (d != NULL)
+      fp.dir = d;
+   if (e != NULL)
+      fp.ext = e;
+   sprintf(dest,"%s%s%s",fp.dir,fp.name,fp.ext);
+   return dest;
+   }
+
+/*
+ * smatch - case-insensitive string match - returns nonzero if they match
+ */
+int smatch(s,t)
+char *s, *t;
+   {
+   char a, b;
+   for (;;) {
+      while (*s == *t)
+         if (*s++ == '\0')
+            return 1;
+         else
+            t++;
+      a = *s++;
+      b = *t++;
+      if (isupper(a))  a = tolower(a);
+      if (isupper(b))  b = tolower(b);
+      if (a != b)
+         return 0;
+      }
+   }
+
+#if MSWIN
+
+FILE *pathOpen(fname, mode)
+   char *fname;
+   char *mode;
+   {
+   char buf[MaxPath];
+   int i;
+
+   for (i = 0; fname[i] != '\0'; i++) {
+      if (fname[i] == '/' || fname[i] == ':' || fname[i] == '\\') {
+         /* fname contains an explicit path */
+         return fopen(fname, mode);
+         }
+      }
+
+   if (!pathfind(buf, getenv("PATH"), fname, NULL))
+      return 0;
+
+   return fopen(buf, mode);
+   }
+
+#endif					/* MSWIN */
diff --git a/src/common/fixgram.icn b/src/common/fixgram.icn
new file mode 100644
index 0000000..8d55b4d
--- /dev/null
+++ b/src/common/fixgram.icn
@@ -0,0 +1,48 @@
+# fix grammar after it has been put through the C preprosesor
+#
+#    allow at most 3 blank lines in a row
+#    change /*#...*/ to #...
+#    remove lines begining with #
+#    remove some of the extra tabs introduced by macro definitions and insert
+#	some newlines
+
+procedure main()
+    local s,n
+
+    write("/*")
+    write(" * W A R N I N G:")
+    write(" *")
+    write(" *    this file has been preprocessed")
+    write(" *    any changes must be made to the original file")
+    write(" */")
+    write()
+
+    n := 0
+    while s := read() do {
+	while s == "" do {
+	    if (n +:= 1) <= 3 then write()
+	    s := read() | break
+	    }
+	s ? (="/*#" & write("#",tab(find("*/"))) & (n := 0)) |
+	    ="#" |
+	    (fix_tabs() & (n := 0))
+	}
+end
+
+procedure fix_tabs()
+    if ="\t\t\t" then {
+        tab(many('\t'))
+	writes("\t\t")
+	}
+    while writes(tab(upto('{\t'))) do
+	if writes(="{") then
+	    tab(many(' \t'))
+	else if ="\t\t\t" then {
+	    writes("\n\t\t")
+	    tab(many('\t'))
+	    }
+	else
+	    writes(tab(many('\t')))
+    write(tab(0))
+    return
+end
diff --git a/src/common/getopt.c b/src/common/getopt.c
new file mode 100644
index 0000000..9b02f12
--- /dev/null
+++ b/src/common/getopt.c
@@ -0,0 +1,57 @@
+/*
+ * getopt.c -- get command-line options.
+ */
+
+#include "../h/gsupport.h"
+
+#ifndef SysOpt
+extern char* progname;
+
+/*
+ * Based on a public domain implementation of System V
+ *  getopt(3) by Keith Bostic (keith@seismo), Aug 24, 1984.
+ */
+
+#define BadCh	(int)'?'
+#define EMSG	""
+#define tell(m)	fprintf(stderr,"%s: %s -- %c\n",progname,m,optopt);return BadCh;
+
+int optind = 1;		/* index into parent argv vector */
+int optopt;		/* character checked for validity */
+char *optarg;		/* argument associated with option */
+
+int getopt(int nargc, char *const nargv[], const char *ostr)
+   {
+   static char *place = EMSG;		/* option letter processing */
+   register char *oli;			/* option letter list index */
+
+   if(!*place) {			/* update scanning pointer */
+      if(optind >= nargc || *(place = nargv[optind]) != '-' || !*++place)
+         return EOF;
+      if (*place == '-') {		/* found "--" */
+         ++optind;
+         return EOF;
+         }
+      }					/* option letter okay? */
+
+   if (((optopt=(int)*place++) == (int)':') || (oli=strchr(ostr,optopt)) == 0) {
+      if(!*place) ++optind;
+      tell("illegal option");
+      }
+   if (*++oli != ':') {			/* don't need argument */
+      optarg = NULL;
+      if (!*place) ++optind;
+      }
+   else {				/* need an argument */
+      if (*place) optarg = place;	/* no white space */
+      else if (nargc <= ++optind) {	/* no arg */
+         place = EMSG;
+         tell("option requires an argument");
+         }
+      else optarg = nargv[optind];	/* white space */
+      place = EMSG;
+      ++optind;
+      }
+   return optopt;			/* dump back option letter */
+   }
+#endif					/* SysOpt */
diff --git a/src/common/icontype.h b/src/common/icontype.h
new file mode 100644
index 0000000..38a1d70
--- /dev/null
+++ b/src/common/icontype.h
@@ -0,0 +1,55 @@
+/*
+ * This file was generated by the program typespec.
+ */
+
+int str_typ = 0;
+int int_typ = 1;
+int rec_typ = 2;
+int proc_typ = 3;
+int coexp_typ = 4;
+int stv_typ = 5;
+int ttv_typ = 6;
+int null_typ = 7;
+int cset_typ = 8;
+int real_typ = 9;
+int list_typ = 10;
+int tbl_typ = 11;
+
+int num_typs = 20;
+struct icon_type icontypes[20] = {
+  {"string", 0, DrfNone, TRetSpcl, NULL, 0, 0, "s", "String"},
+  {"integer", 0, DrfNone, TRetNone, NULL, 0, 0, "i", "Integer"},
+  {"record", 0, DrfNone, TRetBlkP, NULL, 0, 0, "R", "Record"},
+  {"proc", 0, DrfNone, TRetBlkP, NULL, 0, 0, "proc", "Proc"},
+  {"coexpr", 0, DrfNone, TRetBlkP, NULL, 0, 0, "C", "Coexpr"},
+  {"tvsubs", 1, DrfSpcl, TRetSpcl, NULL, 1, 0, "sstv", "Tvsubs"},
+  {"tvtbl", 1, DrfSpcl, TRetBlkP, NULL, 1, 1, "tetv", "Tvtbl"},
+  {"null", 0, DrfNone, TRetNone, NULL, 0, 0, "n", "Null"},
+  {"cset", 0, DrfNone, TRetBlkP, NULL, 0, 0, "c", "Cset"},
+  {"real", 0, DrfNone, TRetBlkP, NULL, 0, 0, "r", "Real"},
+  {"list", 1, DrfNone, TRetBlkP, NULL, 1, 2, "L", "List"},
+  {"table", 1, DrfNone, TRetBlkP, NULL, 3, 3, "T", "Table"},
+  {"file", 0, DrfNone, TRetBlkP, NULL, 0, 0, "f", "File"},
+  {"set", 1, DrfNone, TRetBlkP, NULL, 1, 6, "S", "Set"},
+  {"kywdint", 0, DrfCnst, TRetDescP, ".i..................", 0, 0, "kywdint", "Kywdint"},
+  {"kywdsubj", 0, DrfCnst, TRetDescP, "s...................", 0, 0, "kywdsubj", "Kywdsubj"},
+  {"kywdpos", 0, DrfCnst, TRetDescP, ".i..................", 0, 0, "kywdpos", "Kywdpos"},
+  {"kywdevent", 0, DrfCnst, TRetDescP, "siRpC..ncrLTfS......", 0, 0, "kywdevent", "Kywdevent"},
+  {"kywdwin", 0, DrfCnst, TRetDescP, ".......n....f.......", 0, 0, "kywdwin", "Kywdwin"},
+  {"kywdstr", 0, DrfCnst, TRetDescP, "s...................", 0, 0, "kywdstr", "Kywdstr"}};
+
+int str_var = 0;
+int trpd_tbl = 1;
+int lst_elem = 2;
+int tbl_dflt = 5;
+int tbl_val = 4;
+
+int num_cmpnts = 7;
+struct typ_compnt typecompnt[7] = {
+  {"str_var", 0, 0, 5, NULL},
+  {"trpd_tbl", 0, 0, 6, NULL},
+  {"lst_elem", 0, 1, 10, "LE"},
+  {"tbl_key", 0, 0, 11, NULL},
+  {"tbl_val", 1, 1, 11, "TV"},
+  {"tbl_dflt", 2, 0, 11, NULL},
+  {"set_elem", 0, 0, 13, NULL}};
diff --git a/src/common/identify.c b/src/common/identify.c
new file mode 100644
index 0000000..a1b7038
--- /dev/null
+++ b/src/common/identify.c
@@ -0,0 +1,30 @@
+#include "../h/gsupport.h"
+
+#undef COMPILER
+#define COMPILER 1        /* insure compiler Version number */
+#include "../h/version.h"
+
+extern char *progname;
+
+/*
+ * id_comment - output a comment C identifying the date and time and what
+ *  program is producing the output.
+ */
+void id_comment(f)
+FILE *f;
+   {
+   static char sbuf[26];
+   static int first_time = 1;
+   time_t ct;
+
+   if (first_time) {
+      time(&ct);
+      strcpy(sbuf, ctime(&ct));
+      first_time = 0;
+      }
+   fprintf(f, "/*\n");
+   fprintf(f, " * %s", sbuf);
+   fprintf(f, " * This file was produced by\n");
+   fprintf(f, " *   %s: %s\n", progname, Version);
+   fprintf(f, " */\n");
+   }
diff --git a/src/common/infer.c b/src/common/infer.c
new file mode 100644
index 0000000..819bf8b
--- /dev/null
+++ b/src/common/infer.c
@@ -0,0 +1,33 @@
+/*
+ *  infer.c -- generate definitions reflecting present hardware architecture
+ *
+ *  Inspired by mail from Christian Hudon.
+ */
+
+#include <assert.h>
+#include <stddef.h>
+#include <stdio.h>
+
+typedef struct {
+   char c;
+   double d;
+   } tstruct;
+
+static long atdepth(int n) {
+   return n <= 1 ? (long)&n : atdepth(n - 1);
+   }
+
+int main(int argc, char *argv[]) {
+   assert (-1 == (signed char)0xFF);		/* chars must be 8 bits */
+   assert (sizeof(void*) == sizeof(long));	/* these must be the same */
+   assert (sizeof(int) >= 4);			/* need 32-bit ints or better */
+   assert (sizeof(long) <= 8);			/* but can't handle over 64 */
+   printf("/* generated by infer.c */\n");
+   printf("#define IntBits %d\n", 8 * sizeof(int));
+   printf("#define WordBits %d\n", 8 * sizeof(void *));
+   if (offsetof(tstruct, d) > sizeof(void *))
+      printf("#define Double\n");
+   if (atdepth(2) > atdepth(1))
+      printf("#define UpStack\n");
+   return 0;
+   }
diff --git a/src/common/ipp.c b/src/common/ipp.c
new file mode 100644
index 0000000..8913ee5
--- /dev/null
+++ b/src/common/ipp.c
@@ -0,0 +1,971 @@
+/*
+ * ipp.c -- the Icon preprocessor.
+ *
+ *  All Icon source passes through here before translation or compilation.
+ *  Directives recognized are:
+ *	#line n [filename]
+ *	$line n [filename]
+ *	$include filename
+ *	$define identifier text
+ *	$undef identifier
+ *	$ifdef identifier
+ *	$ifndef identifier
+ *	$else
+ *	$endif
+ *	$error [text]
+ *
+ *  Entry points are
+ *	ppinit(fname,inclpath,m4flag) -- open input file
+ *	ppdef(s,v) -- "$define s v", or "$undef s" if v is a null pointer
+ *	ppch() -- return next preprocessed character
+ *	ppecho() -- preprocess to stdout (for icont/iconc -E)
+ *
+ *  See ../h/features.h for the set of predefined symbols.
+ */
+
+#include "../h/gsupport.h"
+
+#define HTBINS 256			/* number of hash bins */
+
+typedef struct fstruct {		/* input file structure */
+   struct fstruct *prev;		/* previous file */
+   char *fname;				/* file name */
+   long lno;				/* line number */
+   FILE *fp;				/* stdio file pointer */
+   int m4flag;				/* nz if preprocessed by m4 */
+   int ifdepth;				/* $if nesting depth when opened */
+   } infile;
+
+typedef struct bstruct {		/* buffer pointer structure */
+   struct bstruct *prev;		/* previous pointer structure */
+   struct cd *defn;			/* definition being processed */
+   char *ptr;				/* saved pointer value */
+   char *stop;				/* saved stop value */
+   char *lim;				/* saved limit value */
+   } buffer;
+
+typedef struct {			/* preprocessor token structure */
+   char *addr;				/* beginning of token */
+   short len;				/* length */
+   } ptok;
+
+typedef struct cd {			/* structure holding a definition */
+   struct cd *next;			/* link to next defn */
+   struct cd *prev;			/* link to previous defn */
+   short nlen, vlen;			/* length of name & val */
+   char inuse;				/* nonzero if curr being expanded */
+   char s[1];				/* name then value, as needed, no \0 */
+   } cdefn;
+
+static	int	ppopen	(char *fname, int m4);
+static	FILE *	m4pipe	(char *fname);
+static	char *	rline	(FILE *fp);
+static	void	pushdef	(cdefn *d);
+static	void	pushline (char *fname, long lno);
+static	void	ppdir	(char *line);
+static	void	pfatal	(char *s1, char *s2);
+static	void	skipcode (int doelse, int report);
+static	char *	define	(char *s);
+static	char *	undef	(char *s);
+static	char *	ifdef	(char *s);
+static	char *	ifndef	(char *s);
+static	char *	ifxdef	(char *s, int f);
+static	char *	elsedir	(char *s);
+static	char *	endif	(char *s);
+static	char *	errdir	(char *s);
+static	char *	include	(char *s);
+static	char *	setline	(char *s);
+static	char *	wskip	(char *s);
+static	char *	nskip	(char *s);
+static	char *	matchq	(char *s);
+static	char *	getidt	(char *dst, char *src);
+static	char *	getfnm	(char *dst, char *src);
+static	cdefn *	dlookup	(char *name, int len, char *val);
+
+struct ppcmd {
+   char *name;
+   char *(*func)();
+   }
+pplist[] = {
+   { "define",  define  },
+   { "undef",   undef   },
+   { "ifdef",   ifdef   },
+   { "ifndef",  ifndef  },
+   { "else",    elsedir },
+   { "endif",   endif   },
+   { "include", include },
+   { "line",    setline },
+   { "error",   errdir  },
+   { 0,         0       }};
+
+static infile nofile;			/* ancestor of all files; all zero */
+static infile *curfile;			/* pointer to current entry */
+
+static buffer *bstack;			/* stack of pending buffers */
+static buffer *bfree;			/* pool of free bstructs */
+
+static char *buf;			/* input line buffer */
+static char *bnxt;			/* next character */
+static char *bstop;			/* limit of preprocessed chars */
+static char *blim;			/* limit of all chars */
+
+static cdefn *cbin[HTBINS];		/* hash bins for defn table */
+
+static char *lpath;			/* LPATH for finding source files */
+
+static int ifdepth;			/* depth of $if nesting */
+
+extern int tfatals, nocode;		/* provided by icont, iconc */
+
+/*
+ * ppinit(fname, inclpath, m4) -- initialize preprocessor to read from fname.
+ *
+ *  Returns 1 if successful, 0 if open failed.
+ */
+int ppinit(fname, inclpath, m4)
+char *fname;
+char *inclpath;
+int m4;
+   {
+   int i;
+   cdefn *d, *n;
+
+   /*
+    * clear out any existing definitions from previous files
+    */
+   for (i = 0; i < HTBINS; i++) {
+      for (d = cbin[i]; d != NULL; d = n) {
+         n = d->next;
+         free((char *)d);
+         }
+      cbin[i] = NULL;
+      }
+
+   /*
+    * install predefined symbols
+    */
+#define Feature(guard,symname,kwval) dlookup(symname, -1, "1");
+#include "../h/features.h"
+
+   /*
+    * initialize variables and open source file
+    */
+   lpath = inclpath;
+   curfile = &nofile;			/* init file struct pointer */
+   return ppopen(fname, m4);		/* open main source file */
+   }
+
+/*
+ * ppopen(fname, m4) -- open a new file for reading by the preprocessor.
+ *
+ *  Returns 1 if successful, 0 if open failed.
+ *
+ *  Open calls may be nested.  Files are closed when EOF is read.
+ */
+static int ppopen(fname, m4)
+char *fname;
+int m4;
+   {
+   FILE *f;
+   infile *fs;
+
+   for (fs = curfile; fs->fname != NULL; fs = fs->prev)
+      if (strcmp(fname, fs->fname) == 0) {
+         pfatal("circular include", fname);	/* issue error message */
+         return 1;				/* treat as success */
+         }
+   if (m4)
+      f = m4pipe(fname);
+   else if (curfile == &nofile && strcmp(fname, "-") == 0) { /* 1st file only */
+      f = stdin;
+      fname = "stdin";
+      }
+   else
+      f = fopen(fname, "r");
+   if (f == NULL) {
+      return 0;
+      }
+   fs = alloc(sizeof(infile));
+   fs->prev = curfile;
+   fs->fp = f;
+   fs->fname = salloc(fname);
+   fs->lno = 0;
+   fs->m4flag = m4;
+   fs->ifdepth = ifdepth;
+   pushline(fs->fname, 0L);
+   curfile = fs;
+   return 1;
+   }
+
+/*
+ * m4pipe -- open a pipe from m4.
+ */
+static FILE *m4pipe(filename)
+char *filename;
+   {
+   FILE *f;
+   char *s = alloc(4 + strlen(filename));
+   sprintf(s, "m4 %s", filename);
+   f = popen(s, "r");
+   free(s);
+   return f;
+   }
+
+/*
+ * ppdef(s,v) -- define/undefine a symbol
+ *
+ *  If v is a null pointer, undefines symbol s.
+ *  Otherwise, defines s to have the value v.
+ *  No error is given for a redefinition.
+ */
+void ppdef(s, v)
+char *s, *v;
+   {
+   dlookup(s, -1, (char *)NULL);
+   if (v != NULL)
+      dlookup(s, -1, v);
+   }
+
+/*
+ * ppecho() -- run input through preprocessor and echo directly to stdout.
+ */
+void ppecho()
+   {
+   int c;
+
+   while ((c = ppch()) != EOF)
+      putchar(c);
+   }
+
+/*
+ * ppch() -- get preprocessed character.
+ */
+int ppch()
+   {
+   int c, f;
+   char *p;
+   buffer *b;
+   cdefn *d;
+   infile *fs;
+
+   for (;;) {
+      if (bnxt < bstop)			/* if characters ready to go */
+         return ((int)*bnxt++) & 0xFF;		/* return first one */
+
+      if (bnxt < blim) {
+         /*
+          * There are characters in the buffer, but they haven't been
+          *  checked for substitutions yet.  Process either one id, if
+          *  that's what's next, or as much else as we can.
+          */
+         f = *bnxt;
+         if (isalpha(f) || f == '_') {
+            /*
+             * This is the first character of an identifier.  It could
+             *  be the name of a definition.  If so, the name will be
+             *  contiguous in this buffer.  Check it.
+             */
+            p = bnxt + 1;
+            while (p < blim && (isalnum(c = *p) || c == '_'))	/* find end */
+               p++;
+            bstop = p;			/* safe to consume through end */
+            if (((d = dlookup(bnxt, p-bnxt, bnxt)) == 0)  || (d->inuse == 1)) {
+               bnxt++;
+               return f;		/* not defined; just use it */
+               }
+            /*
+             * We got a match.  Remove the token from the input stream and
+             *  push the replacement value.
+             */
+            bnxt = p;
+            pushdef(d);			/* make defn the curr buffer */
+            continue;			/* loop to preprocess */
+            }
+         else {
+            /*
+             * Not an id.  Find the end of non-id stuff and mark it as
+             *  having been preprocessed.  This is where we skip over
+             *  string and cset literals to avoid processing them.
+             */
+            p = bnxt++;
+            while (p < blim) {
+               c = *p;
+               if (isalpha(c) || c == '_') {	/* there's an id ahead */
+                  bstop = p;
+                  return f;
+                  }
+               else if (isdigit(c)) {		/* numeric constant */
+                  p = nskip(p);
+                  }
+               else if (c == '#') {		/* comment: skip to EOL */
+                  bstop = blim;
+                  return f;
+                  }
+               else if (c == '"' || c == '\''){	/* quoted literal */
+                  p = matchq(p);		/* skip to end */
+                  if (*p != '\0')
+                     p++;
+                  }
+               else
+                  p++;				/* else advance one char */
+               }
+            bstop = blim;			/* mark end of processed chrs */
+            return f;				/* return first char */
+            }
+         }
+
+      /*
+       * The buffer is empty.  Revert to a previous buffer.
+       */
+      if (bstack != NULL) {
+         b = bstack;
+         b->defn->inuse = 0;
+         bnxt = b->ptr;
+         bstop = b->stop;
+         blim = b->lim;
+         bstack = b->prev;
+         b->prev = bfree;
+         bfree = b;
+         continue;				/* loop to preprocess */
+         }
+
+      /*
+       * There's nothing at all in memory.  Read a new line.
+       */
+      if ((buf = rline(curfile->fp)) != NULL) {
+         /*
+          * The read was successful.
+          */
+         p = bnxt = bstop = blim = buf;		/* reset buffer pointers */
+         curfile->lno++;			/* bump line number */
+         while (isspace(c = *p))
+            p++;				/* find first nonwhite */
+         if (c == '$' && (!ispunct(p[1]) || p[1]==' '))
+            ppdir(p + 1);			/* handle preprocessor cmd */
+         else if (buf[1]=='l' && buf[2]=='i' && buf[3]=='n' && buf[4]=='e' &&
+                  buf[0]=='#' && buf[5]==' ')
+            ppdir(p + 1);			/* handle #line form */
+         else {
+            /*
+             * Not a preprocessor line; will need to scan for symbols.
+             */
+            bnxt = buf;
+            blim = buf + strlen(buf);
+            bstop = bnxt;			/* no chars scanned yet */
+            }
+         }
+
+      else {
+         /*
+          * The read hit EOF.
+          */
+         if (curfile->ifdepth != ifdepth) {
+            pfatal("unterminated $if", (char *)0);
+            ifdepth = curfile->ifdepth;
+            }
+
+         /*
+          * switch to previous file and close current file.
+          */
+         fs = curfile;
+         curfile = fs->prev;
+
+         if (fs->m4flag) {			/* if m4 preprocessing */
+            void quit();
+            if (pclose(fs->fp) != 0)		/* close pipe */
+               quit("m4 terminated abnormally");
+            }
+         else
+            fclose(fs->fp);		/* close current file */
+
+         free((char *)fs->fname);
+         free((char *)fs);
+         if (curfile == &nofile)	/* if at outer level, return EOF */
+            return EOF;
+         else				/* else generate #line comment */
+            pushline(curfile->fname, curfile->lno);
+         }
+      }
+   }
+
+/*
+ * rline(fp) -- read arbitrarily long line and return pointer.
+ *
+ *  Allocates memory as needed.  Returns NULL for EOF.  Lines end with "\n\0".
+ */
+static char *rline(fp)
+FILE *fp;
+   {
+#define LINE_SIZE_INIT 100
+#define LINE_SIZE_INCR 100
+   static char *lbuf = NULL;	/* line buffer */
+   static int llen = 0;		/* current buffer length */
+   register char *p;
+   register int c, n;
+
+   /* if first time, allocate buffer */
+   if (!lbuf) {
+      lbuf = alloc(LINE_SIZE_INIT);
+      llen = LINE_SIZE_INIT;
+      }
+
+   /* first character is special; return NULL if hit EOF here */
+   c = getc(fp);
+   if (c == EOF)
+      return NULL;
+   if (c == '\n')
+      return "\n";
+
+   p = lbuf;
+   n = llen - 3;
+   *p++ = c;
+
+   for (;;)  {
+      /* read until buffer full; return after newline or EOF */
+      while (--n >= 0 && (c = getc(fp)) != '\n' && c != EOF)
+         *p++ = c;
+      if (n >= 0) {
+         *p++ = '\n';			/* always terminate with \n\0 */
+         *p++ = '\0';
+         return lbuf;
+         }
+
+      /* need to read more, so we need a bigger buffer */
+      llen += LINE_SIZE_INCR;
+      lbuf = realloc(lbuf, (unsigned int)llen);
+      if (!lbuf) {
+         fprintf(stderr, "rline(%d): out of memory\n", llen);
+         exit(EXIT_FAILURE);
+         }
+      p = lbuf + llen - LINE_SIZE_INCR - 2;
+      n = LINE_SIZE_INCR;
+      }
+   }
+
+/*
+ * pushdef(d) -- insert definition into the input stream.
+ */
+static void pushdef(d)
+cdefn *d;
+   {
+   buffer *b;
+
+   d->inuse = 1;
+   b = bfree;
+   if (b == NULL)
+      b = (buffer *)alloc(sizeof(buffer));
+   else
+      bfree = b->prev;
+   b->prev = bstack;
+   b->defn = d;
+   b->ptr = bnxt;
+   b->stop = bstop;
+   b->lim = blim;
+   bstack = b;
+   bnxt = bstop = d->s + d->nlen;
+   blim = bnxt + d->vlen;
+   }
+
+/*
+ * pushline(fname,lno) -- push #line directive into input stream.
+ */
+static void pushline(fname, lno)
+char *fname;
+long lno;
+   {
+   static char tbuf[200];
+
+   sprintf(tbuf, "#line %ld \"%s\"\n", lno, fname);
+   bnxt = tbuf;
+   bstop = blim = tbuf + strlen(tbuf);
+   }
+
+/*
+ * ppdir(s) -- handle preprocessing directive.
+ *
+ *  s is the portion of the line following the $.
+ */
+static void ppdir(s)
+char *s;
+   {
+   char b0, *cmd, *errmsg;
+   struct ppcmd *p;
+
+   b0 = buf[0];				/* remember first char of line */
+   bnxt = "\n";				/* set buffer pointers to empty line */
+   bstop = blim = bnxt + 1;
+
+   s = wskip(s);			/* skip whitespace */
+   s = getidt(cmd = s - 1, s);		/* get command name */
+   s = wskip(s);			/* skip whitespace */
+
+   for (p = pplist; p->name != NULL; p++) /* find name in table */
+      if (strcmp(cmd, p->name) == 0) {
+         errmsg = (*p->func)(s);	/* process directive */
+         if (errmsg != NULL && (p->func != setline || b0 != '#'))
+            pfatal(errmsg, (char *)0);	/* issue err if not from #line form */
+      return;
+      }
+
+   pfatal("invalid preprocessing directive", cmd);
+   }
+
+/*
+ * pfatal(s1,s2) -- output a preprocessing error message.
+ *
+ *  s1 is the error message; s2 is the offending value, if any.
+ *  If s2 ends in a newline, the newline is truncated in place.
+ *
+ *  We can't use tfatal() because we have our own line counter which may be
+ *  out of sync with the lexical analyzer's.
+ */
+static void pfatal(s1, s2)
+char *s1, *s2;
+   {
+   int n;
+
+   fprintf(stderr, "File %s; Line %ld # ", curfile->fname, curfile->lno);
+   if (s2 != NULL && *s2 != '\0') {
+      n = strlen(s2);
+      if (n > 0 && s2[n-1] == '\n')
+         s2[n-1] = '\0';			/* remove newline */
+      fprintf(stderr, "\"%s\": ", s2);		/* print offending value */
+      }
+   fprintf(stderr, "%s\n", s1);			/* print diagnostic */
+   tfatals++;
+   nocode++;
+   }
+
+/*
+ * errdir(s) -- handle deliberate $error.
+ */
+static char *errdir(s)
+char *s;
+   {
+   pfatal("explicit $error", s);		/* issue msg with text */
+   return NULL;
+   }
+
+/*
+ * define(s) -- handle $define directive.
+ */
+static char *define(s)
+char *s;
+   {
+   char c, *name, *val;
+
+   if (isalpha(c = *s) || c == '_')
+      s = getidt(name = s - 1, s);		/* get name */
+   else
+      return "$define: missing name";
+   if (*s == '(')
+      return "$define: \"(\" after name requires preceding space";
+   val = s = wskip(s);
+   if (*s != '\0') {
+      while ((c = *s) != '\0' && c != '#') {	/* scan value */
+         if (c == '"' || c == '\'') {
+            s = matchq(s);
+            if (*s == '\0')
+               return "$define: unterminated literal";
+            }
+         s++;
+         }
+      while (isspace(s[-1]))			/* trim trailing whitespace */
+         s--;
+      }
+   *s = '\0';
+   dlookup(name, -1, val);		/* install in table */
+   return NULL;
+   }
+
+/*
+ * undef(s) -- handle $undef directive.
+ */
+static char *undef(s)
+char *s;
+   {
+   char c, *name;
+
+   if (isalpha(c = *s) || c == '_')
+      s = getidt(name = s - 1, s);		/* get name */
+   else
+      return "$undef: missing name";
+   if (*wskip(s) != '\0')
+      return "$undef: too many arguments";
+   dlookup(name, -1, (char *)NULL);
+   return NULL;
+   }
+
+/*
+ * include(s) -- handle $include directive.
+ */
+static char *include(s)
+char *s;
+   {
+   char *fname;
+   char fullpath[MaxPath];
+
+   s = getfnm(fname = s - 1, s);
+   if (*fname == '\0')
+      return "$include: invalid file name";
+   if (*wskip(s) != '\0')
+      return "$include: too many arguments";
+   if (!pathfind(fullpath, lpath, fname, (char *)NULL) || !ppopen(fullpath, 0))
+      pfatal("cannot open", fname);
+   return NULL;
+   }
+
+/*
+ * setline(s) -- handle $line (or #line) directive.
+ */
+static char *setline(s)
+char *s;
+   {
+   long n;
+   char c;
+   char *fname;
+
+   if (!isdigit(c = *s))
+      return "$line: no line number";
+   n = c - '0';
+
+   while (isdigit(c = *++s))		/* extract line number */
+      n = 10 * n + c - '0';
+   s = wskip(s);			/* skip whitespace */
+
+   if (isalpha (c = *s) || c == '_' || c == '"') {	/* if filename */
+      s = getfnm(fname = s - 1, s);			/* extract it */
+      if (*fname == '\0')
+         return "$line: invalid file name";
+      }
+   else
+      fname = NULL;
+
+   if (*wskip(s) != '\0')
+      return "$line: too many arguments";
+
+   curfile->lno = n;			/* set line number */
+   if (fname != NULL) {			/* also set filename if given */
+      free(curfile->fname);
+      curfile->fname = salloc(fname);
+      }
+
+   pushline(curfile->fname, curfile->lno);
+   return NULL;
+   }
+
+/*
+ * ifdef(s), ifndef(s) -- conditional processing if s is/isn't defined.
+ */
+static char *ifdef(s)
+char *s;
+   {
+   return ifxdef(s, 1);
+   }
+
+static char *ifndef(s)
+char *s;
+   {
+   return ifxdef(s, 0);
+   }
+
+/*
+ * ifxdef(s) -- handle $ifdef (if n is 1) or $ifndef (if n is 0).
+ */
+static char *ifxdef(s, f)
+char *s;
+int f;
+   {
+   char c, *name;
+
+   ifdepth++;
+   if (isalpha(c = *s) || c == '_')
+      s = getidt(name = s - 1, s);		/* get name */
+   else
+      return "$ifdef/$ifndef: missing name";
+   if (*wskip(s) != '\0')
+      return "$ifdef/$ifndef: too many arguments";
+   if ((dlookup(name, -1, name) != NULL) ^ f)
+      skipcode(1, 1);				/* skip to $else or $endif */
+   return NULL;
+   }
+
+/*
+ * elsedir(s) -- handle $else by skipping to $endif.
+ */
+static char *elsedir(s)
+char *s;
+   {
+   if (ifdepth <= curfile->ifdepth)
+      return "unexpected $else";
+   if (*s != '\0')
+      pfatal ("extraneous arguments on $else/$endif", s);
+   skipcode(0, 1);			/* skip the $else section */
+   return NULL;
+   }
+
+/*
+ * endif(s) -- handle $endif.
+ */
+static char *endif(s)
+char *s;
+   {
+   if (ifdepth <= curfile->ifdepth)
+      return "unexpected $endif";
+   if (*s != '\0')
+      pfatal ("extraneous arguments on $else/$endif", s);
+   ifdepth--;
+   return NULL;
+   }
+
+/*
+ * skipcode(doelse,report) -- skip code to $else (doelse=1) or $endif (=0).
+ *
+ *  If report is nonzero, generate #line directive at end of skip.
+ */
+static void skipcode(doelse, report)
+int doelse, report;
+   {
+   char c, *p, *cmd;
+
+   while ((p = buf = rline(curfile->fp)) != NULL) {
+      curfile->lno++;			/* bump line number */
+
+      /*
+       * Handle #line form encountered while skipping.
+       */
+      if (buf[1]=='l' && buf[2]=='i' && buf[3]=='n' && buf[4]=='e' &&
+            buf[0]=='#' && buf[5]==' ') {
+         ppdir(buf + 1);			/* interpret #line */
+         continue;
+         }
+
+      /*
+       * Check for any other kind of preprocessing directive.
+       */
+      while (isspace(c = *p))
+         p++;				/* find first nonwhite */
+      if (c != '$' || (ispunct(p[1]) && p[1]!=' '))
+         continue;			/* not a preprocessing directive */
+      p = wskip(p+1);			/* skip whitespace */
+      p = getidt(cmd = p-1, p);		/* get command name */
+      p = wskip(p);			/* skip whitespace */
+
+      /*
+       * Check for a directive that needs special attention.
+       *  Deliberately accept any form of $if... as valid
+       *  in anticipation of possible future extensions;
+       *  this allows them to appear here if commented out.
+       */
+      if (cmd[0] == 'i' && cmd[1] == 'f') {
+         ifdepth++;
+         skipcode(0, 0);		/* skip to $endif */
+         }
+      else if (strcmp(cmd, "line") == 0)
+         setline(p);			/* process $line, ignore errors */
+      else if (strcmp(cmd, "endif") == 0 ||
+               (doelse == 1 && strcmp(cmd, "else") == 0)) {
+         /*
+          * Time to stop skipping.
+          */
+         if (*p != '\0')
+            pfatal ("extraneous arguments on $else/$endif", p);
+         if (cmd[1] == 'n')		/* if $endif */
+            ifdepth--;
+         if (report)
+            pushline(curfile->fname, curfile->lno);
+         return;
+         }
+      }
+
+   /*
+    *  At EOF, just return; main loop will report unterminated $if.
+    */
+   }
+
+/*
+ * Token scanning functions.
+ */
+
+/*
+ * wskip(s) -- skip whitespace and return updated pointer
+ *
+ *  If '#' is encountered, skips to end of string.
+ */
+static char *wskip(s)
+char *s;
+   {
+   char c;
+
+   while (isspace(c = *s))
+      s++;
+   if (c == '#')
+      while ((c = *++s) != 0)
+         ;
+   return s;
+   }
+
+/*
+ * nskip(s) -- skip over numeric constant and return updated pointer.
+ */
+static char *nskip(s)
+char *s;
+   {
+      char c;
+
+      while (isdigit(c = *++s))
+         ;
+      if (c == 'r' || c == 'R') {
+         while (isalnum(c = *++s))
+            ;
+         return s;
+         }
+      if (c == '.')
+         while (isdigit (c = *++s))
+            ;
+      if (c == 'e' || c == 'E') {
+         c = s[1];
+         if (c == '+' || c == '-')
+            s++;
+         while (isdigit (c = *++s))
+            ;
+         }
+      return s;
+   }
+
+/*
+ * matchq(s) -- scan for matching quote character and return pointer.
+ *
+ *  Taking *s as the quote character, s is incremented until it points
+ *  to either another occurrence of the character or the '\0' terminating
+ *  the string.  Escaped quote characters do not stop the scan.  The
+ *  updated pointer is returned.
+ */
+static char *matchq(s)
+char *s;
+   {
+   char c, q;
+
+   q = *s;
+   if (q == '\0')
+      return s;
+   while ((c = *++s) != q && c != '\0') {
+      if (c == '\\')
+         if (*++s == '\0')
+            return s;
+      }
+   return s;
+   }
+
+/*
+ * getidt(dst,src) -- extract identifier, return updated pointer
+ *
+ *  The identifier (in Icon terms, "many(&letters++&digits++'_')")
+ *  at src is copied to dst and '\0' is appended.  A pointer to the
+ *  character following the identifier is returned.
+ *
+ *  dst may partially overlap src if dst has a lower address.  This
+ *  is typically done to avoid the need for another arbitrarily-long
+ *  buffer.  An offset of -1 allows room for insertion of the '\0'.
+ */
+static char *getidt(dst, src)
+char *dst, *src;
+   {
+   char c;
+
+   while (isalnum(c = *src) || (c == '_')) {
+      *dst++ = c;
+      src++;
+      }
+   *dst = '\0';
+   return src;
+   }
+
+/*
+ * getfnm(dst,src) -- extract filename, return updated pointer
+ *
+ *  Similarly to getidt, getfnm extracts a quoted or unquoted file name.
+ *  An empty string at dst indicates a missing or unterminated file name.
+ */
+static char *getfnm(dst, src)
+char *dst, *src;
+   {
+   char *lim;
+
+   if (*src != '"')
+      return getidt(dst, src);
+   lim = matchq(src);
+   if (*lim != '"') {
+      *dst = '\0';
+      return lim;
+      }
+   while (++src < lim)
+      if ((*dst++ = *src) == '\\')
+         dst[-1] = *++src;
+   *dst = '\0';
+   return lim + 1;
+   }
+
+/*
+ * dlookup(name, len, val) look up entry in definition table.
+ *
+ *  If val == name, return the existing value, or NULL if undefined.
+ *  If val == NULL, delete any existing value and undefine the name.
+ *  If val != NULL, install a new value, and print error if different.
+ *
+ *  If name is null, the call is ignored.
+ *  If len < 0, strlen(name) is taken.
+ */
+static cdefn *dlookup(name, len, val)
+char *name;
+int len;
+char *val;
+   {
+   int h, i, nlen, vlen;
+   unsigned int t;
+   cdefn *d, **p;
+
+   if (len < 0)
+      len = strlen(name);
+   if (len == 0)
+      return NULL;
+   for (t = i = 0; i < len; i++)
+      t = 37 * t + (name[i] & 0xFF);	/* calc hash value */
+   h = t % HTBINS;			/* calc bin number */
+   p = &cbin[h];			/* get head of list */
+   while ((d = *p) != NULL) {
+      if (d->nlen == len && strncmp(name, d->s, len) == 0) {
+         /*
+          * We found a match in the table.
+          */
+         if (val == NULL) {		/* if $undef */
+            *p = d->next;		/* delete from table */
+            free((char *)d);
+            return NULL;
+            }
+         if (val != name && strcmp(val, d->s + d->nlen) != 0)
+            pfatal("value redefined", name);
+         return d;			/* return pointer to entry */
+         }
+      p = &d->next;
+      }
+   /*
+    * No match. Install a definition if that is what is wanted.
+    */
+   if (val == name || val == NULL)	/* if was reference or $undef */
+      return NULL;
+   nlen = strlen(name);
+   vlen = strlen(val);
+   d = (cdefn *)alloc(sizeof(*d) - sizeof(d->s) + nlen + vlen + 1);
+   d->nlen = nlen;
+   d->vlen = vlen;
+   d->inuse = 0;
+   strcpy(d->s, name);
+   strcpy(d->s + nlen, val);
+   d->prev = NULL;
+   d->next = cbin[h];
+   if (d->next != NULL)
+      d->next->prev = d;
+   cbin[h] = d;
+   return d;
+   }
diff --git a/src/common/lextab.h b/src/common/lextab.h
new file mode 100644
index 0000000..7a6154b
--- /dev/null
+++ b/src/common/lextab.h
@@ -0,0 +1,576 @@
+/*
+ * NOTE: this file is generated automatically by mktoktab
+ *  from tokens.txt and op.txt.
+ */
+
+/*
+ * Token table - contains an entry for each token type
+ * with printable name of token, token type, and flags
+ * for semicolon insertion.
+ */
+
+struct toktab toktab[] = {
+/*  token		token type	flags */
+
+   /* primitives */
+   "identifier",      IDENT,         Beginner+Ender,    /*   0 */
+   "integer-literal", INTLIT,        Beginner+Ender,    /*   1 */
+   "real-literal",    REALLIT,       Beginner+Ender,    /*   2 */
+   "string-literal",  STRINGLIT,     Beginner+Ender,    /*   3 */
+   "cset-literal",    CSETLIT,       Beginner+Ender,    /*   4 */
+   "end-of-file",     EOFX,          0,                 /*   5 */
+
+   /* reserved words */
+   "break",           BREAK,         Beginner+Ender,    /*   6 */
+   "by",              BY,            0,                 /*   7 */
+   "case",            CASE,          Beginner,          /*   8 */
+   "create",          CREATE,        Beginner,          /*   9 */
+   "default",         DEFAULT,       Beginner,          /*  10 */
+   "do",              DO,            0,                 /*  11 */
+   "else",            ELSE,          0,                 /*  12 */
+   "end",             END,           Beginner,          /*  13 */
+   "every",           EVERY,         Beginner,          /*  14 */
+   "fail",            FAIL,          Beginner+Ender,    /*  15 */
+   "global",          GLOBAL,        0,                 /*  16 */
+   "if",              IF,            Beginner,          /*  17 */
+   "initial",         INITIAL,       Beginner,          /*  18 */
+   "invocable",       INVOCABLE,     0,                 /*  19 */
+   "link",            LINK,          0,                 /*  20 */
+   "local",           LOCAL,         Beginner,          /*  21 */
+   "next",            NEXT,          Beginner+Ender,    /*  22 */
+   "not",             NOT,           Beginner,          /*  23 */
+   "of",              OF,            0,                 /*  24 */
+   "procedure",       PROCEDURE,     0,                 /*  25 */
+   "record",          RECORD,        0,                 /*  26 */
+   "repeat",          REPEAT,        Beginner,          /*  27 */
+   "return",          RETURN,        Beginner+Ender,    /*  28 */
+   "static",          STATIC,        Beginner,          /*  29 */
+   "suspend",         SUSPEND,       Beginner+Ender,    /*  30 */
+   "then",            THEN,          0,                 /*  31 */
+   "to",              TO,            0,                 /*  32 */
+   "until",           UNTIL,         Beginner,          /*  33 */
+   "while",           WHILE,         Beginner,          /*  34 */
+   "end-of-file",     0,             0,
+   };
+
+/*
+ * restab[c] points to the first reserved word in toktab which
+ * begins with the letter c.
+ */
+
+struct toktab *restab[] = {
+   NULL,        &toktab[ 6], &toktab[ 8], &toktab[10], /* 61-64 abcd */
+   &toktab[12], &toktab[15], &toktab[16], NULL,        /* 65-68 efgh */
+   &toktab[17], NULL,        NULL,        &toktab[20], /* 69-6C ijkl */
+   NULL,        &toktab[22], &toktab[24], &toktab[25], /* 6D-70 mnop */
+   NULL,        &toktab[26], &toktab[29], &toktab[31], /* 71-74 qrst */
+   &toktab[33], NULL,        &toktab[34], NULL,        /* 75-78 uvwx */
+   NULL,        NULL,                                  /* 79-7A yz */
+   };
+
+/*
+ * The operator table acts to extend the token table, it
+ *  indicates what implementations are expected from rtt,
+ *  and it has pointers for the implementation information.
+ */
+
+struct optab optab[] = {
+   {{"!",      BANG,       Beginner}, Unary,          NULL, NULL}, /* 0 */
+   {{"%",      MOD,        0},        Binary,         NULL, NULL}, /* 1 */
+   {{"%:=",    AUGMOD,     0},        0,              NULL, NULL}, /* 2 */
+   {{"&",      AND,        Beginner}, Binary,         NULL, NULL}, /* 3 */
+   {{"&:=",    AUGAND,     0},        0,              NULL, NULL}, /* 4 */
+   {{"*",      STAR,       Beginner}, Unary | Binary, NULL, NULL}, /* 5 */
+   {{"*:=",    AUGSTAR,    0},        0,              NULL, NULL}, /* 6 */
+   {{"**",     INTER,      Beginner}, Binary,         NULL, NULL}, /* 7 */
+   {{"**:=",   AUGINTER,   0},        0,              NULL, NULL}, /* 8 */
+   {{"+",      PLUS,       Beginner}, Unary | Binary, NULL, NULL}, /* 9 */
+   {{"+:=",    AUGPLUS,    0},        0,              NULL, NULL}, /* 10 */
+   {{"++",     UNION,      Beginner}, Binary,         NULL, NULL}, /* 11 */
+   {{"++:=",   AUGUNION,   0},        0,              NULL, NULL}, /* 12 */
+   {{"-",      MINUS,      Beginner}, Unary | Binary, NULL, NULL}, /* 13 */
+   {{"-:=",    AUGMINUS,   0},        0,              NULL, NULL}, /* 14 */
+   {{"--",     DIFF,       Beginner}, Binary,         NULL, NULL}, /* 15 */
+   {{"--:=",   AUGDIFF,    0},        0,              NULL, NULL}, /* 16 */
+   {{".",      DOT,        Beginner}, Unary,          NULL, NULL}, /* 17 */
+   {{"/",      SLASH,      Beginner}, Unary | Binary, NULL, NULL}, /* 18 */
+   {{"/:=",    AUGSLASH,   0},        0,              NULL, NULL}, /* 19 */
+   {{":=",     ASSIGN,     0},        Binary,         NULL, NULL}, /* 20 */
+   {{":=:",    SWAP,       0},        Binary,         NULL, NULL}, /* 21 */
+   {{"<",      NMLT,       0},        Binary,         NULL, NULL}, /* 22 */
+   {{"<:=",    AUGNMLT,    0},        0,              NULL, NULL}, /* 23 */
+   {{"<-",     REVASSIGN,  0},        Binary,         NULL, NULL}, /* 24 */
+   {{"<->",    REVSWAP,    0},        Binary,         NULL, NULL}, /* 25 */
+   {{"<<",     SLT,        0},        Binary,         NULL, NULL}, /* 26 */
+   {{"<<:=",   AUGSLT,     0},        0,              NULL, NULL}, /* 27 */
+   {{"<<=",    SLE,        0},        Binary,         NULL, NULL}, /* 28 */
+   {{"<<=:=",  AUGSLE,     0},        0,              NULL, NULL}, /* 29 */
+   {{"<=",     NMLE,       0},        Binary,         NULL, NULL}, /* 30 */
+   {{"<=:=",   AUGNMLE,    0},        0,              NULL, NULL}, /* 31 */
+   {{"=",      NMEQ,       Beginner}, Unary | Binary, NULL, NULL}, /* 32 */
+   {{"=:=",    AUGNMEQ,    0},        0,              NULL, NULL}, /* 33 */
+   {{"==",     SEQ,        Beginner}, Binary,         NULL, NULL}, /* 34 */
+   {{"==:=",   AUGSEQ,     0},        0,              NULL, NULL}, /* 35 */
+   {{"===",    EQUIV,      Beginner}, Binary,         NULL, NULL}, /* 36 */
+   {{"===:=",  AUGEQUIV,   0},        0,              NULL, NULL}, /* 37 */
+   {{">",      NMGT,       0},        Binary,         NULL, NULL}, /* 38 */
+   {{">:=",    AUGNMGT,    0},        0,              NULL, NULL}, /* 39 */
+   {{">=",     NMGE,       0},        Binary,         NULL, NULL}, /* 40 */
+   {{">=:=",   AUGNMGE,    0},        0,              NULL, NULL}, /* 41 */
+   {{">>",     SGT,        0},        Binary,         NULL, NULL}, /* 42 */
+   {{">>:=",   AUGSGT,     0},        0,              NULL, NULL}, /* 43 */
+   {{">>=",    SGE,        0},        Binary,         NULL, NULL}, /* 44 */
+   {{">>=:=",  AUGSGE,     0},        0,              NULL, NULL}, /* 45 */
+   {{"?",      QMARK,      Beginner}, Unary,          NULL, NULL}, /* 46 */
+   {{"?:=",    AUGQMARK,   0},        0,              NULL, NULL}, /* 47 */
+   {{"@",      AT,         Beginner}, 0,              NULL, NULL}, /* 48 */
+   {{"@:=",    AUGAT,      0},        0,              NULL, NULL}, /* 49 */
+   {{"\\",     BACKSLASH,  Beginner}, Unary,          NULL, NULL}, /* 50 */
+   {{"^",      CARET,      Beginner}, Unary | Binary, NULL, NULL}, /* 51 */
+   {{"^:=",    AUGCARET,   0},        0,              NULL, NULL}, /* 52 */
+   {{"|",      BAR,        Beginner}, 0,              NULL, NULL}, /* 53 */
+   {{"||",     CONCAT,     Beginner}, Binary,         NULL, NULL}, /* 54 */
+   {{"||:=",   AUGCONCAT,  0},        0,              NULL, NULL}, /* 55 */
+   {{"|||",    LCONCAT,    Beginner}, Binary,         NULL, NULL}, /* 56 */
+   {{"|||:=",  AUGLCONCAT, 0},        0,              NULL, NULL}, /* 57 */
+   {{"~",      TILDE,      Beginner}, Unary,          NULL, NULL}, /* 58 */
+   {{"~=",     NMNE,       Beginner}, Binary,         NULL, NULL}, /* 59 */
+   {{"~=:=",   AUGNMNE,    0},        0,              NULL, NULL}, /* 60 */
+   {{"~==",    SNE,        Beginner}, Binary,         NULL, NULL}, /* 61 */
+   {{"~==:=",  AUGSNE,     0},        0,              NULL, NULL}, /* 62 */
+   {{"~===",   NEQUIV,     Beginner}, Binary,         NULL, NULL}, /* 63 */
+   {{"~===:=", AUGNEQUIV,  0},        0,              NULL, NULL}, /* 64 */
+   {{"(",      LPAREN,     Beginner}, 0,              NULL, NULL}, /* 65 */
+   {{")",      RPAREN,     Ender},    0,              NULL, NULL}, /* 66 */
+   {{"+:",     PCOLON,     0},        0,              NULL, NULL}, /* 67 */
+   {{",",      COMMA,      0},        0,              NULL, NULL}, /* 68 */
+   {{"-:",     MCOLON,     0},        0,              NULL, NULL}, /* 69 */
+   {{":",      COLON,      0},        0,              NULL, NULL}, /* 70 */
+   {{";",      SEMICOL,    0},        0,              NULL, NULL}, /* 71 */
+   {{"[",      LBRACK,     Beginner}, 0,              NULL, NULL}, /* 72 */
+   {{"]",      RBRACK,     Ender},    0,              NULL, NULL}, /* 73 */
+   {{"{",      LBRACE,     Beginner}, 0,              NULL, NULL}, /* 74 */
+   {{"}",      RBRACE,     Ender},    0,              NULL, NULL}, /* 75 */
+   {{"$(",     LBRACE,     Beginner}, 0,              NULL, NULL}, /* 76 */
+   {{"$)",     RBRACE,     Ender},    0,              NULL, NULL}, /* 77 */
+   {{"$<",     LBRACK,     Beginner}, 0,              NULL, NULL}, /* 78 */
+   {{"$>",     RBRACK,     Ender},    0,              NULL, NULL}, /* 79 */
+   {{NULL,          0,     0},        0,              NULL, NULL}
+   };
+
+int asgn_loc = 20;
+int semicol_loc = 71;
+int plus_loc = 9;
+int minus_loc = 13;
+
+/*
+ * getopr - find the longest legal operator and return the
+ *  index to its entry in the operator table.
+ */
+
+int getopr(ac, cc)
+int ac;
+int *cc;
+   {
+   register char c;
+
+   *cc = ' ';
+   switch (c = ac) {
+      case '!':
+         return 0;   /* ! */
+      case '$':
+         switch (c = NextChar) {
+            case '(':
+               return 76;   /* $( */
+            case ')':
+               return 77;   /* $) */
+            case '<':
+               return 78;   /* $< */
+            case '>':
+               return 79;   /* $> */
+            }
+         break;
+      case '%':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 2;   /* %:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 1;   /* % */
+            }
+         break;
+      case '&':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 4;   /* &:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 3;   /* & */
+            }
+         break;
+      case '(':
+         return 65;   /* ( */
+      case ')':
+         return 66;   /* ) */
+      case '*':
+         switch (c = NextChar) {
+            case '*':
+               if ((c = NextChar) == ':') {
+                  if ((c = NextChar) == '=') {
+                     return 8;   /* **:= */
+                     }
+                  }
+               else {
+                  *cc = c;
+                  return 7;   /* ** */
+                  }
+               break;
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 6;   /* *:= */
+                  }
+               break;
+            default:
+               *cc = c;
+               return 5;   /* * */
+            }
+         break;
+      case '+':
+         switch (c = NextChar) {
+            case '+':
+               if ((c = NextChar) == ':') {
+                  if ((c = NextChar) == '=') {
+                     return 12;   /* ++:= */
+                     }
+                  }
+               else {
+                  *cc = c;
+                  return 11;   /* ++ */
+                  }
+               break;
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 10;   /* +:= */
+                  }
+               else {
+                  *cc = c;
+                  return 67;   /* +: */
+                  }
+            default:
+               *cc = c;
+               return 9;   /* + */
+            }
+         break;
+      case ',':
+         return 68;   /* , */
+      case '-':
+         switch (c = NextChar) {
+            case '-':
+               if ((c = NextChar) == ':') {
+                  if ((c = NextChar) == '=') {
+                     return 16;   /* --:= */
+                     }
+                  }
+               else {
+                  *cc = c;
+                  return 15;   /* -- */
+                  }
+               break;
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 14;   /* -:= */
+                  }
+               else {
+                  *cc = c;
+                  return 69;   /* -: */
+                  }
+            default:
+               *cc = c;
+               return 13;   /* - */
+            }
+         break;
+      case '.':
+         return 17;   /* . */
+      case '/':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 19;   /* /:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 18;   /* / */
+            }
+         break;
+      case ':':
+         if ((c = NextChar) == '=') {
+            if ((c = NextChar) == ':') {
+               return 21;   /* :=: */
+               }
+            else {
+               *cc = c;
+               return 20;   /* := */
+               }
+            }
+         else {
+            *cc = c;
+            return 70;   /* : */
+            }
+      case ';':
+         return 71;   /* ; */
+      case '<':
+         switch (c = NextChar) {
+            case '-':
+               if ((c = NextChar) == '>') {
+                  return 25;   /* <-> */
+                  }
+               else {
+                  *cc = c;
+                  return 24;   /* <- */
+                  }
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 23;   /* <:= */
+                  }
+               break;
+            case '<':
+               switch (c = NextChar) {
+                  case ':':
+                     if ((c = NextChar) == '=') {
+                        return 27;   /* <<:= */
+                        }
+                     break;
+                  case '=':
+                     if ((c = NextChar) == ':') {
+                        if ((c = NextChar) == '=') {
+                           return 29;   /* <<=:= */
+                           }
+                        }
+                     else {
+                        *cc = c;
+                        return 28;   /* <<= */
+                        }
+                     break;
+                  default:
+                     *cc = c;
+                     return 26;   /* << */
+                  }
+               break;
+            case '=':
+               if ((c = NextChar) == ':') {
+                  if ((c = NextChar) == '=') {
+                     return 31;   /* <=:= */
+                     }
+                  }
+               else {
+                  *cc = c;
+                  return 30;   /* <= */
+                  }
+               break;
+            default:
+               *cc = c;
+               return 22;   /* < */
+            }
+         break;
+      case '=':
+         switch (c = NextChar) {
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 33;   /* =:= */
+                  }
+               break;
+            case '=':
+               switch (c = NextChar) {
+                  case ':':
+                     if ((c = NextChar) == '=') {
+                        return 35;   /* ==:= */
+                        }
+                     break;
+                  case '=':
+                     if ((c = NextChar) == ':') {
+                        if ((c = NextChar) == '=') {
+                           return 37;   /* ===:= */
+                           }
+                        }
+                     else {
+                        *cc = c;
+                        return 36;   /* === */
+                        }
+                     break;
+                  default:
+                     *cc = c;
+                     return 34;   /* == */
+                  }
+               break;
+            default:
+               *cc = c;
+               return 32;   /* = */
+            }
+         break;
+      case '>':
+         switch (c = NextChar) {
+            case ':':
+               if ((c = NextChar) == '=') {
+                  return 39;   /* >:= */
+                  }
+               break;
+            case '=':
+               if ((c = NextChar) == ':') {
+                  if ((c = NextChar) == '=') {
+                     return 41;   /* >=:= */
+                     }
+                  }
+               else {
+                  *cc = c;
+                  return 40;   /* >= */
+                  }
+               break;
+            case '>':
+               switch (c = NextChar) {
+                  case ':':
+                     if ((c = NextChar) == '=') {
+                        return 43;   /* >>:= */
+                        }
+                     break;
+                  case '=':
+                     if ((c = NextChar) == ':') {
+                        if ((c = NextChar) == '=') {
+                           return 45;   /* >>=:= */
+                           }
+                        }
+                     else {
+                        *cc = c;
+                        return 44;   /* >>= */
+                        }
+                     break;
+                  default:
+                     *cc = c;
+                     return 42;   /* >> */
+                  }
+               break;
+            default:
+               *cc = c;
+               return 38;   /* > */
+            }
+         break;
+      case '?':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 47;   /* ?:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 46;   /* ? */
+            }
+         break;
+      case '@':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 49;   /* @:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 48;   /* @ */
+            }
+         break;
+      case '[':
+         return 72;   /* [ */
+      case '\\':
+         return 50;   /* \ */
+      case ']':
+         return 73;   /* ] */
+      case '^':
+         if ((c = NextChar) == ':') {
+            if ((c = NextChar) == '=') {
+               return 52;   /* ^:= */
+               }
+            }
+         else {
+            *cc = c;
+            return 51;   /* ^ */
+            }
+         break;
+      case '{':
+         return 74;   /* { */
+      case '|':
+         if ((c = NextChar) == '|') {
+            switch (c = NextChar) {
+               case ':':
+                  if ((c = NextChar) == '=') {
+                     return 55;   /* ||:= */
+                     }
+                  break;
+               case '|':
+                  if ((c = NextChar) == ':') {
+                     if ((c = NextChar) == '=') {
+                        return 57;   /* |||:= */
+                        }
+                     }
+                  else {
+                     *cc = c;
+                     return 56;   /* ||| */
+                     }
+                  break;
+               default:
+                  *cc = c;
+                  return 54;   /* || */
+               }
+            }
+         else {
+            *cc = c;
+            return 53;   /* | */
+            }
+         break;
+      case '}':
+         return 75;   /* } */
+      case '~':
+         if ((c = NextChar) == '=') {
+            switch (c = NextChar) {
+               case ':':
+                  if ((c = NextChar) == '=') {
+                     return 60;   /* ~=:= */
+                     }
+                  break;
+               case '=':
+                  switch (c = NextChar) {
+                     case ':':
+                        if ((c = NextChar) == '=') {
+                           return 62;   /* ~==:= */
+                           }
+                        break;
+                     case '=':
+                        if ((c = NextChar) == ':') {
+                           if ((c = NextChar) == '=') {
+                              return 64;   /* ~===:= */
+                              }
+                           }
+                        else {
+                           *cc = c;
+                           return 63;   /* ~=== */
+                           }
+                        break;
+                     default:
+                        *cc = c;
+                        return 61;   /* ~== */
+                     }
+                  break;
+               default:
+                  *cc = c;
+                  return 59;   /* ~= */
+               }
+            }
+         else {
+            *cc = c;
+            return 58;   /* ~ */
+            }
+         break;
+      }
+   tfatal("invalid character", (char *)NULL);
+   return -1;
+   }
diff --git a/src/common/literals.c b/src/common/literals.c
new file mode 100644
index 0000000..4978d5f
--- /dev/null
+++ b/src/common/literals.c
@@ -0,0 +1,180 @@
+#include "../h/gsupport.h"
+#include "../h/esctab.h"
+
+/*
+ * Prototypes.
+ */
+unsigned short	*bitvect	(char *image, int len);
+static int escape               (char **str_ptr, int *nchars_ptr);
+
+/*
+ * Within translators, csets are internally implemented as a bit vector made
+ *  from an array of unsigned shorts. For portability, only the lower 16
+ *  bits of these shorts are used.
+ */
+#define BVectIndx(c) (((unsigned char)c >> 4) & 0xf)
+#define BitInShrt(c) (1 << ((unsigned char)c & 0xf))
+
+/*
+ * Macros used by escape() to advance to the next character and to
+ *  test the kind of character.
+ */
+#define NextChar(c) ((*nchars_ptr)--, c = *(*str_ptr)++)
+#define isoctal(c) ((c)>='0'&&(c)<='7')	/* macro to test for octal digit */
+
+/*
+ * escape - translate the character sequence following a '\' into the
+ *   single character it represents.
+ */
+static int escape(str_ptr, nchars_ptr)
+char **str_ptr;
+int *nchars_ptr;
+   {
+   register int c, nc, i;
+
+   /*
+    * Note, it is impossible to have a character string ending with a '\',
+    *  something must be here.
+    */
+   NextChar(c);
+   if (isoctal(c)) {
+      /*
+       * translate an octal escape -- backslash followed by one, two, or three
+       *  octal digits.
+       */
+      c -= '0';
+      for (i = 2; *nchars_ptr > 0 && isoctal(**str_ptr) && i <= 3; ++i) {
+         NextChar(nc);
+         c = (c << 3) | (nc - '0');
+         }
+      return (c & 0377);
+      }
+   else if (c == 'x') {
+      /*
+       * translate a hexadecimal escape -- backslash-x followed by one or
+       *  two hexadecimal digits.
+       */
+      c = 0;
+      for (i = 1; *nchars_ptr > 0 && isxdigit(**str_ptr) && i <= 2; ++i) {
+         NextChar(nc);
+         if (nc >= 'a' && nc <= 'f')
+            nc -= 'a' - 10;
+         else if (nc >= 'A' && nc <= 'F')
+            nc -= 'A' - 10;
+         else if (isdigit(nc))
+            nc -= '0';
+         c = (c << 4) | nc;
+         }
+      return c;
+      }
+   else if (c == '^') {
+      /*
+       * translate a control escape -- backslash followed by caret and one
+       *  character.
+       */
+      if (*nchars_ptr <= 0)
+         return 0;           /* could only happen in a keyword */
+      NextChar(c);
+      return (c & 037);
+      }
+   else
+      return esctab[c];
+   }
+
+/*
+ * bitvect - convert cset literal into a bitvector
+ */
+unsigned short *bitvect(image, len)
+char *image;
+int len;
+   {
+   register int c;
+   register unsigned short *bv;
+   register int i;
+
+   bv = alloc(BVectSize * sizeof(unsigned short));
+   for (i = 0; i < BVectSize; ++i)
+      bv[i] = 0;
+   while (len-- > 0) {
+      c = *image++;
+      if (c == '\\')
+         c = escape(&image, &len);
+      bv[BVectIndx(c)] |= BitInShrt(c);
+      }
+   return bv;
+   }
+
+/*
+ * cset_init - use bitvector for a cset to write an initialization for
+ *    a cset block.
+ */
+void cset_init(f, bv)
+FILE *f;
+unsigned short *bv;
+   {
+   int size;
+   unsigned short n;
+   register int j;
+
+   size = 0;
+   for (j = 0; j < BVectSize; ++j)
+      for (n = bv[j]; n != 0; n >>= 1)
+         size += n & 1;
+   fprintf(f, "{T_Cset, %d,\n", size);
+   fprintf(f, "   cset_display(0x%x", bv[0]);
+   for (j = 1; j < BVectSize; ++j)
+      fprintf(f, ",0x%x", bv[j]);
+   fprintf(f, ")\n    };\n");
+   }
+
+/*
+ * prtstr - print an Icon string literal as a C string literal.
+ */
+int prt_i_str(f, s, len)
+FILE *f;
+char *s;
+int len;
+   {
+   int c;
+   int n_chars;
+
+   n_chars = 0;
+   while (len-- > 0) {
+      ++n_chars;
+      c = *s++;
+      if (c == '\\')
+         c = escape(&s, &len);
+      switch (c) {
+         case '\n':
+            fprintf(f, "\\n");
+            break;
+         case '\t':
+            fprintf(f, "\\t");
+            break;
+         case '\v':
+            fprintf(f, "\\v");
+            break;
+         case '\b':
+            fprintf(f, "\\b");
+            break;
+         case '\r':
+            fprintf(f, "\\r");
+            break;
+         case '\f':
+            fprintf(f, "\\f");
+            break;
+         case '\\':
+            fprintf(f, "\\\\");
+            break;
+         case '\"':
+            fprintf(f, "\\\"");
+            break;
+         default:
+            if (isprint(c))
+               fprintf(f, "%c", c);
+            else
+               fprintf(f, "\\%03o", (int)c);
+         }
+      }
+   return n_chars;
+   }
diff --git a/src/common/long.c b/src/common/long.c
new file mode 100644
index 0000000..071a944
--- /dev/null
+++ b/src/common/long.c
@@ -0,0 +1,34 @@
+/*
+ *  long.c -- functions for handling long values on 16-bit computers.
+ */
+
+#include "../h/gsupport.h"
+
+/*
+ * Write a long string in int-sized chunks.
+ */
+
+long longwrite(s,len,file)
+FILE *file;
+char *s;
+long len;
+{
+   long tally = 0;
+   int n = 0;
+   int leftover, loopnum;
+   char *p;
+
+   leftover = (int)(len % (long)MaxInt);
+   for (p = s, loopnum = (int)(len / (long)MaxInt); loopnum; loopnum--) {
+       n = fwrite(p,sizeof(char),MaxInt,file);
+       tally += (long)n;
+       p += MaxInt;
+   }
+   if (leftover) {
+      n = fwrite(p,sizeof(char),leftover,file);
+      tally += (long)n;
+      }
+   if (tally != len)
+      return -1;
+   else return tally;
+   }
diff --git a/src/common/mktoktab.icn b/src/common/mktoktab.icn
new file mode 100644
index 0000000..c066958
--- /dev/null
+++ b/src/common/mktoktab.icn
@@ -0,0 +1,507 @@
+# Build the files:
+#    lextab.h - token tables and operator recognizer
+#    yacctok.h - %token declarations for YACC
+# from token description file "tokens.txt" and operator description
+# file "op.txt".
+
+global token, tokval, bflag, eflag, head, oper, tail, count
+global restable, flagtable, op_lst, asgn_loc, semicol_loc, plus_loc, minus_loc
+global white_sp, unary_set
+global tokfile, opfile, toktab, tok_dot_h
+
+record op_sym(op, aug, tokval, unary, binary)
+record association(op, n)
+record trie(by_1st_c, dflt)
+
+procedure tokpat()
+   if tab(many(white_sp)) & (token := tab(upto(white_sp))) &
+      tab(many(white_sp)) & (tokval := (tab(upto(white_sp) | 0)))
+   then return (tab(upto('b')) & (bflag := move(1))) | (bflag := "") &
+      ((tab(upto('e')) & (eflag := move(1))) | (eflag := "")) & pos(0)
+end
+
+procedure main()
+   local line, letter, lastletter
+   local s, op, aug, tok, unary, binary, tok_chars, sym, op_trie
+   local prognm, tokfnm, opfnm, toktbnm, dothnm, op_linenum
+
+   white_sp := ' \t'
+
+   prognm := "mktoktab"
+   tokfnm := "tokens.txt"
+   opfnm := "op.txt"
+   toktbnm := "lextab.h"
+   dothnm := "yacctok.h"
+
+   restable := table()
+   flagtable := table("")
+   flagtable[""] := "0"
+   flagtable["b"] := "Beginner"
+   flagtable["e"] := "Ender"
+   flagtable["be"] := "Beginner+Ender"
+   count := 0
+   lastletter := ""
+
+   tokfile := open(tokfnm) | stop("unable to open \"", tokfnm, "\"")
+   opfile := open(opfnm) | stop("unable to open \"", opfnm, "\"")
+   toktab := open(toktbnm,"w") | stop("unable to create \"", toktbnm, "\"")
+   tok_dot_h := open(dothnm,"w") | stop("unable to create \"", dothnm, "\"")
+   write("  writing ", tokfnm, " and ", dothnm)
+
+# Output header for token table
+   write(toktab,"/*")
+   write(toktab," * NOTE: this file is generated automatically by ", prognm)
+   write(toktab," *  from ", tokfnm, " and ", opfnm, ".")
+   write(toktab," */")
+   write(toktab)
+   write(toktab,"/*")
+   write(toktab," * Token table - contains an entry for each token type")
+   write(toktab," * with printable name of token, token type, and flags")
+   write(toktab," * for semicolon insertion.")
+   write(toktab," */")
+   write(toktab)
+   write(toktab,"struct toktab toktab[] = {")
+   write(toktab,"/*  token\t\ttoken type\tflags */")
+   write(toktab)
+   write(toktab,"   /* primitives */")
+
+# output header for token include file
+   write(tok_dot_h,"/*")
+   write(tok_dot_h," * NOTE: these %token declarations are generated")
+   write(tok_dot_h," *  automatically by ", prognm, " from ", tokfnm, " and ")
+   write(tok_dot_h," *  ", opfnm, ".")
+   write(tok_dot_h," */")
+   write(tok_dot_h)
+   write(tok_dot_h, "/* primitive tokens */")
+   write(tok_dot_h)
+
+
+# Skip the first few (non-informative) lines of "tokens.txt"
+
+   garbage()
+
+# Read primitive tokens
+
+   repeat {
+      write(toktab,makeline(token,tokval,bflag || eflag,count))
+      wrt_tok_def(tokval)
+      count +:= 1
+      line := read(tokfile) | stop("premature end-of-file")
+      line ? tokpat() | break
+         }
+
+# Skip some more garbage lines
+
+   garbage()
+
+# Output some more comments
+
+   write(toktab)
+   write(toktab,"   /* reserved words */")
+   write(tok_dot_h)
+   write(tok_dot_h, "/* reserved words */")
+   write(tok_dot_h)
+
+# Read in reserved words, output them,
+# and build table of first letters.
+
+   repeat {
+      write(toktab,makeline(token,tokval,bflag || eflag,count))
+      wrt_tok_def(tokval, token)
+      letter := token[1]
+      if letter ~== lastletter then {
+         lastletter := letter
+         restable[letter] := count
+        }
+   count +:= 1
+   line := read(tokfile) | stop("premature end-of-file")
+   if line ? tokpat() then next else break
+   }
+
+# output end of token table and reserveed word first-letter index.
+
+   write(toktab,makeline("end-of-file","0","",""))
+   write(toktab,"   };")
+   write(toktab)
+   write(toktab,"/*")
+   write(toktab," * restab[c] points to the first reserved word in toktab which")
+   write(toktab," * begins with the letter c.")
+   write(toktab," */")
+   write(toktab)
+   write(toktab,"struct toktab *restab[] = {")
+   write(toktab,makeres("abcd", 16r61))
+   write(toktab,makeres("efgh"))
+   write(toktab,makeres("ijkl"))
+   write(toktab,makeres("mnop"))
+   write(toktab,makeres("qrst"))
+   write(toktab,makeres("uvwx"))
+   write(toktab,makeres("yz"))
+   write(toktab,"   };")
+
+# Another comment
+
+   write(toktab)
+   write(toktab,"/*")
+   write(toktab," * The operator table acts to extend the token table, it")
+   write(toktab," *  indicates what implementations are expected from rtt,")
+   write(toktab," *  and it has pointers for the implementation information.")
+   write(toktab," */")
+   write(toktab)
+   write(toktab, "struct optab optab[] = {")
+   write(tok_dot_h)
+   write(tok_dot_h, "/* operators */")
+   write(tok_dot_h)
+
+# read operator file
+
+   tok_chars := &lcase ++ &ucase ++ '_'
+
+   op_linenum := 0
+   unary_set := set()
+   ops := table()
+   op_lst := []
+   
+   while s := read(opfile) do {
+      op_linenum +:= 1
+      s ? {
+         tab(many(white_sp))
+         if pos(0) | = "#" then
+            next
+         op := tab(upto(white_sp)) | err(opfnm, op_linenum,
+            "unexpected end of line")
+         tab(many(white_sp))
+         if ="(:=" then {
+            tab(many(white_sp))
+            if not ="AUG)" then
+               err(opfnm, op_linenum, "invalid augmented indication")
+            tab(many(white_sp))
+            aug := 1
+            }
+         else
+            aug := &null
+         tok := tab(many(tok_chars)) | err(opfnm, op_linenum, "invalid token")
+         tab(many(white_sp))
+         unary := tab(any('_us')) | err(opfnm,op_linenum,"invalid unary flag")
+         tab(many(white_sp))
+         binary := tab(any('_bs')) | err(opfnm,op_linenum,"invalid binary flag")
+         if unary == "_" & binary == "_" then
+            err(opfnm, op_linenum, "either unary or binary flag must be set")
+         if unary ~== "_" then {
+            if *op ~= 1 then
+               err(opfnm, op_linenum,
+                  "unary operators must be single characters: " || op);
+            insert(unary_set, op)
+            }
+         if \aug & binary == "_" then
+            err(opfnm, op_linenum,
+              "binary flag must be set for augmented assignment")
+
+         ops[op] := op_sym(op, aug, tok, unary, binary)
+         }
+      }
+
+   ops := sort(ops, 3)
+   while get(ops) & sym := get(ops) do
+     op_out(sym.op, sym.aug, sym.tokval, sym.unary, sym.binary)
+
+# Skip more garbage
+
+   garbage()
+
+repeat {
+   wrt_op(token, tokval, bflag || eflag, 0, 1)
+   line := read(tokfile) | stop("premature end-of-file")
+   line ? tokpat() | break
+   }
+
+# Skip more garbage
+
+   garbage()
+
+repeat {
+   wrt_op(token, tokval, bflag || eflag, 0, &null)
+   line := read(tokfile) | stop("premature end-of-file")
+   line ? tokpat() | break
+   }
+   write(toktab,
+      "   {{NULL,          0,     0},        0,              NULL, NULL}")
+   write(toktab, "   };")
+
+   write(toktab)
+   if /asgn_loc then
+      stop(opfnm, " does not contain a definition for ':='")
+   if /semicol_loc then
+      stop(tokfnm, " does not contain a definition for ';'")
+   if /plus_loc then
+      stop(tokfnm, " does not contain a definition for '+'")
+   if /minus_loc then
+      stop(tokfnm, " does not contain a definition for '-'")
+   write(toktab, "int asgn_loc = ", asgn_loc, ";")
+   write(toktab, "int semicol_loc = ", semicol_loc, ";")
+   write(toktab, "int plus_loc = ", plus_loc, ";")
+   write(toktab, "int minus_loc = ", minus_loc, ";")
+
+   op_trie := build_trie(op_lst)
+
+   write(toktab);
+   wrt(toktab, 0, "/*")
+   wrt(toktab, 0, " * getopr - find the longest legal operator and return the")
+   wrt(toktab, 0, " *  index to its entry in the operator table.")
+   wrt(toktab, 0, " */\n")
+   wrt(toktab, 0, "int getopr(ac, cc)")
+   wrt(toktab, 0, "int ac;")
+   wrt(toktab, 0, "int *cc;")
+   wrt(toktab, 1, "{")
+   wrt(toktab, 1, "register char c;\n")
+   wrt(toktab, 1, "*cc = ' ';")
+   bld_slct(op_trie, "", "ac", toktab, 1)
+   wrt(toktab, 1, "tfatal(\"invalid character\", (char *)NULL);")
+   wrt(toktab, 1, "return -1;")
+   wrt(toktab, 1, "}")
+end
+
+procedure makeline(token,tokval,flag,count)	# build an output line for token table.
+   local line
+   line := left("   \"" || token || "\",",22) || left(tokval ||  ",",15)
+   flag := flagtable[flag] || ","
+   if count ~=== "" then flag := left(flag,19)
+   line ||:= flag
+   if count ~=== "" then line ||:= "/* " || right(count,3) || " */"
+   return line
+end
+
+# makeres - build an output line for reserved word index.
+#
+procedure makeres(lets, strt_repr)
+   local let, letters, line
+   static repr
+
+   repr := \strt_repr
+
+   line := "   "
+   letters := lets
+   every let := !lets do
+      if let ~== "." & \restable[let] then {
+         line ||:= "&toktab[" || right(restable[let],2) || "], "
+         }
+      else line ||:= "NULL,        "
+   line := left(line,55) || "/* " 
+   if integer(repr) then
+      line ||:= hex(repr) || "-" || hex((repr +:= *lets) - 1) || " "
+   return line || letters || " */"
+end
+
+procedure garbage()
+   local line
+   while line := read(tokfile) | stop("premature end-of-file") do
+      if line ? tokpat() then return
+end
+
+procedure hex(n)
+   local s
+   static hexdig
+
+   initial hexdig := "0123456789ABCDEF"
+
+   s := ""
+   while n > 0 do {
+      s := hexdig[n % 16 + 1] || s
+      n := n / 16
+      }
+   return s
+end
+
+procedure op_out(op, aug, tokval, unary, binary)
+   local flag, arity
+
+   if unary_str(op) then
+      flag := "b"
+   else
+      flag := ""
+   if unary == "u" then
+      arity := "Unary"
+   if binary == "b" then
+      if /arity then
+         arity := "Binary"
+      else
+         arity ||:= " | Binary"
+   /arity := "0"
+   wrt_op(op, tokval, flag, arity, 1)
+   if \aug then
+      wrt_op(op || ":=", "AUG" || tokval, "", "0", 1)
+end
+
+procedure wrt_op(op, tokval, flag, arity, define)
+   static cnt
+
+   initial cnt := 0;
+
+   flag := flagtable[flag]
+   writes(toktab, "   {{\"", left(esc(op) || "\",", 9))
+   writes(toktab, left(tokval || ",", 12))
+   writes(toktab, left(flag || "},", 11))
+   writes(toktab, left(arity|| ",", 16))
+   write(toktab, "NULL, NULL}, /* ", cnt, " */")
+   if \define then
+      wrt_tok_def(tokval, op)
+   if op == ":=" then
+      asgn_loc := cnt
+   else if op == ";" then
+      semicol_loc := cnt
+   else if op == "+" then
+      plus_loc := cnt
+   else if op == "-" then
+      minus_loc := cnt
+   put(op_lst, association(op, cnt))
+   cnt +:= 1
+end
+
+procedure wrt_tok_def(tokval, tok)
+   if \tok then
+      write(tok_dot_h, "%token\t", left(tokval, 12), "/* ", left(tok, 9),
+         " */")
+   else
+      write(tok_dot_h, "%token\t", tokval);
+end
+
+procedure unary_str(op)
+   if op == "" then
+      return
+   if member(unary_set, op[1]) then
+      return unary_str(op[2:0])
+end
+
+procedure err(file, line, msg)
+   stop(&errout, "file: ", file, ", line: ", line, " - ", msg)
+end
+
+procedure build_trie(ops)
+   local by_1st_c, dflt, asc, c, c_ops
+
+   by_1st_c := table()
+   every asc := !ops do {
+      #
+      # See if there are more characters in this operator.
+      #
+      if c := asc.op[1] then {
+          /by_1st_c[c] := []
+          put(by_1st_c[c], association(asc.op[2:0], asc.n))
+          }
+      else 
+          dflt := asc.n
+      }
+   by_1st_c := sort(by_1st_c)
+   every c_ops := !by_1st_c do
+      c_ops[2] := build_trie(c_ops[2])
+   return trie(by_1st_c, dflt)
+end
+
+
+# bld_slct - output selection code which will recongize operators
+#   represented by the given trie. Code has already been generated
+#   to recognize the string in prefix.
+procedure bld_slct(op_trie, prefix, char_src, f, indent)
+   local fall_through, by_1st_c, dflt, char, trie_1, a, ft
+
+   by_1st_c := op_trie.by_1st_c
+   dflt := op_trie.dflt
+
+   case *by_1st_c of {
+      0:
+         #
+         # There are no more characters to check. When execution gets
+         #  here in the generated code we have found a longest possible
+         #  operator: the one contained in prefix.
+         #
+         wrt(f, indent, "return " , dflt, ";   /* ", prefix, " */")
+      1: {
+         #
+         # If there is only one valid character to check for, generate an
+         #  if statement rather than a switch statement. If the character
+         #  is not next in the input, either we are already at the end of
+         #  a valid operator (in which case, the generated code must
+         #  must save the one-character look ahead) or the generated
+         #  code will fall through to an error message at the end of the
+         #  function.
+         #
+         char := by_1st_c[1][1]
+         trie_1 := by_1st_c[1][2]
+         wrt(f, indent, "if ((c = ", char_src, ") == '", esc(char), "') {")
+         fall_through := bld_slct(trie_1, prefix || char, "NextChar", f,
+            indent + 1)
+         wrt(f, indent + 1, "}")
+         if \dflt then {
+            wrt(f, indent, "else {")
+            wrt(f, indent + 1, "*cc = c;")
+            wrt(f, indent + 1, "return " , dflt, ";   /* ", prefix, " */")
+            wrt(f, indent + 1, "}")
+            }
+         else
+            fall_through := 1
+         }
+      default: {
+         #
+         # There are several possible next characters. Produce a switch
+         #  statement to check for them.
+         #
+         wrt(f, indent, "switch (c = ", char_src, ") {")
+         every a := !by_1st_c do {
+            char := a[1]
+            trie_1 := a[2]
+            wrt(f, indent + 1, "case '", esc(char), "':")
+            ft := bld_slct(trie_1, prefix || char, "NextChar", f, indent + 2)
+            if \ft then {
+               wrt(f, indent + 2, "break;")
+               fall_through := 1
+               }
+           }
+         if \dflt then {
+            wrt(f, indent + 1, "default:")
+            wrt(f, indent + 2, "*cc = c;")
+            wrt(f, indent + 2, "return " , dflt, ";   /* ", prefix, " */")
+            }
+         else
+            fall_through := 1
+         wrt(f, indent + 1, "}")
+         }
+      }
+
+   return fall_through
+end
+
+procedure wrt(f, indent, slst[])
+   local s1, i, exp_indent
+
+   exp_indent := indent * 3;
+   s1 := repl(" ", exp_indent)
+   while s1 ||:= get(slst) 
+   if (*s1 > 80) then {
+      #
+      # line too long, find first space before 80th column, and
+      #  break there. note, this will not work in general. it may
+      #  break a line within a string.
+      #
+      every i := 80 to 1 by -1 do
+         if s1[i] == " " then
+            if i <= exp_indent then {
+               #
+               # we have indented too far
+               #
+               wrt(f, indent - 1, s1[exp_indent+1:0])
+               return
+               }
+            else {
+               write(f, s1[1:i])
+               wrt(f, indent, s1[i+1:0])
+               return
+               }
+      }
+   write(f, s1)
+end
+
+procedure esc(c)
+   if c == "\\" then
+      return "\\\\"
+   else
+      return c
+end
diff --git a/src/common/munix.c b/src/common/munix.c
new file mode 100644
index 0000000..132f397
--- /dev/null
+++ b/src/common/munix.c
@@ -0,0 +1,258 @@
+/*
+ *  munix.c -- special common code from Unix
+ *
+ *  (Originally used only under Unix, but now on all platforms.)
+ */
+
+#include "../h/gsupport.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <unistd.h>
+
+/*
+ *  relfile(prog, mod) -- find related file.
+ *
+ *  Given that prog is the argv[0] by which this program was executed,
+ *  and assuming that it was set by the shell or other equally correct
+ *  invoker, relfile finds the location of a related file and returns
+ *  it in an allocated string.  It takes the location of prog, appends
+ *  mod, and canonizes the result; thus if argv[0] is icont or its path,
+ *  relfile(argv[0],"/../iconx") finds the location of iconx.
+ */
+char *relfile(char *prog, char *mod) {
+   static char baseloc[MaxPath];
+   char buf[MaxPath];
+
+   if (baseloc[0] == 0) {		/* if argv[0] not already found */
+
+      #if CYGWIN
+         char posix_prog[_POSIX_PATH_MAX + 1];
+         cygwin_conv_to_posix_path(prog, posix_prog);
+         prog = posix_prog;
+      #endif				/* CYGWIN */
+
+      if (findexe(prog, baseloc, sizeof(baseloc)) == NULL) {
+         fprintf(stderr, "cannot find location of %s\n", prog);
+         exit(EXIT_FAILURE);
+         }
+      if (followsym(baseloc, buf, sizeof(buf)) != NULL)
+         strcpy(baseloc, buf);
+   }
+
+   strcpy(buf, baseloc);		/* start with base location */
+   strcat(buf, mod);			/* append adjustment */
+   canonize(buf);			/* canonize result */
+   if (mod[strlen(mod)-1] == '/')	/* if trailing slash wanted */
+      strcat(buf, "/");			/* append to result */
+   return salloc(buf);			/* return allocated string */
+   }
+
+/*
+ *  findexe(prog, buf, len) -- find absolute executable path, given argv[0]
+ *
+ *  Finds the absolute path to prog, assuming that prog is the value passed
+ *  by the shell in argv[0].  The result is placed in buf, which is returned.
+ *  NULL is returned in case of error.
+ */
+
+char *findexe(char *name, char *buf, size_t len) {
+   int n;
+   char *s;
+
+   if (name == NULL)
+      return NULL;
+
+   /* if name does not contain a slash, search $PATH for file */
+   if (strchr(name, '/') != NULL)
+      strcpy(buf, name);
+   else if (findonpath(name, buf, len) == NULL)
+      return NULL;
+
+   /* if path is not absolute, prepend working directory */
+   if (buf[0] != '/') {
+      n = strlen(buf) + 1;
+      memmove(buf + len - n, buf, n);
+      if (getcwd(buf, len - n) == NULL)
+         return NULL;
+      s = buf + strlen(buf);
+      *s = '/';
+      memcpy(s + 1, buf + len - n, n);
+      }
+   canonize(buf);
+   return buf;
+   }
+
+/*
+ *  findonpath(name, buf, len) -- find name on $PATH
+ *
+ *  Searches $PATH (using POSIX 1003.2 rules) for executable name,
+ *  writing the resulting path in buf if found.
+ */
+char *findonpath(char *name, char *buf, size_t len) {
+   int nlen, plen;
+   char *path, *next, *sep, *end;
+   struct stat status;
+
+   nlen = strlen(name);
+   path = getenv("PATH");
+
+   if (path == NULL || *path == '\0')
+      path = ".";
+   #if CYGWIN
+      else {
+         char *posix_path;
+         posix_path = alloca(cygwin_win32_to_posix_path_list_buf_size(path));
+         cygwin_win32_to_posix_path_list(path, posix_path);
+         path = posix_path;
+         }
+   #endif				/* CYGWIN */
+
+   end = path + strlen(path);
+   for (next = path; next <= end; next = sep + 1) {
+      sep = strchr(next, ':');
+      if (sep == NULL)
+         sep = end;
+      plen = sep - next;
+      if (plen == 0) {
+         next = ".";
+         plen = 1;
+         }
+      if (plen + 1 + nlen + 1 > len)
+         return NULL;
+      memcpy(buf, next, plen);
+      buf[plen] = '/';
+      strcpy(buf + plen + 1, name);
+      if (access(buf, X_OK) == 0) {
+         if (stat(buf, &status) == 0 && S_ISREG(status.st_mode))
+            return buf;
+         }
+      }
+   return NULL;
+   }
+
+/*
+ *  followsym(name, buf, len) -- follow symlink to final destination.
+ *
+ *  If name specifies a file that is a symlink, resolves the symlink to
+ *  its ultimate destination, and returns buf.  Otherwise, returns NULL.
+ *
+ *  Note that symlinks in the path to name do not make it a symlink.
+ *
+ *  buf should be long enough to hold name.
+ */
+
+#define MAX_FOLLOWED_LINKS 24
+
+char *followsym(char *name, char *buf, size_t len) {
+   int i, n;
+   char *s, tbuf[MaxPath];
+
+   strcpy(buf, name);
+
+   for (i = 0; i < MAX_FOLLOWED_LINKS; i++) {
+      if ((n = readlink(buf, tbuf, sizeof(tbuf) - 1)) <= 0)
+         break;
+      tbuf[n] = 0;
+
+      if (tbuf[0] == '/') {
+         if (n < len)
+            strcpy(buf, tbuf);
+         else
+            return NULL;
+         }
+      else {
+         s = strrchr(buf, '/');
+         if (s != NULL)
+            s++;
+         else
+            s = buf;
+         if ((s - buf) + n < len)
+            strcpy(s, tbuf);
+         else
+            return NULL;
+         }
+      canonize(buf);
+      }
+
+   if (i > 0 && i < MAX_FOLLOWED_LINKS)
+      return buf;
+   else
+      return NULL;
+   }
+
+/*
+ *  canonize(path) -- put file path in canonical form.
+ *
+ *  Rewrites path in place, and returns it, after excising fragments of
+ *  "." or "dir/..".  All leading slashes are preserved but other extra
+ *  slashes are deleted.  The path never grows longer except for the
+ *  special case of an empty path, which is rewritten to be ".".
+ *
+ *  No check is made that any component of the path actually exists or
+ *  that inner components are truly directories.  From this it follows
+ *  that if "foo" is any file path, canonizing "foo/.." produces the path
+ *  of the directory containing "foo".
+ */
+
+char *canonize(char *path) {
+   int len;
+   char *root, *end, *in, *out, *prev;
+
+   /* initialize */
+   root = path;				/* set barrier for trimming by ".." */
+   end = path + strlen(path);		/* set end of input marker */
+   while (*root == '/')			/* preserve all leading slashes */
+      root++;
+   in = root;				/* input pointer */
+   out = root;				/* output pointer */
+
+   /* scan string one component at a time */
+   while (in < end) {
+
+      /* count component length */
+      for (len = 0; in + len < end && in[len] != '/'; len++)
+         ;
+
+      /* check for ".", "..", or other */
+      if (len == 1 && *in == '.')	/* just ignore "." */
+         in++;
+      else if (len == 2 && in[0] == '.' && in[1] == '.') {
+         in += 2;			/* skip over ".." */
+         /* find start of previous component */
+         prev = out;
+         if (prev > root)
+            prev--;			/* skip trailing slash */
+         while (prev > root && prev[-1] != '/')
+            prev--;			/* find next slash or start of path */
+         if (prev < out - 1
+         && (out - prev != 3 || strncmp(prev, "../", 3) != 0)) {
+            out = prev;		/* trim trailing component */
+            }
+         else {
+            memcpy(out, "../", 3);	/* cannot trim, so must keep ".." */
+            out += 3;
+            }
+         }
+      else {
+         memmove(out, in, len);		/* copy component verbatim */
+         out += len;
+         in += len;
+         *out++ = '/';			/* add output separator */
+         }
+
+      while (in < end && *in == '/')	/* consume input separators */
+         in++;
+      }
+
+   /* final fixup */
+   if (out > root)
+      out--;				/* trim trailing slash */
+   if (out == path)
+      *out++ = '.';			/* change null path to "." */
+   *out++ = '\0';
+   return path;				/* return result */
+   }
diff --git a/src/common/op.txt b/src/common/op.txt
new file mode 100644
index 0000000..fa80fc5
--- /dev/null
+++ b/src/common/op.txt
@@ -0,0 +1,61 @@
+#  This file contains tokens for symbols used in standard unary/binary syntax
+#
+#  operator      token      unary/binary/special    (see notes at bottom)
+
+   :=             ASSIGN     _ b
+   :=:            SWAP       _ b
+   <-             REVASSIGN  _ b
+   <->            REVSWAP    _ b
+   &    (:=  AUG) AND        s b   # unary form is for keywords
+   @    (:=  AUG) AT         s s   # control structures for activation
+   ^    (:=  AUG) CARET      u b
+   ||   (:=  AUG) CONCAT     _ b
+   --   (:=  AUG) DIFF       _ b
+   ===  (:=  AUG) EQUIV      _ b
+   **   (:=  AUG) INTER      _ b
+   |||  (:=  AUG) LCONCAT    _ b
+   -    (:=  AUG) MINUS      u b
+   %    (:=  AUG) MOD        _ b
+   ~=== (:=  AUG) NEQUIV     _ b
+   =    (:=  AUG) NMEQ       u b
+   >=   (:=  AUG) NMGE       _ b
+   >    (:=  AUG) NMGT       _ b
+   <=   (:=  AUG) NMLE       _ b
+   <    (:=  AUG) NMLT       _ b
+   ~=   (:=  AUG) NMNE       _ b
+   +    (:=  AUG) PLUS       u b
+   ?    (:=  AUG) QMARK      u s   # binary form is a control structure
+   ==   (:=  AUG) SEQ        _ b
+   >>=  (:=  AUG) SGE        _ b
+   >>   (:=  AUG) SGT        _ b
+   <<=  (:=  AUG) SLE        _ b
+   <<   (:=  AUG) SLT        _ b
+   ~==  (:=  AUG) SNE        _ b
+   /    (:=  AUG) SLASH      u b
+   *    (:=  AUG) STAR       u b
+   ++   (:=  AUG) UNION      _ b
+   \              BACKSLASH  u s   # binary form is a control structure
+   |              BAR        s s   # unary & binary forms are control strutures
+   !              BANG       u s   # binary form is a control structure
+   .              DOT        u s   # binary form is for field references
+   ~              TILDE      u _
+
+
+# notes,
+#
+#  (:=  AUG) indicates that the binary operator has an augmented
+#            assignment form. For example, the entry 
+#                 +    (:=  AUG) PLUS      ub
+#            acts like two entries:
+#                 +              PLUS      ub
+#                 +:=            AUGPLUS    b
+#             except that the compiler automatically combines the
+#             implementations for + and := to implement +:=.
+#  
+#  1st flag: _ - no unary form
+#            u - unary operator implemented by .rtt file
+#            s - unary form but special implementation within the compiler
+#
+#  2st flag: _ - no binary form
+#            b - binary operator implemented by .rtt file
+#            s - binary form but special implementation within the compiler
diff --git a/src/common/patchstr.c b/src/common/patchstr.c
new file mode 100644
index 0000000..7edc24c
--- /dev/null
+++ b/src/common/patchstr.c
@@ -0,0 +1,189 @@
+/*
+ * patchstr.c -- install a string at preconfigured points in an executable
+ *
+ *  Usage:  patchstr filename newstring		-- to patch a file
+ *          patchstr filename			-- to report existing values
+ *
+ *  Patchstr installs or changes strings in an executable file.  It replaces
+ *  null-terminated strings of up to 500 characters that are immediately
+ *  preceded by the eighteen (unterminated) characters "%PatchStringHere->".
+ *
+ *  If the new string is shorter than the old string, it is null-padded.
+ *  If the old string is shorter, it must have suffient null padding to
+ *  accept the new string.
+ *
+ *  If no "newstring" is specified, existing values are printed.
+ *
+ *  4-Aug-91, 14-Feb-92 gmt
+ */
+
+#include "../h/rt.h"
+
+#undef strlen
+
+void	report		(char *filename);
+void	patchstr	(char *filename, char *newstring);
+int	findpattern	(FILE *f);
+int	oldval		(FILE *f, char *buf);
+
+/* guard pattern; first character must not reappear later */
+#define PATTERN "%PatchStringHere->"
+
+/* maximum string length */
+#define MAXLEN 500
+
+int exitcode = 0;		/* exit code; nonzero if any problems */
+int nfound = 0;			/* number of strings found */
+int nchanged = 0;		/* number of strings changed */
+
+/*
+ * main program
+ */
+int main (argc, argv)
+int argc;
+char *argv[];
+   {
+   char *fname, *newstr;
+
+   if (argc < 2 || argc > 3) {
+      fprintf(stderr, "usage: %s filename [newstring]\n", argv[0]);
+      exit(1);
+      }
+   fname = argv[1];
+   newstr = argv[2];
+   if (newstr)
+      patchstr(fname, newstr);
+   else
+      report(fname);
+   exit(exitcode);
+   /*NOTREACHED*/
+   }
+
+/*
+ * report (filename) -- report existing string values in a file
+ */
+void report (fname)
+char *fname;
+   {
+   FILE *f;
+   long posn;
+   int n;
+   char buf[MAXLEN+2];
+
+   if (!(f = fopen(fname, "rb"))) {	/* open read-only */
+      perror(fname);
+      exit(1);
+      }
+   while (findpattern(f)) {		/* find occurrence of magic string */
+      nfound++;
+      posn = ftell(f);			/* remember current location */
+      n = oldval(f, buf);		/* check available space */
+      fseek(f, posn, 0);		/* reposition to beginning of string */
+      if (n > MAXLEN) {
+         strcpy (buf+40, "...  [unterminated]");
+         exitcode = 1;
+         }
+      printf("at byte %ld:\t%s\n", posn, buf);	/* print value */
+      }
+   if (nfound == 0) {
+      fprintf(stderr, "flag pattern not found\n");
+      exitcode = 1;
+      }
+   }
+
+/*
+ * patchstr (filename, newstring) -- patch a file
+ */
+void patchstr (fname, newstr)
+char *fname, *newstr;
+   {
+   FILE *f;
+   long posn;
+   int n;
+   char buf[MAXLEN+2];
+
+   if (!(f = fopen(fname, "r+b"))) {	/* open for read-and-update */
+      perror(fname);
+      exit(1);
+      }
+   while (findpattern(f)) {		/* find occurrence of magic string */
+      nfound++;
+      posn = ftell(f);			/* remember current location */
+      n = oldval(f, buf);		/* check available space */
+      fseek(f, posn, 0);		/* reposition to beginning of string */
+      if (n > MAXLEN) {
+         fprintf(stderr, "at byte %ld: unterminated string\n", posn);
+         exitcode = 1;
+         }
+      else if (n < (int)strlen(newstr)) {
+         fprintf (stderr, "at byte %ld: buffer only holds %d characters\n",
+            posn, n);
+         exitcode = 1;
+         }
+      else {
+         fputs(newstr, f);		/* rewrite string with new value */
+         n -= strlen(newstr);
+         while (n-- > 0)
+            putc('\0', f);		/* pad out with NUL characters */
+         nchanged++;
+         fseek(f, 0L, 1);		/* re-enable reading */
+         }
+      }
+   if (nfound == 0) {
+      fprintf(stderr, "flag pattern not found\n");
+      exitcode = 1;
+      }
+   else
+      fprintf(stderr, "replaced %d occurrence%s\n", nchanged,
+         nchanged == 1 ? "" : "s");
+   }
+
+/*
+ * findpattern(f) - read until the magic pattern has been matched
+ *
+ *  Return 1 if successful, 0 if not.
+ */
+int findpattern(f)
+FILE *f;
+   {
+   int c;
+   char *p;
+
+   p = PATTERN;			/* p points to next char we're looking for */
+   for (;;) {
+      c = getc(f);		/* get next char from file */
+      if (c == EOF)
+         return 0;		/* if EOF, give up */
+      if (c != *p) {
+         p = PATTERN;		/* if mismatch, start over */
+         if (c == *p)		/* (but see if matched pattern start) */
+            p++;
+         continue;
+         }
+      if (*++p == '\0')		/* if entire pattern matched */
+         return 1;
+      }
+   }
+
+/*
+ * oldval(f, buf) - read old string into buf and return usable length
+ *
+ *  The "usable" (replaceable) length for rewriting takes null padding into
+ *  account up to MAXLEN.  A returned value greater than that indicates an
+ *  unterminated string.  The file will need to be repositioned after calling
+ *  this function.
+ */
+int oldval(f, buf)
+FILE *f;
+char buf[MAXLEN+2];
+   {
+   int n;
+   char *e, *p;
+
+   n = fread(buf, 1, MAXLEN+1, f);	/* read up to MAXLEN + null char */
+   e = buf + n;				/* note end of read area */
+   n = strlen(buf);			/* count string length proper */
+   for (p = buf + n + 1; p < e && *p == '\0'; p++)
+      n++;				/* count nulls beyond end */
+   return n;				/* return usable length */
+   }
diff --git a/src/common/pscript.icn b/src/common/pscript.icn
new file mode 100644
index 0000000..d9b2ee7
--- /dev/null
+++ b/src/common/pscript.icn
@@ -0,0 +1,44 @@
+#  Program to sanitize Yacc output and  minor changes to it to suit the Icon
+#  translator.
+
+# procedure to skip optional white space.
+procedure sws()
+   return tab( many( ' \t' ) ) | ""
+end
+
+$ifdef _CYGWIN
+   $define YY_STATE "yystate"
+$else					# _CYGWIN
+   $define YY_STATE "yy_state"
+$endif					# _CYGWIN
+
+procedure main()
+   local line, prefix
+
+   while line := read() do {
+      if line == "#" then next		# omit lone #s -- illegal now
+      else line ? {
+         if write(="#endif") then next	# omit illegal stuff
+         else if (prefix := tab(find("yyerror"))) & ="yyerror" & sws() & ="(" &
+            sws() & ="\"" then {
+            #
+            # We are beyond the 'yyerror( "'. Write the part of the
+            # line before the call, then decide what to do about
+            # the error message that follows.
+            #
+            writes(prefix)
+            if ="syntax error\"" then
+               writes("yyerror(yychar, yylval, ", YY_STATE)
+            else if ="yacc stack overflow\"" then
+               writes("tsyserr(\"parse stack overflow\"")
+            else
+               writes("tsyserr(\"parser: ")
+             write(tab(0))
+             }
+          else if ="extern char *malloc(), *realloc();" then {
+             # let proto.h handle this declaration.
+             }
+          else write(tab(0))
+          }
+      }
+end
diff --git a/src/common/rtdb.c b/src/common/rtdb.c
new file mode 100644
index 0000000..5467244
--- /dev/null
+++ b/src/common/rtdb.c
@@ -0,0 +1,1692 @@
+/*
+ * Routines to read a data base of run-time information.
+ */
+#include "../h/gsupport.h"
+#include "../h/version.h"
+#include "icontype.h"
+
+/*
+ * GetInt - the next thing in the data base is an integer. Get it.
+ */
+#define GetInt(n, c)\
+   n = 0;\
+   while (isdigit(c)) {\
+      n = n * 10 + (c - '0');\
+      c = getc(db);\
+      }
+
+/*
+ * SkipWhSp - skip white space characters in the data base.
+ */
+#define SkipWhSp(c)\
+   while (isspace(c)) {\
+      if (c == '\n')\
+         ++dbline;\
+      c = getc(db);\
+      }
+
+/*
+ * prototypes for static functions.
+ */
+static int            cmp_1_pre  (int p1, int p2);
+static struct il_code *db_abstr  (void);
+static void         db_case   (struct il_code *il, int num_cases);
+static void         db_err3   (int fatal,char *s1,char *s2,char *s3);
+static int             db_icntyp (void);
+static struct il_c    *db_ilc    (void);
+static struct il_c    *db_ilcret (int il_c_type);
+static struct il_code *db_inlin  (void);
+static struct il_code *db_ilvar  (void);
+static int             db_rtflg  (void);
+static int             db_tndtyp (void);
+static struct il_c    *new_ilc   (int il_c_type);
+static void          quoted   (int delim);
+
+extern char *progname;   /* name of program using this module */
+
+static char *dbname;           /* data base name */
+static FILE *db;               /* data base  file */
+static int dbline;             /* line number current position in data base */
+static struct str_buf db_sbuf; /* string buffer */
+static int *type_map;          /* map data base type codes to internal ones */
+static int *compnt_map;        /* map data base component codes to internal */
+
+/*
+ * opendb - open data base and do other house keeping.
+ */
+int db_open(s, lrgintflg)
+char *s;
+char **lrgintflg;
+   {
+   char *msg_buf;
+   char *id;
+   int i, n;
+   register int c;
+   static int first_time = 1;
+
+   if (first_time) {
+      first_time = 0;
+      init_sbuf(&db_sbuf);
+      }
+   dbname = s;
+   dbline = 0;
+   *lrgintflg = NULL;
+   db = fopen(dbname, "rb");
+   if (db == NULL)
+      return 0;
+   ++dbline;
+
+   /*
+    * Make sure the version number in the data base is what is expected.
+    */
+   s = db_string();
+   if (strcmp(s, DVersion) != 0) {
+      msg_buf = alloc(35 + strlen(s) + strlen(progname) + strlen(DVersion));
+      sprintf(msg_buf, "found version %s, %s requires version %s",
+           s, progname, DVersion);
+      db_err1(1, msg_buf);
+      }
+
+   *lrgintflg = db_string();  /* large integer flag */
+
+   /*
+    * Create tables for mapping type codes and type component codes in
+    *  the data base to those compiled into this program. The codes may
+    *  be different if types have been added to the program since the
+    *  data base was created.
+    */
+   type_map = alloc(num_typs * sizeof(int));
+   db_chstr("", "types");   /* verify section header */
+   c = getc(db);
+   SkipWhSp(c)
+   while (c == 'T') {
+      c = getc(db);
+      if (!isdigit(c))
+         db_err1(1, "expected type code");
+      GetInt(n, c)
+      if (n >= num_typs)
+         db_err1(1, "data base inconsistant with program, rebuild data base");
+      SkipWhSp(c)
+      if (c != ':')
+         db_err1(1, "expected ':'");
+      id = db_string();
+      for (i = 0; strcmp(id, icontypes[i].id) != 0; ++i)
+         if (i >= num_typs)
+            db_err2(1, "unknown type:", id);
+      type_map[n] = i;
+      c = getc(db);
+      SkipWhSp(c)
+      }
+   db_chstr("", "endsect");
+
+   compnt_map = alloc(num_cmpnts * sizeof(int));
+   db_chstr("", "components");   /* verify section header */
+   c = getc(db);
+   SkipWhSp(c)
+   while (c == 'C') {
+      c = getc(db);
+      if (!isdigit(c))
+         db_err1(1, "expected type component code");
+      GetInt(n, c)
+      if (n >= num_cmpnts)
+         db_err1(1, "data base inconsistant with program, rebuild data base");
+      SkipWhSp(c)
+      if (c != ':')
+         db_err1(1, "expected ':'");
+      id = db_string();
+      for (i = 0; strcmp(id, typecompnt[i].id) != 0; ++i)
+         if (i >= num_cmpnts)
+            db_err2(1, "unknown type component:", id);
+      compnt_map[n] = i;
+      c = getc(db);
+      SkipWhSp(c)
+      }
+   db_chstr("", "endsect");
+
+   return 1;
+   }
+
+/*
+ * db_close - close data base.
+ */
+void db_close()
+   {
+   if (fclose(db) != 0)
+      db_err2(0, "cannot close", dbname);
+   }
+
+/*
+ * db_string - get a white-space delimited string from the data base.
+ */
+char *db_string()
+   {
+   register int c;
+
+   /*
+    * Look for the start of the string; '$' starts a special indicator.
+    *  Copy characters into string buffer until white space is found.
+    */
+   c = getc(db);
+   SkipWhSp(c);
+   if (c == EOF)
+      db_err1(1, "unexpected EOF");
+   if (c == '$')
+      return NULL;
+   while (!isspace(c) && c != EOF) {
+      AppChar(db_sbuf, c);
+      c = getc(db);
+      }
+   if (c == '\n')
+      ++dbline;
+   return str_install(&db_sbuf); /* put string in string table */
+   }
+
+/*
+ * db_impl - read basic header information for an operation into a structure
+ *   and return it.
+ */
+struct implement *db_impl(oper_typ)
+int oper_typ;
+   {
+   register struct implement *ip;
+   register int c;
+   int i;
+   char *name;
+   long n;
+
+   /*
+    * Get operation name.
+    */
+   if ((name = db_string()) == NULL)
+      return NULL;
+
+   /*
+    * Create an internal structure to hold the data base entry.
+    */
+   ip = NewStruct(implement);
+   ip->blink = NULL;
+   ip->iconc_flgs = 0;         /* reserved for internal use by compiler */
+   ip->oper_typ = oper_typ;
+   ip->name = name;
+   ip->op = NULL;
+
+   /*
+    * Get the function name prefix assigned to this operation.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   if (isalpha(c) || isdigit(c))
+      ip->prefix[0] = c;
+   else
+     db_err2(1, "invalid prefix for", ip->name);
+   c = getc(db);
+   if (isalpha(c) || isdigit(c))
+      ip->prefix[1] = c;
+   else
+     db_err2(1, "invalid prefix for", ip->name);
+
+   /*
+    * Get the number of parameters.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   if (!isdigit(c))
+     db_err2(1, "number of parameters missing for", ip->name);
+   GetInt(n, c)
+   ip->nargs = n;
+
+   /*
+    * Get the flags that indicate whether each parameter requires a dereferenced
+    *  and/or undereferenced value, and whether the last parameter represents
+    *  the end of a varargs list. Store the flags in an array.
+    */
+   if (n == 0)
+      ip->arg_flgs = NULL;
+   else
+      ip->arg_flgs = alloc(n * sizeof(int));
+   if (c != '(')
+      db_err2(1, "parameter flags missing for", ip->name);
+   c = getc(db);
+   for (i = 0; i < n; ++i) {
+      if (c == ',' || c == ')')
+         db_err2(1, "parameter flag missing for", ip->name);
+      ip->arg_flgs[i] = 0;
+      while (c != ',' && c != ')') {
+          switch (c) {
+             case 'u':
+                ip->arg_flgs[i] |= RtParm;
+                break;
+             case 'd':
+                ip->arg_flgs[i] |= DrfPrm;
+                break;
+             case 'v':
+                ip->arg_flgs[i] |= VarPrm;
+                break;
+             default:
+                db_err2(1, "invalid parameter flag for", ip->name);
+             }
+         c = getc(db);
+         }
+      if (c == ',')
+         c = getc(db);
+      }
+   if (c != ')')
+     db_err2(1, "invalid parameter flag list for", ip->name);
+
+   /*
+    * Get the result sequence indicator for the operation.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   if (c != '{')
+     db_err2(1, "result sequence missing for", ip->name);
+   c = getc(db);
+   ip->resume = 0;
+   if (c == '}') {
+      ip->min_result = NoRsltSeq;
+      ip->max_result = NoRsltSeq;
+      }
+   else {
+      if (!isdigit(c))
+        db_err2(1, "invalid result sequence for", ip->name);
+      GetInt(n, c)
+      ip->min_result = n;
+      if (c != ',')
+        db_err2(1, "invalid result sequence for", ip->name);
+      c = getc(db);
+      if (c == '*') {
+         ip->max_result = UnbndSeq;
+         c = getc(db);
+         }
+      else if (isdigit(c)) {
+         GetInt(n, c)
+         ip->max_result = n;
+         }
+      else
+        db_err2(1, "invalid result sequence for", ip->name);
+      if (c == '+') {
+         ip->resume = 1;
+         c = getc(db);
+         }
+      if (c != '}')
+        db_err2(1, "invalid result sequence for", ip->name);
+      }
+
+   /*
+    * Get the flag indicating whether the operation contains returns, fails,
+    *  or suspends.
+    */
+   ip->ret_flag = db_rtflg();
+
+   /*
+    * Get the t/f flag that indicates whether the operation explicitly
+    *  uses the 'result' location.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case 't':
+         ip->use_rslt = 1;
+         break;
+      case 'f':
+         ip->use_rslt = 0;
+         break;
+      default:
+         db_err2(1, "invalid 'result' use indicator for", ip->name);
+         }
+   return ip;
+   }
+
+/*
+ * db_code - read the RTL code for the body of an operation.
+ */
+void db_code(ip)
+struct implement *ip;
+   {
+   register int c;
+   char *s;
+   word n;
+   int var_type;
+   int i;
+
+   /*
+    * read the descriptive string.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   if (c != '"')
+      db_err1(1, "operation description expected");
+   for (c = getc(db); c != '"' && c != '\n' && c != EOF; c = getc(db)) {
+      if (c == '\\') {
+         AppChar(db_sbuf, c);
+         c = getc(db);
+         }
+      AppChar(db_sbuf, c);
+      }
+   if (c != '"')
+      db_err1(1, "expected '\"'");
+   ip->comment = str_install(&db_sbuf);
+
+   /*
+    * Get the number of tended variables in the declare clause.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   GetInt(n, c)
+   ip->ntnds = n;
+
+   /*
+    * Read information about the tended variables into an array.
+    */
+   if (n == 0)
+      ip->tnds = NULL;
+   else
+      ip->tnds = alloc(n * sizeof(struct tend_var));
+   for (i = 0; i < n; ++i) {
+      var_type = db_tndtyp();  /* type of tended declaration */
+      ip->tnds[i].var_type = var_type;
+      ip->tnds[i].blk_name = NULL;
+      if (var_type == TndBlk) {
+         /*
+          * Tended block pointer declarations include a block type or '*' to
+          *  indicate 'union block *'.
+          */
+         s = db_string();
+         if (s == NULL)
+            db_err1(1, "block name expected");
+         if (*s != '*')
+            ip->tnds[i].blk_name = s;
+         }
+      ip->tnds[i].init = db_ilc();  /* C code for declaration initializer */
+      }
+
+   /*
+    * Get the number of non-tended variables in the declare clause.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   GetInt(n, c)
+   ip->nvars = n;
+
+   /*
+    * Get each non-tended declaration and store it in an array.
+    */
+   if (n == 0)
+      ip->vars = NULL;
+   else
+      ip->vars = alloc(n * sizeof(struct ord_var));
+   for (i = 0; i < n; ++i) {
+      s = db_string();             /* variable name */
+      if (s == NULL)
+         db_err1(1, "variable name expected");
+      ip->vars[i].name = s;
+      ip->vars[i].dcl = db_ilc();  /* full declaration including name */
+      }
+
+   /*
+    * Get the executable RTL code.
+    */
+   ip->in_line = db_inlin();
+
+   /*
+    * We should be at the end of the operation.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   if (c != '$')
+      db_err1(1, "expected $end");
+   }
+
+/*
+ * db_inlin - read in the in-line code (executable RTL code) for an operation.
+ */
+static struct il_code *db_inlin()
+   {
+   struct il_code *il = NULL;
+   register int c;
+   int i;
+   int indx;
+   int fall_thru;
+   int n, n1;
+
+   /*
+    * The following nested switch statements act as a trie for recognizing
+    *  the prefix form of RTL code in the data base.
+    */
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case 'a':
+         switch (getc(db)) {
+            case 'b': {
+               db_chstr("ab", "str");
+               il = new_il(IL_Abstr, 2);        /* abstract type computation */
+               il->u[0].fld = db_abstr();       /* side effects */
+               il->u[1].fld = db_abstr();       /* return type */
+               break;
+               }
+            case 'c': {
+               db_chstr("ac", "ase");
+               il = new_il(IL_Acase, 5);        /* arith_case */
+               il->u[0].fld = db_ilvar();       /* first variable */
+               il->u[1].fld = db_ilvar();       /* second variable */
+               il->u[2].fld = db_inlin();       /* C_integer action */
+               il->u[3].fld = db_inlin();       /* integer action */
+               il->u[4].fld = db_inlin();       /* C_double action */
+               break;
+               }
+            default:
+               db_err1(1, "expected abstr or acase");
+            }
+         break;
+
+      case 'b':
+         db_chstr("b", "lock");
+         c = getc(db);
+         SkipWhSp(c)
+         if (c == 't')
+            fall_thru = 1;
+         else
+            fall_thru = 0;
+         c = getc(db);
+         SkipWhSp(c)
+         GetInt(n, c)
+         il = new_il(IL_Block, 3 + n);    /* block of in-line C code */
+         il->u[0].n = fall_thru;
+         il->u[1].n = n;                  /* number of local tended */
+         for (i = 2; i - 2 < n; ++i)
+             il->u[i].n = db_tndtyp();    /* tended declaration */
+         il->u[i].c_cd = db_ilc();        /* C code */
+         break;
+
+      case 'c':
+         switch (getc(db)) {
+            case 'a': {
+               char prfx3;
+               int ret_val = 0;
+               int ret_flag;
+               int rslt = 0;
+               int num_sbuf;
+               int num_cbuf;
+
+               db_chstr("ca", "ll");
+               /*
+                * Call to body function. Get the letter used as the 3rd
+                *  character of the function prefix.
+                */
+               c = getc(db);
+               SkipWhSp(c)
+               prfx3 = c;
+
+               /*
+                * Determine what the body function returns directly.
+                */
+               c = getc(db);
+               SkipWhSp(c)
+               switch (c) {
+                  case 'i':
+                     ret_val = RetInt;    /* returns C integer */
+                     break;
+                  case 'd':
+                     ret_val = RetDbl;    /* returns C double */
+                     break;
+                  case 'n':
+                     ret_val = RetNoVal;  /* returns nothing directly */
+                     break;
+                  case 's':
+                     ret_val = RetSig;    /* returns a signal */
+                     break;
+                  default:
+                     db_err1(1, "invalid indicator for type of return value");
+                  }
+
+              /*
+               * Get the return/suspend/fail/fall-through flag.
+               */
+               c = getc(db);
+               ret_flag = db_rtflg();
+
+               /*
+                * Get the flag indicating whether the body function expects
+                *  to have an explicit result location passed to it.
+                */
+               c = getc(db);
+               SkipWhSp(c)
+               switch (c) {
+                  case 't':
+                     rslt = 1;
+                     break;
+                  case 'f':
+                     rslt = 0;
+                     break;
+                  default:
+                     db_err1(1, "t or f expected");
+                  }
+
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(num_sbuf, c)  /* number of cset buffers */
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(num_cbuf, c)  /* number of string buffers */
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)         /* num args */
+
+               il = new_il(IL_Call, 8 + n * 2);
+               il->u[0].n = 0;      /* reserved for internal use by compiler */
+               il->u[1].n = prfx3;
+               il->u[2].n = ret_val;
+               il->u[3].n = ret_flag;
+               il->u[4].n = rslt;
+               il->u[5].n = num_sbuf;
+               il->u[6].n = num_cbuf;
+               il->u[7].n = n;
+               indx = 8;
+
+               /*
+                * get the prototype parameter declarations and actual arguments.
+                */
+               n *= 2;
+               while (n--)
+                  il->u[indx++].c_cd = db_ilc();
+               }
+               break;
+
+            case 'n':
+               if (getc(db) != 'v')
+                  db_err1(1, "expected cnv1 or cnv2");
+               switch (getc(db)) {
+                  case '1':
+                     il = new_il(IL_Cnv1, 2);
+                     il->u[0].n = db_icntyp();      /* type code */
+                     il->u[1].fld = db_ilvar();     /* source */
+                     break;
+                  case '2':
+                     il = new_il(IL_Cnv2, 3);
+                     il->u[0].n = db_icntyp();      /* type code */
+                     il->u[1].fld = db_ilvar();     /* source */
+                     il->u[2].c_cd = db_ilc();      /* destination */
+                     break;
+                  default:
+                     db_err1(1, "expected cnv1 or cnv2");
+                  }
+               break;
+
+            case 'o':
+               db_chstr("co", "nst");
+               il = new_il(IL_Const, 2);     /* constant keyword */
+               il->u[0].n = db_icntyp();     /* type code */
+               c = getc(db);
+               SkipWhSp(c)
+               if (c == '"' || c == '\'') {
+                  quoted(c);
+                  c = getc(db);              /* quoted literal without quotes */
+                  }
+               else
+                  while (c != EOF && !isspace(c)) {
+                     AppChar(db_sbuf, c);
+                     c = getc(db);
+                     }
+               il->u[1].s = str_install(&db_sbuf); /* non-quoted values */
+               break;
+
+            default:
+               db_err1(1, "expected call, const, cnv1, or cnv2");
+            }
+         break;
+
+      case 'd':
+         if (getc(db) != 'e' || getc(db) != 'f')
+            db_err1(1, "expected def1 or def2");
+         switch (getc(db)) {
+            case '1':
+               il = new_il(IL_Def1, 3);       /* defaulting, no dest. field */
+               il->u[0].n = db_icntyp();      /* type code */
+               il->u[1].fld = db_ilvar();     /* source */
+               il->u[2].c_cd = db_ilc();      /* default value */
+               break;
+            case '2':
+               il = new_il(IL_Def2, 4);       /* defaulting, with dest. field */
+               il->u[0].n = db_icntyp();      /* type code */
+               il->u[1].fld = db_ilvar();     /* source */
+               il->u[2].c_cd = db_ilc();      /* default value */
+               il->u[3].c_cd = db_ilc();      /* destination */
+               break;
+            default:
+               db_err1(1, "expected dflt1 or dflt2");
+            }
+         break;
+
+      case 'r':
+         if (getc(db) != 'u' || getc(db) != 'n' || getc(db) != 'e' ||
+            getc(db) != 'r' || getc(db) != 'r')
+            db_err1(1, "expected runerr1 or runerr2");
+         switch (getc(db)) {
+            case '1':
+               il = new_il(IL_Err1, 1);       /* runerr, no offending value */
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)
+               il->u[0].n = n;                /* error number */
+               break;
+            case '2':
+               il = new_il(IL_Err2, 2);       /* runerr, with offending value */
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)
+               il->u[0].n = n;                /* error number */
+               il->u[1].fld = db_ilvar();     /* variable */
+               break;
+            default:
+               db_err1(1, "expected runerr1 or runerr2");
+            }
+         break;
+
+      case 'i':
+         switch (getc(db)) {
+            case 'f':
+               switch (getc(db)) {
+                  case '1':
+                     il = new_il(IL_If1, 2);    /* if-then */
+                     il->u[0].fld = db_inlin(); /* condition */
+                     il->u[1].fld = db_inlin(); /* then clause */
+                     break;
+                  case '2':
+                     il = new_il(IL_If2, 3);     /* if-then-else */
+                     il->u[0].fld = db_inlin(); /* condition */
+                     il->u[1].fld = db_inlin(); /* then clause */
+                     il->u[2].fld = db_inlin(); /* else clause */
+                     break;
+                  default:
+                     db_err1(1, "expected if1 or if2");
+                  }
+               break;
+            case 's':
+               il = new_il(IL_Is, 2);         /* type check */
+               il->u[0].n = db_icntyp();      /* type code */
+               il->u[1].fld = db_ilvar();     /* variable */
+               break;
+            default:
+               db_err1(1, "expected if1, if2, or is");
+            }
+         break;
+
+      case 'l':
+         switch (getc(db)) {
+            case 'c':
+               db_chstr("lc", "ase");
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)
+               il = new_il(IL_Lcase, 2 + 2 * n); /* length case */
+               il->u[0].n = n;                   /* number of cases */
+               indx = 1;
+               while (n--) {
+                  c = getc(db);
+                  SkipWhSp(c)
+                  GetInt(n1, c)
+                  il->u[indx++].n = n1;           /* selection number */
+                  il->u[indx++].fld = db_inlin(); /* action */
+                  }
+               il->u[indx].fld = db_inlin();      /* default */
+               break;
+
+            case 's':
+               if (getc(db) != 't')
+                  db_err1(1, "expected lst");
+               il = new_il(IL_Lst, 2);            /* sequence of code parts */
+               il->u[0].fld = db_inlin();         /* 1st part */
+               il->u[1].fld = db_inlin();         /* 2nd part */
+               break;
+
+            default:
+               db_err1(1, "expected lcase or lst");
+            }
+         break;
+
+      case 'n':
+         db_chstr("n", "il");
+         il = NULL;
+         break;
+
+      case 't': {
+         struct il_code *var;
+
+         if (getc(db) != 'c' || getc(db) != 'a' || getc(db) != 's' ||
+            getc(db) != 'e')
+               db_err1(1, "expected tcase1 or tcase2");
+         switch (getc(db)) {
+            case '1':
+               var = db_ilvar();
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)
+               il = new_il(IL_Tcase1, 3 * n + 2); /* type case, no default */
+               il->u[0].fld = var;                /* variable */
+               db_case(il, n);                    /* get cases */
+               break;
+
+            case '2':
+               var = db_ilvar();
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(n, c)
+               il = new_il(IL_Tcase2, 3 * n + 3);  /* type case, with default */
+               il->u[0].fld = var;                 /* variable */
+               db_case(il, n);                     /* get cases */
+               il->u[3 * n + 2].fld = db_inlin();  /* default */
+               break;
+
+            default:
+               db_err1(1, "expected tcase1 or tcase2");
+            }
+         }
+         break;
+
+      case '!':
+         il = new_il(IL_Bang, 1);                   /* negated condition */
+         il->u[0].fld = db_inlin();                 /* condition */
+         break;
+
+      case '&':
+         if (getc(db) != '&')
+            db_err1(1, "expected &&");
+         il = new_il(IL_And, 2);                    /* && (conjunction) */
+         il->u[0].fld = db_inlin();                 /* 1st operand */
+         il->u[1].fld = db_inlin();                 /* 2nd operand */
+         break;
+
+      default:
+         db_err1(1, "syntax error");
+      }
+   return il;
+   }
+
+/*
+ * db_rtflg - get the sequence of 4 [or 5] flags that indicate whether code
+ *  for a operation [or body function] returns, fails, suspends, has error
+ *  failure, [or execution falls through the code].
+ */
+static int db_rtflg()
+   {
+   register int c;
+   int ret_flag;
+
+   /*
+    * The presence of each flag is indicated by a unique character. Its absence
+    *  indicated by '_'.
+    */
+   ret_flag = 0;
+   c = getc(db);
+   SkipWhSp(c)
+   if (c == 'f')
+      ret_flag |= DoesFail;
+   else if (c != '_')
+     db_err1(1, "invalid return indicator");
+   c = getc(db);
+   if (c == 'r')
+      ret_flag |= DoesRet;
+   else if (c != '_')
+     db_err1(1, "invalid return indicator");
+   c = getc(db);
+   if (c == 's')
+      ret_flag |= DoesSusp;
+   else if (c != '_')
+     db_err1(1, "invalid return indicator");
+   c = getc(db);
+   if (c == 'e')
+      ret_flag |= DoesEFail;
+   else if (c != '_')
+     db_err1(1, "invalid return indicator");
+   c = getc(db);
+   if (c == 't')
+      ret_flag |= DoesFThru;
+   else if (c != '_' && c != ' ')
+     db_err1(1, "invalid return indicator");
+   return ret_flag;
+   }
+
+/*
+ * db_case - get the cases for a type_case statement from the data base.
+ */
+static void db_case(il, num_cases)
+struct il_code *il;
+int num_cases;
+   {
+   register int c;
+   int *typ_vect;
+   int i, j;
+   int num_types;
+   int indx;
+
+   il->u[1].n = num_cases;    /* number of cases */
+   indx = 2;
+   for (i = 0; i < num_cases; ++i) {
+      /*
+       * Determine the number of types in this case then store the
+       *  type codes in an array.
+       */
+      c = getc(db);
+      SkipWhSp(c)
+      GetInt(num_types, c)
+      il->u[indx++].n = num_types;
+      typ_vect = alloc(num_types * sizeof(int));
+      il->u[indx++].vect = typ_vect;
+      for (j = 0; j < num_types; ++j)
+         typ_vect[j] = db_icntyp();           /* type code */
+
+      il->u[indx++].fld = db_inlin();         /* action */
+      }
+   }
+
+/*
+ * db_ilvar - get a symbol table index for a simple variable or a
+ *  subscripted variable from the data base.
+ */
+static struct il_code *db_ilvar()
+   {
+   struct il_code *il;
+   register int c;
+   int n;
+
+   c = getc(db);
+   SkipWhSp(c)
+
+   if (isdigit(c)) {
+      /*
+       * Simple variable: just a symbol table index.
+       */
+      il = new_il(IL_Var, 1);
+      GetInt(n, c)
+      il->u[0].n = n;    /* symbol table index */
+      }
+   else {
+      if (c != '[')
+         db_err1(1, "expected symbol table index or '['");
+      /*
+       * Subscripted variable: symbol table index and subscript.
+       */
+      il = new_il(IL_Subscr, 2);
+      c = getc(db);
+      SkipWhSp(c);
+      GetInt(n, c)
+      il->u[0].n = n;    /* symbol table index */
+      c = getc(db);
+      SkipWhSp(c)
+      GetInt(n, c)
+      il->u[1].n = n;    /* subscripting index */
+      }
+   return il;
+   }
+
+/*
+ * db_abstr - get abstract type computations from the data base.
+ */
+static struct il_code *db_abstr()
+   {
+   struct il_code *il = NULL;
+   register int c;
+   word typcd;
+   word indx;
+   int n;
+   int nargs;
+
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case 'l':
+         db_chstr("l", "st");
+         il = new_il(IL_Lst, 2);        /* sequence of code parts */
+         il->u[0].fld = db_abstr();     /* 1st part */
+         il->u[1].fld = db_abstr();     /* 2nd part */
+         break;
+
+      case 'n':
+         switch (getc(db)) {
+            case 'e':
+               if (getc(db) != 'w')
+                  db_err1(1, "expected new");
+               typcd = db_icntyp();
+               c = getc(db);
+               SkipWhSp(c)
+               GetInt(nargs, c)
+               il = new_il(IL_New, 2 + nargs);  /* new structure create here */
+               il->u[0].n = typcd;              /* type code */
+               il->u[1].n = nargs;              /* number of args */
+               indx = 2;
+               while (nargs--)
+                  il->u[indx++].fld = db_abstr(); /* argument for component */
+               break;
+            case 'i':
+               if (getc(db) != 'l')
+                  db_err1(1, "expected nil");
+               il = NULL;
+               break;
+            default:
+               db_err1(1, "expected new or nil");
+            }
+       break;
+
+      case 's':
+         db_chstr("s", "tore");
+         il = new_il(IL_Store, 1);  /* abstract store */
+         il->u[0].fld = db_abstr(); /* type to "dereference" */
+         break;
+
+      case 't':
+         db_chstr("t", "yp");
+         il = new_il(IL_IcnTyp, 1);  /* explicit type */
+         il->u[0].n = db_icntyp();   /* type code */
+         break;
+
+      case 'v':
+         db_chstr("v", "artyp");
+         il = new_il(IL_VarTyp, 1);        /* variable */
+         il->u[0].fld = db_ilvar();        /* symbol table index, etc */
+         break;
+
+      case '.':
+         il = new_il(IL_Compnt, 2);        /* component access */
+         il->u[0].fld = db_abstr();        /* type being accessed */
+         c = getc(db);
+         SkipWhSp(c)
+         switch (c) {
+            case 'f':
+               il->u[1].n = CM_Fields;
+               break;
+            case 'C':
+               c = getc(db);
+               GetInt(n, c)
+               il->u[1].n = compnt_map[n];
+               break;
+            default:
+               db_err1(1, "expected component code");
+            }
+         break;
+
+      case '=':
+         il = new_il(IL_TpAsgn, 2);        /* assignment (side effect) */
+         il->u[0].fld = db_abstr();        /* left-hand-side */
+         il->u[1].fld = db_abstr();        /* right-hand-side */
+         break;
+
+      case '+':
+         if (getc(db) != '+')
+            db_err1(1, "expected ++");
+         il = new_il(IL_Union, 2);         /* ++ (union) */
+         il->u[0].fld = db_abstr();        /* 1st operand */
+         il->u[1].fld = db_abstr();        /* 2nd operand */
+         break;
+
+      case '*':
+         if (getc(db) != '*')
+            db_err1(1, "expected **");
+         il = new_il(IL_Inter, 2);         /* ** (intersection) */
+         il->u[0].fld = db_abstr();        /* 1st operand */
+         il->u[1].fld = db_abstr();        /* 2nd operand */
+         break;
+      }
+   return il;
+   }
+
+/*
+ * db_ilc - read a piece of in-line C code.
+ */
+static struct il_c *db_ilc()
+   {
+   register int c;
+   int old_c;
+   word n;
+   struct il_c *base = NULL;
+   struct il_c **nxtp = &base;
+
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case '$':
+         /*
+          * This had better be the starting $c.
+          */
+         c = getc(db);
+         if (c == 'c') {
+            c = getc(db);
+            for (;;) {
+               SkipWhSp(c)
+               if (c == '$') {
+                  c = getc(db);
+                  switch (c) {
+                     case 'c':             /* $cb or $cgoto <cond> <lbl num> */
+                        c = getc(db);
+                        switch (c) {
+                           case 'b':
+                              *nxtp = new_ilc(ILC_CBuf);
+                              c = getc(db);
+                              break;
+                           case 'g':
+                              db_chstr("$cg", "oto");
+                              *nxtp = new_ilc(ILC_CGto);
+#ifdef MultiThread
+   #undef code
+#endif					/* MultiThead */
+                              (*nxtp)->code[0] = db_ilc();
+                              c = getc(db);
+                              SkipWhSp(c);
+                              if (!isdigit(c))
+                                 db_err1(1, "$cgoto: expected label number");
+                              GetInt(n, c);
+                              (*nxtp)->n = n;
+                              break;
+                           default:
+                             db_err1(1, "expected $cb or $cgoto");
+                           }
+                        break;
+                     case 'e':
+                        c = getc(db);
+                        if (c == 'f') {             /* $efail */
+                            db_chstr("$ef", "ail");
+                            *nxtp = new_ilc(ILC_EFail);
+                            c = getc(db);
+                            break;
+                            }
+                        else
+                           return base;            /* $e */
+                     case 'f':                     /* $fail */
+                        db_chstr("$f", "ail");
+                        *nxtp = new_ilc(ILC_Fail);
+                        c = getc(db);
+                        break;
+                     case 'g':                     /* $goto <lbl num> */
+                        db_chstr("$g", "oto");
+                        *nxtp = new_ilc(ILC_Goto);
+                        c = getc(db);
+                        SkipWhSp(c);
+                        if (!isdigit(c))
+                           db_err1(1, "$goto: expected label number");
+                        GetInt(n, c);
+                        (*nxtp)->n = n;
+                        break;
+                     case 'l':                     /* $lbl <lbl num> */
+                        db_chstr("$l", "bl");
+                        *nxtp = new_ilc(ILC_Lbl);
+                        c = getc(db);
+                        SkipWhSp(c);
+                        if (!isdigit(c))
+                           db_err1(1, "$lbl: expected label number");
+                        GetInt(n, c);
+                        (*nxtp)->n = n;
+                        break;
+                     case 'm':                     /* $m[d]<indx> */
+                        *nxtp = new_ilc(ILC_Mod);
+                        c = getc(db);
+                        if (c == 'd') {
+                           (*nxtp)->s = "d";
+                           c = getc(db);
+                           }
+                        if (isdigit(c)) {
+                           GetInt(n, c);
+                           (*nxtp)->n = n;
+                           }
+                        else if (c == 'r') {
+                           (*nxtp)->n = RsltIndx;
+                           c = getc(db);
+                           }
+                        else
+                           db_err1(1, "$m: expected symbol table index");
+                        break;
+                     case 'r':                     /* $r[d]<indx> or $ret ... */
+                        c = getc(db);
+                        if (isdigit(c) || c == 'd') {
+                           *nxtp = new_ilc(ILC_Ref);
+                           if (c == 'd') {
+                              (*nxtp)->s = "d";
+                              c = getc(db);
+                              }
+                           GetInt(n, c);
+                           (*nxtp)->n = n;
+                           }
+                        else if (c == 'r') {
+                           *nxtp = new_ilc(ILC_Ref);
+                           (*nxtp)->n = RsltIndx;
+                           c = getc(db);
+                           }
+                        else {
+                           if (c != 'e' || getc(db) != 't')
+                              db_err1(1, "expected $ret");
+                           *nxtp = db_ilcret(ILC_Ret);
+                           c = getc(db);
+                           }
+                        break;
+                     case 's':                     /* $sb or $susp ... */
+                        c = getc(db);
+                        switch (c) {
+                           case 'b':
+                              *nxtp = new_ilc(ILC_SBuf);
+                              c = getc(db);
+                              break;
+                           case 'u':
+                              db_chstr("$su", "sp");
+                              *nxtp = db_ilcret(ILC_Susp);
+                              c = getc(db);
+                              break;
+                           default:
+                             db_err1(1, "expected $sb or $susp");
+                           }
+                        break;
+                     case 't':                     /* $t[d]<indx> */
+                        *nxtp = new_ilc(ILC_Tend);
+                        c = getc(db);
+                        if (!isdigit(c))
+                           db_err1(1, "$t: expected index");
+                        GetInt(n, c);
+                        (*nxtp)->n = n;
+                        break;
+                     case '{':
+                        *nxtp = new_ilc(ILC_LBrc);
+                        c = getc(db);
+                        break;
+                     case '}':
+                        *nxtp = new_ilc(ILC_RBrc);
+                        c = getc(db);
+                        break;
+                     default:
+                        db_err1(1, "invalid $ escape in C code");
+                     }
+                  }
+               else {
+                  /*
+                   * Arbitrary code - gather into a string.
+                   */
+                  while (c != '$') {
+                     if (c == '"' || c == '\'') {
+                        quoted(c);
+                        c = getc(db);
+                        }
+                     if (c == '\n')
+                        ++dbline;
+                     if (c == EOF)
+                        db_err1(1, "unexpected EOF in C code");
+                     old_c = c;
+                     AppChar(db_sbuf, c);
+                     c = getc(db);
+                     if (old_c == ' ')
+                        while (c == ' ')
+                           c = getc(db);
+                     }
+                  *nxtp = new_ilc(ILC_Str);
+                  (*nxtp)->s = str_install(&db_sbuf);
+                  }
+               nxtp = &(*nxtp)->next;
+               }
+            }
+         break;
+      case 'n':
+         db_chstr("n", "il");
+         return NULL;
+      }
+   db_err1(1, "expected C code of the form $c ... $e or nil");
+   /*NOTREACHED*/
+   return 0;	/* avoid gcc warning */
+   }
+
+/*
+ * quoted - get the string for a quoted literal. The first quote mark
+ *  has been read.
+ */
+static void quoted(delim)
+int delim;
+   {
+   register int c;
+
+   AppChar(db_sbuf, delim);
+   c = getc(db);
+   while (c != delim && c != EOF) {
+      if (c == '\\') {
+         AppChar(db_sbuf, c);
+         c = getc(db);
+         if (c == EOF)
+            db_err1(1, "unexpected EOF in quoted literal");
+         }
+      AppChar(db_sbuf, c);
+      c = getc(db);
+      }
+   if (c == EOF)
+      db_err1(1, "unexpected EOF in quoted literal");
+   AppChar(db_sbuf, c);
+   }
+
+/*
+ * db_ilcret - get the in-line C code on a return or suspend statement.
+ */
+static struct il_c *db_ilcret(il_c_type)
+int il_c_type;
+   {
+   struct il_c *ilc;
+   int c;
+   int n;
+   int i;
+
+   ilc = new_ilc(il_c_type);
+   ilc->n = db_icntyp();       /* kind of return expression */
+   c = getc(db);
+   SkipWhSp(c)
+   GetInt(n, c)                /* number of arguments in this expression */
+   for (i = 0; i < n; ++i)
+      ilc->code[i] = db_ilc(); /* an argument to the return expression */
+   return ilc;
+   }
+
+/*
+ * db_tndtyp - get the indication for the type of a tended declaration.
+ */
+static int db_tndtyp()
+   {
+   int c;
+
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case 'b':
+         db_chstr("b", "lkptr");
+         return TndBlk;          /* tended block pointer */
+      case 'd':
+         db_chstr("d", "esc");
+         return TndDesc;         /* tended descriptor */
+      case 's':
+         db_chstr("s", "tr");
+         return TndStr;          /* tended string */
+      default:
+         db_err1(1, "expected blkptr, desc, or str");
+         /* NOTREACHED */
+      }
+   /* NOTREACHED */
+   return 0;	/* avoid gcc warning */
+   }
+
+/*
+ * db_icntyp - get a type code from the data base.
+ */
+static int db_icntyp()
+   {
+   int c;
+   int n;
+
+   c = getc(db);
+   SkipWhSp(c)
+   switch (c) {
+      case 'T':
+         c = getc(db);
+         GetInt(n, c)
+         if (n < num_typs)
+            return type_map[n];       /* type code from specification system */
+         break;
+      case 'a':
+         return TypAny;               /* a - any type */
+      case 'c':
+         switch (getc(db)) {
+            case 'i':
+               return TypCInt;        /* ci - C integer */
+            case 'd':
+               return TypCDbl;        /* cd - C double */
+            case 's':
+               return TypCStr;        /* cs - C string */
+            }
+         break;
+      case 'd':
+         return RetDesc;              /* d - descriptor on return statement */
+      case 'e':
+         switch (getc(db)) {
+            case 'c':
+               if (getc(db) == 'i')
+                  return TypECInt;    /* eci - exact C integer */
+               break;
+            case 'i':
+               return TypEInt;        /* ei - exact integer */
+            case ' ':
+            case '\n':
+            case '\t':
+                return TypEmpty;      /* e - empty  type */
+            }
+         break;
+      case 'n':
+         if (getc(db) == 'v')
+            return RetNVar;           /* nv - named variable on return */
+         break;
+      case 'r':
+         if (getc(db) == 'n')
+            return RetNone;           /* rn - nothing explicitly returned */
+         break;
+      case 's':
+         if (getc(db) == 'v')
+            return RetSVar;           /* sv - structure variable on return */
+         break;
+      case 't':
+         switch (getc(db)) {
+            case 'c':
+               return TypTCset;       /* tc - temporary cset */
+            case 's':
+               return TypTStr;        /* ts - temporary string */
+            }
+         break;
+      case 'v':
+         return TypVar;               /* v - variable */
+      }
+   db_err1(1, "invalid type code");
+   /* NOTREACHED */
+   return 0;	/* avoid gcc warning */
+   }
+
+/*
+ * new_ilc - allocate a new structure to hold a piece of in-line C code.
+ */
+static struct il_c *new_ilc(il_c_type)
+int il_c_type;
+   {
+   struct il_c *ilc;
+   int i;
+
+   ilc = NewStruct(il_c);
+   ilc->next = NULL;
+   ilc->il_c_type = il_c_type;
+   for (i = 0; i < 3; ++i)
+      ilc->code[i] = NULL;
+   ilc->n = 0;
+   ilc->s = NULL;
+   return ilc;
+   }
+
+/*
+ * new_il - allocate a new structure with "size" fields to hold a piece of
+ *   RTL code.
+ */
+struct il_code *new_il(il_type, size)
+int il_type;
+int size;
+   {
+   struct il_code *il;
+
+   il = alloc(sizeof(struct il_code) + (size-1) * sizeof(union il_fld));
+   il->il_type = il_type;
+   return il;
+   }
+
+/*
+ * db_dscrd - discard an implementation up to $end, skipping the in-line
+ *   RTL code.
+ */
+void db_dscrd(ip)
+struct implement *ip;
+   {
+   char state;  /* how far along we are at recognizing $end */
+
+   free(ip);
+   state = '\0';
+   for (;;) {
+      switch (getc(db)) {
+         case '$':
+            state = '$';
+            continue;
+         case 'e':
+            if (state == '$') {
+               state = 'e';
+               continue;
+               }
+            break;
+         case 'n':
+            if (state == 'e') {
+               state = 'n';
+               continue;
+               }
+            break;
+         case 'd':
+            if (state == 'n')
+               return;
+            break;
+         case '\n':
+            ++dbline;
+            break;
+         case EOF:
+            db_err1(1, "unexpected EOF");
+         }
+      state = '\0';
+      }
+   }
+
+/*
+ * db_chstr - we are expecting a specific string. We may already have
+ *   read a prefix of it.
+ */
+void db_chstr(prefix, suffix)
+char *prefix;
+char *suffix;
+   {
+   int c;
+
+   c = getc(db);
+   SkipWhSp(c)
+
+   for (;;) {
+      if (*suffix == '\0' && (isspace(c) || c == EOF)) {
+         if (c == '\n')
+            ++dbline;
+         return;
+         }
+      else if (*suffix != c)
+         break;
+      c = getc(db);
+      ++suffix;
+      }
+   db_err3(1, "expected:", prefix, suffix);
+   }
+
+/*
+ * db_tbl - fill in a hash table of implementation information for the
+ *  given section.
+ */
+int db_tbl(section, tbl)
+char *section;
+struct implement **tbl;
+   {
+   struct implement *ip;
+   int num_added = 0;
+   unsigned hashval;
+
+   /*
+    * Get past the section header.
+    */
+   db_chstr("", section);
+
+   /*
+    * Create an entry in the hash table for each entry in the data base.
+    *  If multiple data bases are loaded into one hash table, use the
+    *  first entry encountered for each operation.
+    */
+   while ((ip = db_impl(toupper(section[0]))) != NULL) {
+      if (db_ilkup(ip->name, tbl) == NULL) {
+         db_code(ip);
+         hashval = IHasher(ip->name);
+         ip->blink = tbl[hashval];
+         tbl[hashval] = ip;
+         ++num_added;
+         db_chstr("", "end");
+         }
+      else
+         db_dscrd(ip);
+      }
+   db_chstr("", "endsect");
+   return num_added;
+   }
+
+/*
+ * db_ilkup - look up id in a table of implementation information and return
+ *  pointer it or NULL if it is not there.
+ */
+struct implement *db_ilkup(id, tbl)
+char *id;
+struct implement **tbl;
+   {
+   register struct implement *ptr;
+
+   ptr = tbl[IHasher(id)];
+   while (ptr != NULL && ptr->name != id)
+      ptr = ptr->blink;
+   return ptr;
+   }
+
+/*
+ * nxt_pre - assign next prefix. A prefix consists of n characters each from
+ *   the range 0-9 and a-z, at least one of which is a digit.
+ *
+ */
+void nxt_pre(pre, nxt, n)
+char *pre;
+char *nxt;
+int n;
+   {
+   int i, num_dig;
+
+   if (nxt[0] == '\0') {
+      fprintf(stderr, "out of unique prefixes\n");
+      exit(EXIT_FAILURE);
+      }
+
+   /*
+    * copy the next prefix into the output string.
+    */
+   for (i = 0; i < n; ++i)
+      pre[i] = nxt[i];
+
+   /*
+    * Increment next prefix. First, determine how many digits there are in
+    *  the current prefix.
+    */
+   num_dig = 0;
+   for (i = 0; i < n; ++i)
+      if (isdigit(nxt[i]))
+         ++num_dig;
+
+   for (i = n - 1; i >= 0; --i) {
+      switch (nxt[i]) {
+         case '9':
+            /*
+             * If there is at least one other digit, increment to a letter.
+             *  Otherwise, start over at zero and continue to the previous
+             *  character in the prefix.
+             */
+            if (num_dig > 1) {
+               nxt[i] = 'a';
+               return;
+               }
+            else
+               nxt[i] = '0';
+            break;
+
+         case 'z':
+            /*
+             * Start over at zero and continue to previous character in the
+             *  prefix.
+             */
+            nxt[i] = '0';
+            ++num_dig;
+            break;
+         default:
+            ++nxt[i];
+            return;
+         }
+      }
+
+   /*
+    * Indicate that there are no more prefixes.
+    */
+   nxt[0] = '\0';
+   }
+
+/*
+ * cmp_pre - lexically compare 2-character prefixes.
+ */
+int cmp_pre(pre1, pre2)
+char *pre1;
+char *pre2;
+   {
+   int cmp;
+
+   cmp = cmp_1_pre(pre1[0], pre2[0]);
+   if (cmp == 0)
+      return cmp_1_pre(pre1[1], pre2[1]);
+   else
+      return cmp;
+   }
+
+/*
+ * cmp_1_pre - lexically compare 1 character of a prefix.
+ */
+static int cmp_1_pre(p1, p2)
+int p1;
+int p2;
+   {
+   if (isdigit(p1)) {
+      if (isdigit(p2))
+         return p1 - p2;
+      else
+         return -1;
+      }
+    else {
+       if (isdigit(p2))
+          return 1;
+       else
+         return p1 - p2;
+      }
+   }
+
+/*
+ * db_err1 - print a data base error message in the form of 1 string.
+ */
+void db_err1(fatal, s)
+int fatal;
+char *s;
+   {
+   if (fatal)
+      fprintf(stderr, "error, ");
+   else
+      fprintf(stderr, "warning, ");
+   fprintf(stderr, "data base \"%s\", line %d - %s\n", dbname, dbline, s);
+   if (fatal)
+      exit(EXIT_FAILURE);
+   }
+
+/*
+ * db_err2 - print a data base error message in the form of 2 strings.
+ */
+void db_err2(fatal, s1, s2)
+int fatal;
+char *s1;
+char *s2;
+   {
+   if (fatal)
+      fprintf(stderr, "error, ");
+   else
+      fprintf(stderr, "warning, ");
+   fprintf(stderr, "data base \"%s\", line %d - %s %s\n", dbname, dbline, s1,
+      s2);
+   if (fatal)
+      exit(EXIT_FAILURE);
+   }
+
+/*
+ * db_err3 - print a data base error message in the form of 3 strings.
+ */
+static void db_err3(fatal, s1, s2, s3)
+int fatal;
+char *s1;
+char *s2;
+char *s3;
+   {
+   if (fatal)
+      fprintf(stderr, "error, ");
+   else
+      fprintf(stderr, "warning, ");
+   fprintf(stderr, "data base \"%s\", line %d - %s %s%s\n", dbname, dbline, s1,
+      s2, s3);
+   if (fatal)
+      exit(EXIT_FAILURE);
+   }
diff --git a/src/common/strtbl.c b/src/common/strtbl.c
new file mode 100644
index 0000000..129dc94
--- /dev/null
+++ b/src/common/strtbl.c
@@ -0,0 +1,207 @@
+/*
+ * The functions in this file maintain a hash table of strings and manage
+ *   string buffers.
+ */
+#include "../h/gsupport.h"
+
+/*
+ * Prototype for static function.
+ */
+static int streq  (int len, char *s1, char *s2);
+
+/*
+ * Entry in string table.
+ */
+struct str_entry {
+   char *s;                 /* string */
+   int length;              /* length of string */
+   struct str_entry *next;
+   };
+
+#define SBufSize 1024                     /* initial size of a string buffer */
+#define StrTblSz 149                      /* size of string hash table */
+static struct str_entry **str_tbl = NULL; /* string hash table */
+
+/*
+ * init_str - initialize string hash table.
+ */
+void init_str()
+   {
+   int h;
+
+   if (str_tbl == NULL) {
+      str_tbl = alloc(StrTblSz * sizeof(struct str_entry *));
+      for (h = 0; h < StrTblSz; ++h)
+         str_tbl[h] = NULL;
+      }
+   }
+
+/*
+ * free_stbl - free string table.
+ */
+void free_stbl()
+   {
+   struct str_entry *se, *se1;
+   int h;
+
+   for (h = 0; h < StrTblSz; ++h)
+      for (se = str_tbl[h]; se != NULL; se = se1) {
+         se1 = se->next;
+         free((char *)se);
+         }
+
+   free((char *)str_tbl);
+   str_tbl = NULL;
+   }
+
+/*
+ * init_sbuf - initialize a new sbuf struct, allocating an initial buffer.
+ */
+void init_sbuf(sbuf)
+struct str_buf *sbuf;
+   {
+   sbuf->size = SBufSize;
+   sbuf->frag_lst = alloc(sizeof(struct str_buf_frag) + (SBufSize - 1));
+   sbuf->frag_lst->next = NULL;
+   sbuf->strtimage = sbuf->frag_lst->s;
+   sbuf->endimage = sbuf->strtimage;
+   sbuf->end = sbuf->strtimage + SBufSize;
+   }
+
+/*
+ * clear_sbuf - free string buffer storage.
+ */
+void clear_sbuf(sbuf)
+struct str_buf *sbuf;
+   {
+   struct str_buf_frag *sbf, *sbf1;
+
+   for (sbf = sbuf->frag_lst; sbf != NULL; sbf = sbf1) {
+      sbf1 = sbf->next;
+      free((char *)sbf);
+      }
+   sbuf->frag_lst = NULL;
+   sbuf->strtimage = NULL;
+   sbuf->endimage = NULL;
+   sbuf->end = NULL;
+   }
+
+/*
+ * new_sbuf - allocate a new buffer for a sbuf struct, copying the partially
+ *   created string from the end of full buffer to the new one.
+ */
+void new_sbuf(sbuf)
+struct str_buf *sbuf;
+   {
+   struct str_buf_frag *sbf;
+   char *s1, *s2;
+
+   /*
+    * The new buffer is larger than the old one to insure that any
+    *  size string can be buffered.
+    */
+   sbuf->size *= 2;
+   s1 = sbuf->strtimage;
+   sbf = alloc(sizeof(struct str_buf_frag) + (sbuf->size - 1));
+   sbf->next = sbuf->frag_lst;
+   sbuf->frag_lst = sbf;
+   sbuf->strtimage = sbf->s;
+   s2 = sbuf->strtimage;
+   while (s1 < sbuf->endimage)
+      *s2++ = *s1++;
+   sbuf->endimage = s2;
+   sbuf->end = sbuf->strtimage + sbuf->size;
+   }
+
+/*
+ * spec_str - install a special string (null terminated) in the string table.
+ */
+char *spec_str(s)
+char *s;
+   {
+   struct str_entry *se;
+   register char *s1;
+   register int l;
+   register int h;
+
+   h = 0;
+   l = 1;
+   for (s1 = s; *s1 != '\0'; ++s1) {
+      h += *s1 & 0377;
+      ++l;
+      }
+   h %= StrTblSz;
+   for (se = str_tbl[h]; se != NULL; se = se->next)
+      if (l == se->length && streq(l, s, se->s))
+         return se->s;
+   se = NewStruct(str_entry);
+   se->s = s;
+   se->length = l;
+   se->next = str_tbl[h];
+   str_tbl[h] = se;
+   return s;
+   }
+
+/*
+ * str_install - find out if the string at the end of the buffer is in
+ *   the string table. If not, put it there. Return a pointer to the
+ *   string in the table.
+ */
+char *str_install(sbuf)
+struct str_buf *sbuf;
+   {
+   int h;
+   struct str_entry *se;
+   register char *s;
+   register char *e;
+   int l;
+
+   AppChar(*sbuf, '\0');   /* null terminate the buffered copy of the string */
+   s = sbuf->strtimage;
+   e = sbuf->endimage;
+
+   /*
+    * Compute hash value.
+    */
+   h = 0;
+   while (s < e)
+      h += *s++ & 0377;
+   h %= StrTblSz;
+   s = sbuf->strtimage;
+   l = e - s;
+   for (se = str_tbl[h]; se != NULL; se = se->next)
+      if (l == se->length && streq(l, s, se->s)) {
+         /*
+          * A copy of the string is already in the table. Delete the copy
+          *  in the buffer.
+          */
+         sbuf->endimage = s;
+         return se->s;
+         }
+
+   /*
+    * The string is not in the table. Add the copy from the buffer to the
+    *  table.
+    */
+   se = NewStruct(str_entry);
+   se->s = s;
+   se->length = l;
+   sbuf->strtimage = e;
+   se->next = str_tbl[h];
+   str_tbl[h] = se;
+   return se->s;
+   }
+
+/*
+ * streq - compare s1 with s2 for len bytes, and return 1 for equal,
+ *  0 for not equal.
+ */
+static int streq(len, s1, s2)
+register int len;
+register char *s1, *s2;
+   {
+   while (len--)
+      if (*s1++ != *s2++)
+         return 0;
+   return 1;
+   }
diff --git a/src/common/time.c b/src/common/time.c
new file mode 100644
index 0000000..84d8fe1
--- /dev/null
+++ b/src/common/time.c
@@ -0,0 +1,34 @@
+#include "../h/gsupport.h"
+
+/*
+ * millisec - returns execution time in milliseconds. Time is measured
+ *  from the function's first call. The granularity of the time is
+ *  generally larger than one millisecond and on some systems it may
+ *  only be accurate to the second.
+ *
+ * For some unfathomable reason, the Open Group's "Single Unix Specification"
+ *  requires that the ANSI C clock() function be defined in units of 1/1000000
+ *  second.  This means that the result overflows a 32-bit signed clock_t
+ *  value only about 35 minutes.  Consequently, we use the POSIX standard
+ *  times() function instead.
+ */
+
+long millisec()
+   {
+   static long clockres = 0;
+   static long starttime = 0;
+   long curtime;
+   struct tms tp;
+
+   times(&tp);
+   curtime = tp.tms_utime + tp.tms_stime;
+   if (clockres == 0) {
+      #ifdef CLK_TCK
+         clockres = CLK_TCK;
+      #else
+         clockres = sysconf(_SC_CLK_TCK);
+      #endif
+      starttime = curtime;
+      }
+   return (long) ((1000.0 / clockres) * (curtime - starttime));
+   }
diff --git a/src/common/tokens.txt b/src/common/tokens.txt
new file mode 100644
index 0000000..c717d36
--- /dev/null
+++ b/src/common/tokens.txt
@@ -0,0 +1,76 @@
+Primitive Tokens
+
+   Token                Token Type      Flags
+
+   identifier           IDENT            b e
+   integer-literal      INTLIT           b e
+   real-literal         REALLIT          b e
+   string-literal       STRINGLIT        b e
+   cset-literal         CSETLIT          b e
+   end-of-file          EOFX
+
+Reserved Words
+
+   Token                Token Type      Flags
+
+   break                BREAK            b e
+   by                   BY
+   case                 CASE             b
+   create               CREATE           b
+   default              DEFAULT          b
+   do                   DO
+   else                 ELSE
+   end                  END              b
+   every                EVERY            b
+   fail                 FAIL             b e
+   global               GLOBAL
+   if                   IF               b
+   initial              INITIAL          b
+   invocable            INVOCABLE
+   link                 LINK
+   local                LOCAL            b
+   next                 NEXT             b e
+   not                  NOT              b
+   of                   OF
+   procedure            PROCEDURE
+   record               RECORD
+   repeat               REPEAT           b
+   return               RETURN           b e
+   static               STATIC           b
+   suspend              SUSPEND          b e
+   then                 THEN
+   to                   TO
+   until                UNTIL            b
+   while                WHILE            b
+
+``Operator'' tokens not used in standard unary/binary syntax, see op.txt.
+
+   Token                Token Type      Flags
+
+   (                    LPAREN           b
+   )                    RPAREN             e
+   +:                   PCOLON
+   ,                    COMMA
+   -:                   MCOLON
+   :                    COLON
+   ;                    SEMICOL
+   [                    LBRACK           b
+   ]                    RBRACK             e
+   {                    LBRACE           b
+   }                    RBRACE             e
+
+tokens starting with $ are alternate spellings for some tokens
+
+   $(                   LBRACE           b
+   $)                   RBRACE           e
+   $<                   LBRACK           b
+   $>                   RBRACK           e
+
+Explanation of Flags
+
+   b    indicates that the token may begin an expression.
+   e    indicates that the token may end an expression.
+
+   These two flags are used for semicolon insertion.  If a line
+   ends with an "e" token, and the next token is a "b" token,
+   a semicolon is inserted between the two tokens.
diff --git a/src/common/typespec.icn b/src/common/typespec.icn
new file mode 100644
index 0000000..f86ba9a
--- /dev/null
+++ b/src/common/typespec.icn
@@ -0,0 +1,482 @@
+#
+# typespec - transform Icon type specifications into C tables.
+#    Specifications are read from standard input; tables are written
+#    to standard output.
+#
+#  The grammar for the a type specifcation is:
+#
+#    <type-def>      ::= <identifier> <opt-abrv> : <kind> <opt-return>
+#  
+#    <kind>          ::= simple |
+#                        aggregate(<component>, ... ) |
+#                        variable <var-type-spec>
+#  
+#    <component>     ::= var <identifier> <opt-abrv> |
+#                            <identifier>
+#  
+#    <var-type-spec> ::= initially <type> |
+#                        always <type>
+#  
+#    <type>          ::= <type-name> | <type> ++ <type-name>
+#  
+#    <opt-abrv>      ::= <nil> |
+#                        { <identifier> }
+#  
+#    <opt-return>    ::= <nil> |
+#                        return block_pointer |
+#                        return descriptor_pointer |
+#                        return char_pointer |
+#                        return C_integer
+
+# Information about an Icon type.
+#
+record icon_type(
+   id,          # name of type
+   support_new, # supports RTL "new" construct
+   deref,       # dereferencing needs
+   rtl_ret,     # kind of RTL return supported if any
+   typ,         # for variable: initial type
+   num_comps,   # for aggregate: number of type components
+   compnts,     # for aggregate: index of first component
+   abrv)        # abreviation used for type tracing
+
+# Information about a component of an aggregate type.
+#
+record typ_compnt (
+   id,        # name of component
+   n,         # position of component within type aggragate
+   var,       # flag: this component is an Icon-level variable
+   aggregate, # index of type that owns the component
+   abrv)      # abreviation used for type tracing
+
+record token(kind, image)
+
+global icontypes, typecompnt, type_indx, compnt_indx
+global lex, line_num, saved_token, error_msg, prog_name
+
+procedure main()
+   local typ, tok, compnt, indx, x
+
+   prog_name := "typespec"
+   lex := create tokenize_input()
+
+   icontypes := []
+   typecompnt := []
+
+   #
+   # Read each of the type specifications
+   #
+   while typ := icon_type(ident("may be EOF")) do {
+      #
+      # Check for abreviation
+      #
+      typ.abrv := opt_abrv(typ.id)
+
+      if next_token().kind ~== ":" then
+          input_err("expected ':'")
+
+      #
+      # See what kind of type this is
+      #
+      case ident() of {
+         "simple": {
+            typ.support_new := "0"
+            typ.deref := "DrfNone"
+            typ.num_comps := "0"
+            typ.compnts := "0"
+            }
+
+         "aggregate": {
+            typ.support_new := "1"
+            typ.deref := "DrfNone"
+
+            #
+            # get the component names for the type
+            #
+            typ.compnts := *typecompnt
+            if next_token().kind ~== "(" then
+               input_err("expected '('")
+            typ.num_comps := 0
+            tok := next_token()
+            if tok.kind ~== "id" then
+               input_err("expected type component")
+            while tok.kind ~== ")" do {
+               #
+               # See if this component is an Icon variable.
+               #
+               if tok.image == "var" then {
+                  compnt := typ_compnt(ident(), typ.num_comps, "1", *icontypes)
+                  compnt.abrv := opt_abrv(compnt.id)
+                  }
+               else
+                  compnt := typ_compnt(tok.image, typ.num_comps, "0",
+                     *icontypes)
+
+               put(typecompnt, compnt)
+               typ.num_comps +:= 1
+
+               tok := next_token()
+               if tok.kind == "," then {
+                  tok := next_token()
+                  if tok.kind ~== "id" then
+                     input_err("expected type component")
+                  }
+               else if tok.kind ~== ")" then
+                  input_err("expected type component")
+               }
+            }
+
+         "variable": {
+            typ.support_new := "0"
+            typ.num_comps := "0"
+            typ.compnts := "0"
+            case ident() of {
+                "initially":
+                   typ.deref := "DrfGlbl"
+                "always":
+                   typ.deref :=  "DrfCnst"
+                default:
+                  input_err("expected 'initially' or 'always'")
+               }
+
+            #
+            # Get the initial type associated with the variable
+            #
+            typ.typ := [ident()]
+            tok := &null
+            while (tok := next_token("may be EOF")).kind == "++" do {
+                put(typ.typ, ident())
+                tok := &null
+                }
+            saved_token := tok  # put token back
+            }
+         default:
+            input_err("expected 'simple', 'aggregate', or 'variable'")
+         }
+
+      #
+      # Check for an optional return clause
+      #
+      tok := &null
+      if (tok := next_token("may be EOF")).image == "return" then {
+         case next_token().image of {
+            "block_pointer":
+               typ.rtl_ret := "TRetBlkP"
+            "descriptor_pointer":
+               typ.rtl_ret := "TRetDescP"
+            "char_pointer":
+               typ.rtl_ret := "TRetCharP"
+            "C_integer":
+               typ.rtl_ret := "TRetCInt"
+            default:
+               input_err("expected vword type")
+            }
+         }
+      else {
+         typ.rtl_ret := "TRetNone"
+         saved_token := tok    # put token back
+         }
+
+      put(icontypes, typ)
+      }
+
+   #
+   # Create tables of type and compontent indexes.
+   #
+   type_indx := table()
+   indx := -1
+   every type_indx[(!icontypes).id] := (indx +:= 1)
+   compnt_indx := table()
+   indx := -1
+   every compnt_indx[(!typecompnt).id] := (indx +:= 1)
+
+   write("/*")
+   write(" * This file was generated by the program ", prog_name, ".")
+   write(" */")
+   write()
+
+   #
+   # Locate the indexes of types with special semantics or which are
+   #  explicitly needed by iconc. Output the indexes as assignments to
+   #  variables.
+   #
+   indx := req_type("string")
+   icontypes[indx + 1].rtl_ret := "TRetSpcl"
+   write("int str_typ = ", indx, ";")
+
+   indx := req_type("integer")
+   write("int int_typ = ", indx, ";")
+
+   indx := req_type("record")
+   write("int rec_typ = ", indx, ";")
+
+   indx := req_type("proc")
+   write("int proc_typ = ", indx, ";")
+
+   indx := req_type("coexpr")
+   write("int coexp_typ = ", indx, ";")
+
+   indx := req_type("tvsubs")
+   icontypes[indx + 1].deref := "DrfSpcl"
+   icontypes[indx + 1].rtl_ret := "TRetSpcl"
+   write("int stv_typ = ", indx, ";")
+
+   indx := req_type("tvtbl")
+   icontypes[indx + 1].deref := "DrfSpcl"
+   write("int ttv_typ = ", indx, ";")
+
+   indx := req_type("null")
+   write("int null_typ = ", indx, ";")
+
+   indx := req_type("cset")
+   write("int cset_typ = ", indx, ";")
+
+   indx := req_type("real")
+   write("int real_typ = ", indx, ";")
+
+   indx := req_type("list")
+   write("int list_typ = ", indx, ";")
+
+   indx := req_type("table")
+   write("int tbl_typ = ", indx, ";")
+
+   #
+   # Output the type table.
+   #
+   write()
+   write("int num_typs = ", *icontypes, ";")
+   write("struct icon_type icontypes[", *icontypes, "] = {")
+   x := copy(icontypes)
+   output_typ(get(x))
+   while typ := get(x) do {
+      write(",")
+      output_typ(typ)
+      }
+   write("};")
+
+   #
+   # Locate the indexes of components which are explicitly needed by iconc.
+   #  Output the indexes as assignments to variables.
+   #
+   write()
+   indx := req_compnt("str_var")
+   write("int str_var = ", indx, ";")
+
+   indx := req_compnt("trpd_tbl")
+   write("int trpd_tbl = ", indx, ";")
+
+   indx := req_compnt("lst_elem")
+   write("int lst_elem = ", indx, ";")
+
+   indx := req_compnt("tbl_dflt")
+   write("int tbl_dflt = ", indx, ";")
+
+   indx := req_compnt("tbl_val")
+   write("int tbl_val = ", indx, ";")
+
+   #
+   # Output the component table.
+   #
+   write()
+   write("int num_cmpnts = ", *typecompnt, ";")
+   write("struct typ_compnt typecompnt[", *typecompnt, "] = {")
+   output_compnt(get(typecompnt))
+   while compnt := get(typecompnt) do {
+      write(",")
+      output_compnt(compnt)
+      }
+   write("};")
+end
+
+#
+# ident - insure that next token is an identifier and return its image
+#
+procedure ident(may_be_eof)
+   local tok  
+
+   tok := next_token(may_be_eof) | fail
+
+   if tok.kind == "id" then
+      return tok.image
+   else 
+      input_err("expected identifier")
+end
+
+#
+# opt_abrv - look for an optional abreviation. If there is none, return the
+#   default value supplied by the caller.
+#
+procedure opt_abrv(abrv)
+   local tok
+
+   tok := next_token("may be EOF")
+   if tok.kind == "{" then {
+      abrv := ident()
+      if next_token().kind ~== "}" then
+          input_err("expected '}'")
+      }
+   else
+      saved_token := tok   # put token back
+
+   return abrv
+end
+
+#
+# next_token - get the next token, looking to see if one was put back.
+#
+procedure next_token(may_be_eof)
+   local tok
+
+   if \saved_token then {
+      tok := saved_token
+      saved_token := &null
+      return tok
+      }
+   else if tok := @lex then
+      return tok
+   else if \may_be_eof then
+      fail
+   else {
+      write(&errout, prog_name, ", unexpected EOF")
+      exit(1)
+      }
+end
+
+#
+# req_type - get the index of a required type.
+#
+procedure req_type(id)
+   local indx
+
+   if indx := \type_indx[id] then
+      return indx
+   else {
+      write(&errout, prog_name, ", the type ", id, " is required")
+      exit(1)
+      }
+end
+
+#
+# req_compnt - get the index of a required component.
+#
+procedure req_compnt(id)
+   local indx
+
+   if indx := \compnt_indx[id] then
+      return indx
+   else {
+      write(&errout, prog_name, ", the component ", id, " is required")
+      exit(1)
+      }
+end
+
+#
+# output_typ - output the table entry for a type.
+#
+procedure output_typ(typ)
+   local typ_str, s, indx
+
+   writes("  {", image(typ.id), ", ", typ.support_new, ", ", typ.deref, ", ",
+      typ.rtl_ret, ", ")
+   if \typ.typ then {
+      typ_str := repl(".", *type_indx)
+      every s := !typ.typ do {
+         if s == "any_value" then {
+            every indx := 1 to *icontypes do {
+               if icontypes[indx].deref == "DrfNone" then
+                  typ_str[indx] := icontypes[indx].abrv[1]
+               }
+            }
+         else if indx := \type_indx[s] + 1 then
+            typ_str[indx] := icontypes[indx].abrv[1]
+         else {
+            write(&errout, prog_name, ", the specification for ", typ.id,
+               " contains an illegal type: ", s)
+            exit(1)
+            }
+         }
+      writes(image(typ_str))
+      }
+   else
+      writes("NULL")
+   writes(", ", typ.num_comps, ", ", typ.compnts, ", ", image(typ.abrv), ", ")
+   writes(image(map(typ.id[1], &lcase, &ucase) || typ.id[2:0]), "}")
+end
+
+#
+# output_compnt - output the table entry for a component.
+#
+procedure output_compnt(compnt)
+   writes("  {", image(compnt.id), ", ", compnt.n, ", ", compnt.var, ", ",
+      compnt.aggregate, ", ", image(\compnt.abrv) | "NULL", "}")
+end
+
+#
+# input_err - signal the lexical anaylser to print an error message about
+#   the last token
+#
+procedure input_err(msg)
+   error_msg := msg
+   @lex
+end
+
+#
+# tokenize_input - transform standard input into tokens and suspend them
+#
+procedure tokenize_input()
+   local line
+
+   line_num := 0
+   while line := read() do {
+      line_num +:= 1
+      suspend line ? tokenize_line()
+      }
+   fail
+end
+
+#
+# tokenize_line - transform the subject of string scanning into tokens and
+#   suspend them
+#
+procedure tokenize_line()
+   local s, tok, save_pos
+   static id_chars
+
+   initial id_chars := &letters ++ &digits ++ '_'
+
+   repeat {
+      tab(many(' \t'))        # skip white space
+      if ="#" | pos(0) then
+         fail                 # end of input on this line
+
+      save_pos := &pos
+
+      if any(&letters) then
+         tok := token("id", tab(many(id_chars)))
+      else if s := =(":" | "(" | "," | ")" | "++" | "{" | "}") then
+         tok := token(s, s)
+      else
+         err("unknown symbol")
+
+      suspend tok
+      err(\error_msg, save_pos)   # was the last token erroneous?
+      }
+end
+
+#
+# err - print an error message about the current string being scanned
+#
+procedure err(msg, save_pos)
+   local s, strt_msg
+
+   tab(\save_pos)    # error occured here
+
+   strt_msg := prog_name || ", " || msg || "; line " || line_num || ": "
+   (s := image(tab(1))) & &fail      # get front of line then undo tab
+   strt_msg ||:= s[1:-1]             # strip ending quote from image
+   s := image(tab(0))                # get end of line
+   s := s[2:0]                       # strip first quote from image
+   write(&errout, strt_msg, s)
+   write(&errout, repl(" ", *strt_msg), "^")  # show location of error
+   exit(1)
+end
diff --git a/src/common/typespec.txt b/src/common/typespec.txt
new file mode 100644
index 0000000..6fdd726
--- /dev/null
+++ b/src/common/typespec.txt
@@ -0,0 +1,87 @@
+# This file contains Icon type specifications.
+
+#   The first group of types have special semantics that are not completely
+#   captured by the specification system. 
+
+
+    string{s}:    simple
+                  # special form of descriptor
+                  # has RLT return construct with two arguments
+
+    integer{i}:   simple
+                  # two kinds of dwords
+
+    record{R}:    simple # really special aggregate
+                  return block_pointer
+                  # special semantics for allocating sub-types
+                  # different sub-types have different components
+
+    proc:         simple
+                  return block_pointer
+                  # special semantics for allocating sub-types
+                
+    coexpr{C}:    simple
+                  return block_pointer
+                  # special semantics for allocating sub-types
+
+    # sub-string trapped variables
+    tvsubs{sstv}: aggregate(str_var)
+                  # has RTL return construct with three arguments
+                  # variable type with special dereferencing semantics
+
+    # table-element trapped variables
+    tvtbl{tetv}:  aggregate(trpd_tbl)
+                  return block_pointer
+                  # variable type with special dereferencing semantics
+
+
+#   The second group of types are required by iconc but have no special
+#   semantics.
+
+       null{n}:  simple
+
+       cset{c}:  simple
+                 return block_pointer
+
+       real{r}:  simple
+                 return block_pointer
+
+       list{L}:  aggregate(var lst_elem{LE})
+                 return block_pointer
+
+       table{T}: aggregate(tbl_key, var tbl_val{TV}, tbl_dflt)
+                 return block_pointer
+
+
+#    The third group of types appear only in RTL code. They have no special
+#    semantics nor any special uses by iconc.
+
+       file{f}:  simple
+                 return block_pointer
+
+       set{S}:   aggregate(set_elem)
+                 return block_pointer
+
+       # integer keyword variables: &random, &trace, &error
+       kywdint:  variable always integer
+                 return descriptor_pointer
+
+       # &subject
+       kywdsubj: variable always string
+                 return descriptor_pointer
+
+       # &pos
+       kywdpos:  variable always integer
+                 return descriptor_pointer
+
+       # &eventsource, &eventvalue, &eventcode
+       kywdevent: variable always any_value
+                 return descriptor_pointer
+
+       # &window
+       kywdwin: variable always file ++ null
+                 return descriptor_pointer
+
+       # &fg and friends
+       kywdstr: variable always string
+                 return descriptor_pointer
diff --git a/src/common/xwindow.c b/src/common/xwindow.c
new file mode 100644
index 0000000..b5d2c5b
--- /dev/null
+++ b/src/common/xwindow.c
@@ -0,0 +1,159 @@
+/*
+ * xwindow.c - X Window System-specific routines
+ */
+#include "../h/define.h"
+#include "../h/config.h"
+#ifdef XWindows
+
+typedef struct {
+  char *s;
+  int i;
+} stringint, *siptr;
+
+#ifdef XpmFormat
+   #include "../xpm/xpm.h"
+#else					/* XpmFormat */
+   #include <X11/Xlib.h>
+   #include <X11/Xutil.h>
+#endif					/* XpmFormat */
+
+#include <X11/Xos.h>
+#include <X11/Xatom.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+
+int GraphicsHome  = XK_Home;
+int GraphicsLeft  = XK_Left;
+int GraphicsUp    = XK_Up;
+int GraphicsRight = XK_Right;
+int GraphicsDown  = XK_Down;
+int GraphicsPrior = XK_Prior;
+int GraphicsNext  = XK_Next;
+int GraphicsEnd   = XK_End;
+
+/*
+ * Translate a key event.  Put ascii result if any in s.
+ * Return number of ascii (>0) if the key was "normal" and s is filled in.
+ * Return 0 if the key was strange and keysym should be returned.
+ * Return -1 if the key was a modifier key and should be dropped.
+ */
+int translate_key_event(event, s, k)
+XKeyEvent *event;
+char *s;
+KeySym *k;
+{
+   int i = XLookupString(event, s, 10, k, NULL);
+
+   if (i > 0)
+      return i;			/* "normal" key */
+   else if (IsModifierKey(*k))
+      return -1;		/* modifier key */
+   else
+      return 0;			/* other (e.g. function key) */
+}
+
+stringint drawops[] = {
+   { 0, 16},
+   {"and",		GXand},
+   {"andInverted",	GXandInverted},
+   {"andReverse",	GXandReverse},
+   {"clear",		GXclear},
+   {"copy",		GXcopy},
+   {"copyInverted",	GXcopyInverted},
+   {"equiv",		GXequiv},
+   {"invert",		GXinvert},
+   {"nand",		GXnand},
+   {"noop",		GXnoop},
+   {"nor",		GXnor},
+   {"or",		GXor},
+   {"orInverted",	GXorInverted},
+   {"orReverse",	GXorReverse},
+   {"set",		GXset},
+   {"xor",		GXxor},
+};
+
+#define NUMCURSORSYMS	78
+
+stringint cursorsyms[] = {
+  { 0, NUMCURSORSYMS},
+  {"X cursor",		XC_X_cursor},
+  {"arrow",		XC_arrow},
+  {"based arrow down",	XC_based_arrow_down},
+  {"based arrow up",	XC_based_arrow_up},
+  {"boat",		XC_boat},
+  {"bogosity",		XC_bogosity},
+  {"bottom left corner",XC_bottom_left_corner},
+  {"bottom right corner",XC_bottom_right_corner},
+  {"bottom side",	XC_bottom_side},
+  {"bottom tee",	XC_bottom_tee},
+  {"box spiral",	XC_box_spiral},
+  {"center ptr",	XC_center_ptr},
+  {"circle",		XC_circle},
+  {"clock",		XC_clock},
+  {"coffee mug",	XC_coffee_mug},
+  {"cross",		XC_cross},
+  {"cross reverse",	XC_cross_reverse},
+  {"crosshair",		XC_crosshair},
+  {"diamond cross",	XC_diamond_cross},
+  {"dot",		XC_dot},
+  {"dotbox",		XC_dotbox},
+  {"double arrow",	XC_double_arrow},
+  {"draft large",	XC_draft_large},
+  {"draft small",	XC_draft_small},
+  {"draped box",	XC_draped_box},
+  {"exchange",		XC_exchange},
+  {"fleur",		XC_fleur},
+  {"gobbler",		XC_gobbler},
+  {"gumby",		XC_gumby},
+  {"hand1",		XC_hand1},
+  {"hand2",		XC_hand2},
+  {"heart",		XC_heart},
+  {"icon",		XC_icon},
+  {"iron cross",	XC_iron_cross},
+  {"left ptr",		XC_left_ptr},
+  {"left side",		XC_left_side},
+  {"left tee",		XC_left_tee},
+  {"leftbutton",	XC_leftbutton},
+  {"ll angle",		XC_ll_angle},
+  {"lr angle",		XC_lr_angle},
+  {"man",		XC_man},
+  {"middlebutton",	XC_middlebutton},
+  {"mouse",		XC_mouse},
+  {"pencil",		XC_pencil},
+  {"pirate",		XC_pirate},
+  {"plus",		XC_plus},
+  {"question arrow",	XC_question_arrow},
+  {"right ptr",		XC_right_ptr},
+  {"right side",	XC_right_side},
+  {"right tee",		XC_right_tee},
+  {"rightbutton",	XC_rightbutton},
+  {"rtl logo",		XC_rtl_logo},
+  {"sailboat",		XC_sailboat},
+  {"sb down arrow",	XC_sb_down_arrow},
+  {"sb h double arrow",	XC_sb_h_double_arrow},
+  {"sb left arrow",	XC_sb_left_arrow},
+  {"sb right arrow",	XC_sb_right_arrow},
+  {"sb up arrow",	XC_sb_up_arrow},
+  {"sb v double arrow",	XC_sb_v_double_arrow},
+  {"shuttle",		XC_shuttle},
+  {"sizing",		XC_sizing},
+  {"spider",		XC_spider},
+  {"spraycan",		XC_spraycan},
+  {"star",		XC_star},
+  {"target",		XC_target},
+  {"tcross",		XC_tcross},
+  {"top left arrow",	XC_top_left_arrow},
+  {"top left corner",	XC_top_left_corner},
+  {"top right corner",	XC_top_right_corner},
+  {"top side",		XC_top_side},
+  {"top tee",		XC_top_tee},
+  {"trek",		XC_trek},
+  {"ul angle",		XC_ul_angle},
+  {"umbrella",		XC_umbrella},
+  {"ur angle",		XC_ur_angle},
+  {"watch",		XC_watch},
+  {"xterm",		XC_xterm},
+  {"num glyphs",	XC_num_glyphs},
+};
+
+#endif					/* XWindows */
diff --git a/src/common/yacctok.h b/src/common/yacctok.h
new file mode 100644
index 0000000..a6a532d
--- /dev/null
+++ b/src/common/yacctok.h
@@ -0,0 +1,125 @@
+/*
+ * NOTE: these %token declarations are generated
+ *  automatically by mktoktab from tokens.txt and 
+ *  op.txt.
+ */
+
+/* primitive tokens */
+
+%token	IDENT
+%token	INTLIT
+%token	REALLIT
+%token	STRINGLIT
+%token	CSETLIT
+%token	EOFX
+
+/* reserved words */
+
+%token	BREAK       /* break     */
+%token	BY          /* by        */
+%token	CASE        /* case      */
+%token	CREATE      /* create    */
+%token	DEFAULT     /* default   */
+%token	DO          /* do        */
+%token	ELSE        /* else      */
+%token	END         /* end       */
+%token	EVERY       /* every     */
+%token	FAIL        /* fail      */
+%token	GLOBAL      /* global    */
+%token	IF          /* if        */
+%token	INITIAL     /* initial   */
+%token	INVOCABLE   /* invocable */
+%token	LINK        /* link      */
+%token	LOCAL       /* local     */
+%token	NEXT        /* next      */
+%token	NOT         /* not       */
+%token	OF          /* of        */
+%token	PROCEDURE   /* procedure */
+%token	RECORD      /* record    */
+%token	REPEAT      /* repeat    */
+%token	RETURN      /* return    */
+%token	STATIC      /* static    */
+%token	SUSPEND     /* suspend   */
+%token	THEN        /* then      */
+%token	TO          /* to        */
+%token	UNTIL       /* until     */
+%token	WHILE       /* while     */
+
+/* operators */
+
+%token	BANG        /* !         */
+%token	MOD         /* %         */
+%token	AUGMOD      /* %:=       */
+%token	AND         /* &         */
+%token	AUGAND      /* &:=       */
+%token	STAR        /* *         */
+%token	AUGSTAR     /* *:=       */
+%token	INTER       /* **        */
+%token	AUGINTER    /* **:=      */
+%token	PLUS        /* +         */
+%token	AUGPLUS     /* +:=       */
+%token	UNION       /* ++        */
+%token	AUGUNION    /* ++:=      */
+%token	MINUS       /* -         */
+%token	AUGMINUS    /* -:=       */
+%token	DIFF        /* --        */
+%token	AUGDIFF     /* --:=      */
+%token	DOT         /* .         */
+%token	SLASH       /* /         */
+%token	AUGSLASH    /* /:=       */
+%token	ASSIGN      /* :=        */
+%token	SWAP        /* :=:       */
+%token	NMLT        /* <         */
+%token	AUGNMLT     /* <:=       */
+%token	REVASSIGN   /* <-        */
+%token	REVSWAP     /* <->       */
+%token	SLT         /* <<        */
+%token	AUGSLT      /* <<:=      */
+%token	SLE         /* <<=       */
+%token	AUGSLE      /* <<=:=     */
+%token	NMLE        /* <=        */
+%token	AUGNMLE     /* <=:=      */
+%token	NMEQ        /* =         */
+%token	AUGNMEQ     /* =:=       */
+%token	SEQ         /* ==        */
+%token	AUGSEQ      /* ==:=      */
+%token	EQUIV       /* ===       */
+%token	AUGEQUIV    /* ===:=     */
+%token	NMGT        /* >         */
+%token	AUGNMGT     /* >:=       */
+%token	NMGE        /* >=        */
+%token	AUGNMGE     /* >=:=      */
+%token	SGT         /* >>        */
+%token	AUGSGT      /* >>:=      */
+%token	SGE         /* >>=       */
+%token	AUGSGE      /* >>=:=     */
+%token	QMARK       /* ?         */
+%token	AUGQMARK    /* ?:=       */
+%token	AT          /* @         */
+%token	AUGAT       /* @:=       */
+%token	BACKSLASH   /* \         */
+%token	CARET       /* ^         */
+%token	AUGCARET    /* ^:=       */
+%token	BAR         /* |         */
+%token	CONCAT      /* ||        */
+%token	AUGCONCAT   /* ||:=      */
+%token	LCONCAT     /* |||       */
+%token	AUGLCONCAT  /* |||:=     */
+%token	TILDE       /* ~         */
+%token	NMNE        /* ~=        */
+%token	AUGNMNE     /* ~=:=      */
+%token	SNE         /* ~==       */
+%token	AUGSNE      /* ~==:=     */
+%token	NEQUIV      /* ~===      */
+%token	AUGNEQUIV   /* ~===:=    */
+%token	LPAREN      /* (         */
+%token	RPAREN      /* )         */
+%token	PCOLON      /* +:        */
+%token	COMMA       /* ,         */
+%token	MCOLON      /* -:        */
+%token	COLON       /* :         */
+%token	SEMICOL     /* ;         */
+%token	LBRACK      /* [         */
+%token	RBRACK      /* ]         */
+%token	LBRACE      /* {         */
+%token	RBRACE      /* }         */
diff --git a/src/common/yylex.h b/src/common/yylex.h
new file mode 100644
index 0000000..9850417
--- /dev/null
+++ b/src/common/yylex.h
@@ -0,0 +1,624 @@
+/*
+ * yylex.h -- the lexical analyzer.
+ *
+ * This source file contains the lexical analyzer, yylex(), and its
+ * support routines. It is built by inclusion in ../icont/tlex.c and
+ * ../iconc/clex.c, with slight variations depending on whether "Iconc"
+ * is defined.
+ */
+
+#if !defined(Iconc)
+   #include "../h/esctab.h"
+#endif					/* !Iconc */
+
+/*
+ * Prototypes.
+ */
+
+static  int             bufcmp          (char *s);
+static	struct toktab   *findres	(void);
+static	struct toktab   *getident	(int ac,int *cc);
+static	struct toktab   *getnum		(int ac,int *cc);
+static	struct toktab   *getstring	(int ac,int *cc);
+static	int		setfilenm	(int c);
+static	int		setlineno	(void);
+
+#if !defined(Iconc)
+   static	int	ctlesc		(void);
+   static	int	hexesc		(void);
+   static	int	octesc		(int ac);
+#endif					/* !Iconc */
+
+#define isletter(s)	(isupper(c) | islower(c))
+#define tonum(c)        (isdigit(c) ? (c - '0') : ((c & 037) + 9))
+
+struct node tok_loc =
+   {0, NULL, 0, 0};	/* "model" node containing location of current token */
+
+struct str_buf lex_sbuf;	/* string buffer for lexical analyzer */
+
+/*
+ * yylex - find the next token in the input stream, and return its token
+ *  type and value to the parser.
+ *
+ * Variables of interest:
+ *
+ *  cc - character following last token.
+ *  nlflag - set if a newline was between the last token and the current token
+ *  lastend - set if the last token was an Ender.
+ *  lastval - when a semicolon is inserted and returned, lastval gets the
+ *   token value that would have been returned if the semicolon hadn't
+ *   been inserted.
+ */
+
+static struct toktab *lasttok = NULL;
+static int lastend = 0;
+static int eofflag = 0;
+static int cc = '\n';
+
+int yylex()
+   {
+   register struct toktab *t;
+   register int c;
+   int n;
+   int nlflag;
+   static nodeptr lastval;
+   static struct node semi_loc;
+
+   if (lasttok != NULL) {
+      /*
+       * A semicolon was inserted and returned on the last call to yylex,
+       *  instead of going to the input, return lasttok and set the
+       *  appropriate variables.
+       */
+
+      yylval = lastval;
+      tok_loc = *lastval;
+      t = lasttok;
+      goto ret;
+      }
+   nlflag = 0;
+loop:
+   c = cc;
+   /*
+    * Remember where a semicolon will go if we insert one.
+    */
+   semi_loc.n_file = tok_loc.n_file;
+   semi_loc.n_line = in_line;
+   if (cc == '\n')
+      --semi_loc.n_line;
+   semi_loc.n_col = incol;
+   /*
+    * Skip whitespace and comments and process #line directives.
+    */
+   while (c == Comment || isspace(c)) {
+      if (c == '\n') {
+         nlflag++;
+         c = NextChar;
+	 if (c == Comment) {
+            /*
+	     * Check for #line directive at start of line.
+             */
+            if (('l' == (c = NextChar)) &&
+                ('i' == (c = NextChar)) &&
+                ('n' == (c = NextChar)) &&
+                ('e' == (c = NextChar))) {
+               c = setlineno();
+	       while ((c == ' ') || (c == '\t'))
+		  c = NextChar;
+               if (c != EOF && c != '\n')
+                  c = setfilenm(c);
+	       }
+	    while (c != EOF && c != '\n')
+               c = NextChar;
+	    }
+         }
+      else {
+	 if (c == Comment) {
+	    while (c != EOF && c != '\n')
+               c = NextChar;
+	    }
+         else {
+            c = NextChar;
+            }
+         }
+      }
+   /*
+    * A token is the next thing in the input.  Set token location to
+    *  the current line and column.
+    */
+   tok_loc.n_line = in_line;
+   tok_loc.n_col = incol;
+
+   if (c == EOF) {
+      /*
+       * End of file has been reached.	Set eofflag, return T_Eof, and
+       *  set cc to EOF so that any subsequent scans also return T_Eof.
+       */
+      if (eofflag++) {
+	 eofflag = 0;
+	 cc = '\n';
+	 yylval = NULL;
+	 return 0;
+	 }
+      cc = EOF;
+      t = T_Eof;
+      yylval = NULL;
+      goto ret;
+      }
+
+   /*
+    * Look at current input character to determine what class of token
+    *  is next and take the appropriate action.  Note that the various
+    *  token gathering routines write a value into cc.
+    */
+   if (isalpha(c) || (c == '_')) {   /* gather ident or reserved word */
+      if ((t = getident(c, &cc)) == NULL)
+	 goto loop;
+      }
+   else if (isdigit(c) || (c == '.')) {	/* gather numeric literal or "." */
+      if ((t = getnum(c, &cc)) == NULL)
+	 goto loop;
+      }
+   else if (c == '"' || c == '\'') {    /* gather string or cset literal */
+      if ((t = getstring(c, &cc)) == NULL)
+	 goto loop;
+      }
+   else {			/* gather longest legal operator */
+      if ((n = getopr(c, &cc)) == -1)
+	 goto loop;
+      t = &(optab[n].tok);
+      yylval = OpNode(n);
+      }
+   if (nlflag && lastend && (t->t_flags & Beginner)) {
+      /*
+       * A newline was encountered between the current token and the last,
+       *  the last token was an Ender, and the current token is a Beginner.
+       *  Return a semicolon and save the current token in lastval.
+       */
+      lastval = yylval;
+      lasttok = t;
+      tok_loc = semi_loc;
+      yylval = OpNode(semicol_loc);
+      return SEMICOL;
+      }
+ret:
+   /*
+    * Clear lasttok, set lastend if the token being returned is an
+    *  Ender, and return the token.
+    */
+   lasttok = 0;
+   lastend = t->t_flags & Ender;
+   return (t->t_type);
+   }
+
+/*
+ * getident - gather an identifier beginning with ac.  The character
+ *  following identifier goes in cc.
+ */
+
+static struct toktab *getident(ac, cc)
+int ac;
+int *cc;
+   {
+   register int c;
+   register struct toktab *t;
+
+   c = ac;
+   /*
+    * Copy characters into string space until a non-alphanumeric character
+    *  is found.
+    */
+   do {
+      AppChar(lex_sbuf, c);
+      c = NextChar;
+      } while (isalnum(c) || (c == '_'));
+   *cc = c;
+   /*
+    * If the identifier is a reserved word, make a ResNode for it and return
+    *  the token value.  Otherwise, install it with putid, make an
+    *  IdNode for it, and return.
+    */
+   if ((t = findres()) != NULL) {
+      lex_sbuf.endimage = lex_sbuf.strtimage;
+      yylval = ResNode(t->t_type);
+      return t;
+      }
+   else {
+      yylval = IdNode(str_install(&lex_sbuf));
+      return (struct toktab *)T_Ident;
+      }
+   }
+
+/*
+ * findres - if the string just copied into the string space by getident
+ *  is a reserved word, return a pointer to its entry in the token table.
+ *  Return NULL if the string isn't a reserved word.
+ */
+
+static struct toktab *findres()
+   {
+   register struct toktab *t;
+   register char c;
+
+   c = *lex_sbuf.strtimage;
+   if (!islower(c))
+      return NULL;
+   /*
+    * Point t at first reserved word that starts with c (if any).
+    */
+   if ((t = restab[c - 'a']) == NULL)
+      return NULL;
+   /*
+    * Search through reserved words, stopping when a match is found
+    *  or when the current reserved word doesn't start with c.
+    */
+   while (t->t_word[0] == c) {
+      if (bufcmp(t->t_word))
+	 return t;
+      t++;
+      }
+   return NULL;
+   }
+
+/*
+ * bufcmp - compare a null terminated string to what is in the string buffer.
+ */
+static int bufcmp(s)
+char *s;
+   {
+   register char *s1;
+   s1 = lex_sbuf.strtimage;
+   while (s != '\0' && s1 < lex_sbuf.endimage && *s == *s1) {
+      ++s;
+      ++s1;
+      }
+   if (*s == '\0' && s1 == lex_sbuf.endimage)
+      return 1;
+   else
+      return 0;
+   }
+
+/*
+ * getnum - gather a numeric literal starting with ac and put the
+ *  character following the literal into *cc.
+ *
+ * getnum also handles the "." operator, which is distinguished from
+ *  a numeric literal by what follows it.
+ */
+
+static struct toktab *getnum(ac, cc)
+int ac;
+int *cc;
+   {
+   register int c, r, state;
+   int realflag, n, dummy;
+
+   c = ac;
+   if (c == '.') {
+      r = 0;
+      state = 7;
+      realflag = 1;
+      }
+   else {
+      r = tonum(c);
+      state = 0;
+      realflag = 0;
+      }
+   for (;;) {
+      AppChar(lex_sbuf, c);
+      c = NextChar;
+      switch (state) {
+	 case 0:		/* integer part */
+	    if (isdigit(c))	    { r = r * 10 + tonum(c); continue; }
+	    if (c == '.')           { state = 1; realflag++; continue; }
+	    if (c == 'e' || c == 'E')  { state = 2; realflag++; continue; }
+	    if (c == 'r' || c == 'R')  {
+	       state = 5;
+	       if (r < 2 || r > 36)
+		  tfatal("invalid radix for integer literal", (char *)NULL);
+	       continue;
+	       }
+	    break;
+	 case 1:		/* fractional part */
+	    if (isdigit(c))   continue;
+	    if (c == 'e' || c == 'E')   { state = 2; continue; }
+	    break;
+	 case 2:		/* optional exponent sign */
+	    if (c == '+' || c == '-') { state = 3; continue; }
+	 case 3:		/* first digit after e, e+, or e- */
+	    if (isdigit(c)) { state = 4; continue; }
+	    tfatal("invalid real literal", (char *)NULL);
+	    break;
+	 case 4:		/* remaining digits after e */
+	    if (isdigit(c))   continue;
+	    break;
+	 case 5:		/* first digit after r */
+	    if ((isdigit(c) || isletter(c)) && tonum(c) < r)
+	       { state = 6; continue; }
+	    tfatal("invalid integer literal", (char *)NULL);
+	    break;
+	 case 6:		/* remaining digits after r */
+	    if (isdigit(c) || isletter(c)) {
+	       if (tonum(c) >= r) {	/* illegal digit for radix r */
+		  tfatal("invalid digit in integer literal", (char *)NULL);
+		  r = tonum('z');       /* prevent more messages */
+		  }
+	       continue;
+	       }
+	    break;
+         case 7:		/* token began with "." */
+            if (isdigit(c)) {
+               state = 1;		/* followed by digit is a real const */
+	       realflag = 1;
+               continue;
+               }
+            *cc = c;			/* anything else is just a dot */
+	    lex_sbuf.endimage--;	/* remove dot (undo AppChar) */
+	    n = getopr((int)'.', &dummy);
+	    yylval = OpNode(n);
+	    return &(optab[n].tok);
+         }
+      break;
+      }
+   *cc = c;
+   if (realflag) {
+      yylval = RealNode(str_install(&lex_sbuf));
+      return T_Real;
+      }
+   yylval = IntNode(str_install(&lex_sbuf));
+   return T_Int;
+   }
+
+/*
+ * getstring - gather a string literal starting with ac and place the
+ *  character following the literal in *cc.
+ */
+static struct toktab *getstring(ac, cc)
+int ac;
+int *cc;
+   {
+   register int c, sc;
+   int sav_indx;
+   int len;
+
+   sc = ac;
+   sav_indx = -1;
+   c = NextChar;
+   while (c != sc && c != '\n' && c != EOF) {
+      /*
+       * If a '_' is the last non-white space before a new-line,
+       *  we must remember where it is.
+       */
+      if (c == '_')
+         sav_indx = lex_sbuf.endimage - lex_sbuf.strtimage;
+      else if (!isspace(c))
+         sav_indx = -1;
+
+      if (c == Escape) {
+         c = NextChar;
+         if (c == EOF)
+            break;
+
+#if defined(Iconc)
+         AppChar(lex_sbuf, Escape);
+         if (c == '^') {
+            c = NextChar;
+            if (c == EOF)
+               break;
+            AppChar(lex_sbuf, '^');
+            }
+#else					/* Iconc */
+	 if (isoctal(c))
+	    c = octesc(c);
+	 else if (c == 'x')
+	    c = hexesc();
+	 else if (c == '^')
+	    c = ctlesc();
+	 else
+	    c = esctab[c];
+#endif					/* Iconc */
+
+	 }
+      AppChar(lex_sbuf, c);
+      c = NextChar;
+
+      /*
+       * If a '_' is the last non-white space before a new-line, the
+       *  string continues at the first non-white space on the next line
+       *  and everything from the '_' to the end of this line is ignored.
+       */
+      if (c == '\n' && sav_indx >= 0) {
+         lex_sbuf.endimage = lex_sbuf.strtimage + sav_indx;
+         while ((c = NextChar) != EOF && isspace(c))
+            ;
+         }
+      }
+   if (c == sc)
+      *cc = ' ';
+   else {
+      tfatal("unclosed quote", (char *)NULL);
+      *cc = c;
+      }
+   len = lex_sbuf.endimage - lex_sbuf.strtimage;
+   if (ac == '"') {     /* a string literal */
+      yylval = StrNode(str_install(&lex_sbuf), len);
+      return T_String;
+      }
+   else {		/* a cset literal */
+      yylval = CsetNode(str_install(&lex_sbuf), len);
+      return T_Cset;
+      }
+   }
+
+#if !defined(Iconc)
+
+/*
+ * ctlesc - translate a control escape -- backslash followed by
+ *  caret and one character.
+ */
+
+static int ctlesc()
+   {
+   register int c;
+
+   c = NextChar;
+   if (c == EOF)
+      return EOF;
+
+   return (c & 037);
+   }
+
+/*
+ * octesc - translate an octal escape -- backslash followed by
+ *  one, two, or three octal digits.
+ */
+
+static int octesc(ac)
+int ac;
+   {
+   register int c, nc, i;
+
+   c = 0;
+   nc = ac;
+   i = 1;
+   do {
+      c = (c << 3) | (nc - '0');
+      nc = NextChar;
+      if (nc == EOF)
+	 return EOF;
+      } while (isoctal(nc) && i++ < 3);
+   PushChar(nc);
+
+   return (c & 0377);
+   }
+
+/*
+ * hexesc - translate a hexadecimal escape -- backslash-x
+ *  followed by one or two hexadecimal digits.
+ */
+
+static int hexesc()
+   {
+   register int c, nc, i;
+
+   c = 0;
+   i = 0;
+   while (i++ < 2) {
+      nc = NextChar;
+      if (nc == EOF)
+	 return EOF;
+      if (nc >= 'a' && nc <= 'f')
+	 nc -= 'a' - 10;
+      else if (nc >= 'A' && nc <= 'F')
+	 nc -= 'A' - 10;
+      else if (isdigit(nc))
+	 nc -= '0';
+      else {
+	 PushChar(nc);
+	 break;
+	 }
+      c = (c << 4) | nc;
+      }
+
+   return c;
+   }
+
+#endif					/* !Iconc */
+
+/*
+ * setlineno - set line number from #line comment, return following char.
+ */
+
+static int setlineno()
+   {
+   register int c;
+
+   while ((c = NextChar) == ' ' || c == '\t')
+      ;
+   if (c < '0' || c > '9') {
+      tfatal("no line number in #line directive", "");
+      while (c != EOF && c != '\n')
+	 c = NextChar;
+      return c;
+      }
+   in_line = 0;
+   while (c >= '0' && c <= '9') {
+      in_line = in_line * 10 + (c - '0');
+      c = NextChar;
+      }
+   return c;
+   }
+
+/*
+ * setfilenm -	set file name from #line comment, return following char.
+ */
+
+static int setfilenm(c)
+register int c;
+   {
+   while (c == ' ' || c == '\t')
+      c = NextChar;
+   if (c != '"') {
+      tfatal("'\"' missing from file name in #line directive", "");
+      while (c != EOF && c != '\n')
+	 c = NextChar;
+      return c;
+      }
+   while ((c = NextChar) != '"' && c != EOF && c != '\n')
+      AppChar(lex_sbuf, c);
+   if (c == '"') {
+      tok_loc.n_file = str_install(&lex_sbuf);
+      return NextChar;
+      }
+   else {
+      tfatal("'\"' missing from file name in #line directive", "");
+      return c;
+      }
+   }
+
+/*
+ * nextchar - return the next character in the input.
+ *
+ *  Called from the lexical analyzer; interfaces it to the preprocessor.
+ */
+
+int nextchar()
+   {
+   register int c;
+
+   if ((c = peekc) != 0) {
+      peekc = 0;
+      return c;
+      }
+   c = ppch();
+   switch (c) {
+      case EOF:
+	 if (incol) {
+	    c = '\n';
+	    in_line++;
+	    incol = 0;
+	    peekc = EOF;
+	    break;
+	    }
+	 else {
+	    in_line = 0;
+	    incol = 0;
+	    break;
+	    }
+      case '\n':
+	 in_line++;
+	 incol = 0;
+	 break;
+      case '\t':
+	 incol = (incol | 7) + 1;
+	 break;
+      case '\b':
+	 if (incol)
+	    incol--;
+	 break;
+      default:
+	 incol++;
+      }
+   return c;
+   }
diff --git a/src/h/config.h b/src/h/config.h
new file mode 100644
index 0000000..bc48ada
--- /dev/null
+++ b/src/h/config.h
@@ -0,0 +1,309 @@
+/*
+ * Icon configuration.
+ */
+
+/*
+ * System-specific definitions are in define.h, which is loaded first.
+ */
+
+/*
+ *  A number of symbols are defined here.
+ *  Some enable or disable certain Icon features, for example:
+ *	NoCoexpr	disables co-expressions
+ *	LoadFunc	enables dynamic loading
+ *
+ *  Other definitions may occur for different configurations. These include:
+ *	DeBug		debugging code
+ *	MultiThread	support for multiple programs under the interpreter
+ *
+ *  Many definitions reflect remnants of past research projects.
+ *  Changing them to values not used in standard configurations
+ *  may result in an unbuildable or nonfunctioning system.
+ */
+
+/*
+ * If COMPILER is not defined, code for the interpreter is compiled.
+ */
+
+#ifndef COMPILER
+   #define COMPILER 0
+#endif
+
+/*
+ * The following definitions serve to cast common conditionals is
+ *  a positive way, while allowing defaults for the cases that
+ *  occur most frequently.  That is, if co-expressions are not supported,
+ *  NoCoexpr is defined in define.h, but if they are supported, no
+ *  definition is needed in define.h; nonetheless subsequent conditionals
+ *  can be cast as #ifdef Coexpr.
+ */
+
+#ifndef NoCoexpr
+   #undef Coexpr
+   #define Coexpr
+#endif					/* NoCoexpr */
+
+#ifdef NoCoexpr
+   #undef MultiThread
+   #undef EventMon
+   #undef Eve
+#endif					/* NoCoexpr */
+
+#if COMPILER
+   #undef Eve
+   #undef MultiThread
+   #undef EventMon
+#endif					/* COMPILER */
+
+#ifdef Eve
+   #undef EventMon
+   #undef MultiThread
+   #define EventMon
+   #define MultiThread
+#endif					/* Eve */
+
+#ifndef NoLargeInts
+   #undef LargeInts
+   #define LargeInts
+#endif					/* NoLargeInts */
+
+#ifdef EventMon
+   #undef MultiThread
+   #define MultiThread
+#endif					/* EventMon */
+
+/*
+ * Graphics definitions.
+ */
+#ifdef Graphics
+
+   #ifndef XWindows
+      #ifdef MSWIN
+         #undef WinGraphics
+         #define WinGraphics 1
+      #else				/* Graphics */
+         #define XWindows 1
+      #endif				/* Graphics */
+   #endif				/* XWindows */
+
+   #ifndef NoXpmFormat
+      #ifdef XWindows
+         #undef HaveXpmFormat
+         #define HaveXpmFormat
+      #endif				/* XWindows */
+   #endif				/* NoXpmFormat */
+
+   #undef LineCodes
+   #define LineCodes
+
+   #undef Polling
+   #define Polling
+
+   #ifndef ICONC_XLIB
+      #ifdef WinGraphics
+         #define ICONC_XLIB "-luser32 -lgdi32 -lcomdlg32 -lwinmm"
+      #else				/* WinGraphics */
+         #define ICONC_XLIB "-L/usr/X11R6/lib -lX11"
+      #endif				/* WinGraphics */
+   #endif				/* ICONC_XLIB */
+
+#endif					/* Graphics */
+
+/*
+ * Data sizes and alignment.
+ */
+
+#define WordSize sizeof(word)
+
+#ifndef StackAlign
+   #define StackAlign 8
+#endif					/* StackAlign */
+
+/*
+ * Other defaults.
+ */
+
+#ifdef DeBug
+   #undef DeBugTrans
+   #undef DeBugLinker
+   #undef DeBugIconx
+   #define DeBugTrans
+   #define DeBugLinker
+   #define DeBugIconx
+#endif					/* DeBug */
+
+#ifndef MaxHdr
+   /*
+    * Maximum allowable BinaryHeader size.
+    * WARNING: changing this invalidates old BinaryHeader executables.
+    */
+   #define MaxHdr 8192
+#endif					/* MaxHdr */
+
+#ifndef MaxPath
+   #define MaxPath 256
+#endif					/* MaxPath */
+
+#ifndef SourceSuffix
+   #define SourceSuffix ".icn"
+#endif					/* SourceSuffix */
+
+/*
+ * Representations of directories. LocalDir is the "current working directory".
+ *  SourceDir is where the source file is.
+ */
+
+#define LocalDir ""
+#define SourceDir (char *)NULL
+
+#ifndef TargetDir
+   #define TargetDir LocalDir
+#endif					/* TargetDir */
+
+/*
+ * Features enabled by default.
+ */
+#ifndef NoPipes
+   #define Pipes
+#endif					/* Pipes */
+
+#ifndef NoKeyboardFncs
+   #define KeyboardFncs
+#endif					/* KeyboardFncs */
+
+#ifndef NoReadDirectory
+   #define ReadDirectory
+#endif					/* ReadDirectory */
+
+#ifndef NoSysOpt
+   #define SysOpt
+#endif					/* SysOpt */
+
+/*
+ *  The following definitions assume ANSI C.
+ */
+#define Cat(x,y) x##y
+#define Lit(x) #x
+#define Bell '\a'
+
+/*
+ * Miscellaney.
+ */
+
+#ifndef DiffPtrs
+   #define DiffPtrs(p1,p2) (word)((p1)-(p2))
+#endif					/* DiffPtrs */
+
+#ifndef AllocReg
+   #define AllocReg(n) malloc(n)
+#endif					/* AllocReg */
+
+#ifndef RttSuffix
+   #define RttSuffix ".r"
+#endif					/* RttSuffix */
+
+#ifndef DBSuffix
+   #define DBSuffix ".db"
+#endif					/* DBSuffix */
+
+#ifndef PPInit
+   #define PPInit ""
+#endif					/* PPInit */
+
+#ifndef PPDirectives
+   #define PPDirectives {"passthru", PpKeep},
+#endif					/* PPDirectives */
+
+#ifndef NoSrcColumnInfo
+   #define SrcColumnInfo
+#endif					/* NoSrcColumnInfo */
+
+#ifndef ExecSuffix
+   #define ExecSuffix ""
+#endif					/* ExecSuffix */
+
+#ifndef CSuffix
+   #define CSuffix ".c"
+#endif					/* CSuffix */
+
+#ifndef HSuffix
+   #define HSuffix ".h"
+#endif					/* HSuffix */
+
+#ifndef ObjSuffix
+   #define ObjSuffix ".o"
+#endif					/* ObjSuffix */
+
+#ifndef LibSuffix
+   #define LibSuffix ".a"
+#endif					/* LibSuffix */
+
+#ifndef CComp
+   #define CComp "cc"
+#endif					/* CComp */
+
+#ifndef COpts
+   #define COpts ""
+#endif					/* COpts */
+
+/*
+ * Note, size of the hash table is a power of 2:
+ */
+#define IHSize 128
+#define IHasher(x)	(((unsigned int)(unsigned long)(x))&(IHSize-1))
+
+#if COMPILER
+
+   /*
+    * Code for the compiler.
+    */
+   #undef MultiThread		/* no way -- interpreter only */
+   #undef EventMon		/* presently not supported in the compiler */
+
+#else					/* COMPILER */
+
+   /*
+    * Code for the interpreter.
+    */
+   #ifndef IcodeSuffix
+      #define IcodeSuffix ""
+   #endif				/* IcodeSuffix */
+
+   #ifndef IcodeASuffix
+      #define IcodeASuffix ""
+   #endif				/* IcodeASuffix */
+
+   #ifndef U1Suffix
+      #define U1Suffix ".u1"
+   #endif				/* U1Suffix */
+
+   #ifndef U2Suffix
+      #define U2Suffix ".u2"
+   #endif				/* U2Suffix */
+
+   #ifndef USuffix
+      #define USuffix ".u"
+   #endif				/* USuffix */
+
+#endif					/* COMPILER */
+
+/*
+ *  Vsizeof is for use with variable-sized (i.e., indefinite)
+ *   structures containing an array of descriptors declared of size 1
+ *   to avoid compiler warnings associated with 0-sized arrays.
+ */
+
+#define Vsizeof(s)	(sizeof(s) - sizeof(struct descrip))
+
+/*
+ * Other sizeof macros:
+ *
+ *  Wsizeof(x)	-- Size of x in words.
+ *  Vwsizeof(x) -- Size of x in words, minus the size of a descriptor.	Used
+ *   when structures have a potentially null list of descriptors
+ *   at their end.
+ */
+
+#define Wsizeof(x)	((sizeof(x) + sizeof(word) - 1) / sizeof(word))
+#define Vwsizeof(x) \
+   ((sizeof(x) - sizeof(struct descrip) + sizeof(word) - 1) / sizeof(word))
diff --git a/src/h/cpuconf.h b/src/h/cpuconf.h
new file mode 100644
index 0000000..228ce6b
--- /dev/null
+++ b/src/h/cpuconf.h
@@ -0,0 +1,247 @@
+/*
+ *  Configuration parameters that depend on computer architecture.
+ *  Some depend on values defined in config.h, which is always
+ *  included before this file.
+ */
+
+#ifndef CStateSize
+   #define CStateSize 15		/* size of C state for co-expressions */
+#endif					/* CStateSize */
+
+/*
+ * The following definitions depend on the sizes of ints and pointers.
+ */
+
+/*
+ * Most of the present implementations use 32-bit "words".  Note that
+ *  WordBits is the number of bits in an Icon integer, not necessarily
+ *  the number of bits in an int (given by IntBits).  In some systems
+ *  an Icon integer is a long, not an int.
+ *
+ *  MaxStrLen must not be so large as to overlap flags.
+ */
+
+/*
+ * 64-bit words.
+ */
+
+#if WordBits == 64
+
+   #ifndef MinLong
+      #define MinLong  ((long int)0x8000000000000000) /* smallest long int */
+   #endif
+
+   #ifndef MaxLong
+      #define MaxLong  ((long int)0x7fffffffffffffff) /* largest long integer */
+   #endif
+
+   #define MaxStrLen 017777777777L		/* maximum string length */
+
+   #ifndef MaxNegInt
+      #define MaxNegInt "-9223372036854775808"
+   #endif
+
+   #ifndef F_Nqual
+      #define F_Nqual 0x8000000000000000	/* set if NOT string qualifier*/
+   #endif				/* F_Nqual */
+
+   #ifndef F_Var
+      #define F_Var	0x4000000000000000	/* set if variable */
+   #endif				/* F_Var */
+
+   #ifndef F_Ptr
+      #define F_Ptr	0x1000000000000000	/* set if value field is ptr */
+   #endif				/* F_Ptr */
+
+   #ifndef F_Typecode
+      #define F_Typecode  0x2000000000000000	/* set if dword incls typecode*/
+   #endif				/* F_Typecode */
+
+#endif					/* WordBits == 64 */
+
+/*
+ * 32-bit words.
+ */
+
+#if WordBits == 32
+
+   #define MaxLong  ((long int)017777777777L)   /* largest long integer */
+   #define MinLong  ((long int)020000000000L)   /* smallest long integer */
+
+   #define MaxNegInt "-2147483648"
+
+   #define MaxStrLen 0777777777		/* maximum string length */
+
+   #define F_Nqual	0x80000000	/* set if NOT string qualifier */
+   #define F_Var	0x40000000	/* set if variable */
+   #define F_Ptr	0x10000000	/* set if value field is pointer */
+   #define F_Typecode	0x20000000	/* set if dword includes type code */
+
+#endif					/* WordBits == 32 */
+
+/*
+ * Values that depend on the number of bits in an int (not necessarily
+ * the same as the number of bits in a word).
+ */
+
+#if IntBits == 64
+   #define LogIntBits	6			/* log of IntBits */
+   #define MaxUnsigned 01777777777777777777777L /* largest unsigned integer */
+   #define MaxInt	0777777777777777777777L /* largest int */
+   /*
+    * Cset initialization and access macros.
+    */
+   #define fwd(w0, w1, w2, w3) \
+      (((w0) & 0xffff) | (((unsigned)(w1) & 0xffff) << 16) | \
+      (((unsigned)(w2) & 0xffff) << 32) | (((unsigned)(w3) & 0xffff) << 48))
+   #define cset_display(w0,w1,w2,w3,w4,w5,w6,w7,w8,w9,wa,wb,wc,wd,we,wf) \
+      {fwd(w0,w1,w2,w3),fwd(w4,w5,w6,w7),fwd(w8,w9,wa,wb),fwd(wc,wd,we,wf)}
+   #define Cset32(b,c) (*CsetPtr(b,c)>>(32*CsetOff((b)>>5)))  /* 32b of cset */
+#endif					/* IntBits == 64 */
+
+#if IntBits == 32
+   #define LogIntBits	5		/* log of IntBits */
+   #define MaxUnsigned	037777777777	/* largest unsigned integer */
+   #define MaxInt	017777777777	/* largest int */
+   /*
+    * Cset initialization and access macros.
+    */
+   #define twd(w0,w1)	(((w0)&0xffff) | (((unsigned)w1)<<16))
+   #define cset_display(w0,w1,w2,w3,w4,w5,w6,w7,w8,w9,wa,wb,wc,wd,we,wf) \
+      {twd(w0,w1),twd(w2,w3),twd(w4,w5),twd(w6,w7), \
+       twd(w8,w9),twd(wa,wb),twd(wc,wd),twd(we,wf)}
+   #define Cset32(b,c) (*CsetPtr(b,c))	/* 32 bits of cset */
+#endif					/* IntBits == 32 */
+
+#ifndef LogHuge
+   #define LogHuge 309			/* maximum base-10 exp+1 of real */
+#endif					/* LogHuge */
+
+#ifndef Big
+   #define Big 9007199254740992.	/* larger than 2^53 lose precision */
+#endif					/* Big */
+
+#ifndef Precision
+   #define Precision 10			/* digits in string from real */
+#endif					/* Precision */
+
+/*
+ * Parameters that configure tables and sets:
+ *
+ *  HSlots	Initial number of hash buckets; must be a power of 2.
+ *  LogHSlots	Log to the base 2 of HSlots.
+ *
+ *  HSegs	Maximum number of hash bin segments; the maximum number of
+ *		hash bins is HSlots * 2 ^ (HSegs - 1).
+ *
+ *		If Hsegs is increased above 20, the arrays log2h[] and segsize[]
+ *		in the runtime system will need modification.
+ *
+ *  MaxHLoad	Maximum loading factor; more hash bins are allocated when
+ *		the average bin exceeds this many entries.
+ *
+ *  MinHLoad	Minimum loading factor; if a newly created table (e.g. via
+ *		copy()) is more lightly loaded than this, bins are combined.
+ *
+ *  Because splitting doubles the number of hash bins, and combining halves it,
+ *  MaxHLoad should be at least twice MinHLoad.
+ */
+
+#ifndef HSlots
+   #define HSlots     16
+   #define LogHSlots  4
+#endif					/* HSlots */
+
+#if ((1 << LogHSlots) != HSlots)
+   #error HSlots and LogHSlots are inconsistent
+#endif					/* HSlots / LogHSlots consistency */
+
+#ifndef HSegs
+   #define HSegs	 20
+#endif					/* HSegs */
+
+#ifndef MinHLoad
+   #define MinHLoad  1
+#endif					/* MinHLoad */
+
+#ifndef MaxHLoad
+   #define MaxHLoad  5
+#endif					/* MaxHLoad */
+
+/*
+ * The number of bits in each base-B digit; the type DIGIT (unsigned int)
+ *  in rt.h must be large enough to hold this many bits.
+ *  It must be at least 2 and at most WordBits / 2.
+ */
+#define NB           (WordBits / 2)
+
+/*
+ * The number of decimal digits at which the image lf a large integer
+ * goes from exact to approximate (to avoid possible long delays in
+ * conversion from large integer to string because of its quadratic
+ * complexity).
+ */
+#define MaxDigits	30
+
+/*
+ * Memory sizing.
+ */
+#ifndef AlcMax
+   #define AlcMax 25
+#endif					/* AlcMax */
+
+/*
+ * Maximum sized block that can be allocated (via malloc() or such).
+ */
+#ifndef MaxBlock
+   #define MaxBlock MaxUnsigned
+#endif					/* MaxBlock */
+
+/*
+ * What follows is default memory sizing. Implementations with special
+ *  requirements may specify these values in define.h.
+ */
+
+#ifndef MaxStrSpace
+   #define MaxStrSpace 500000		/* size of the string space in bytes */
+#endif					/* MaxStrSpace */
+
+#ifndef MaxAbrSize
+   #define MaxAbrSize 500000		/* size of the block region in bytes */
+#endif					/* MaxAbrSize */
+
+#ifndef MinAbrSize
+   #define MinAbrSize	 5000		/* minimum block region size */
+#endif					/* MinAbrSize */
+
+#ifndef MStackSize
+   #ifdef MultiThread
+      #define MStackSize 20000		/* size of the main stack in words */
+   #else				/* MultiThread */
+      #define MStackSize 10000		/* size of the main stack in words */
+   #endif				/* MultiThread */
+#endif					/* MStackSize */
+
+#ifndef StackSize
+   #define StackSize	2000		/* words in co-expression stack */
+#endif					/* StackSize */
+
+#ifndef QualLstSize
+   #define QualLstSize	5000		/* size of qualifier pointer region */
+#endif					/* QualLstSize */
+
+#ifndef ActStkBlkEnts
+   #ifdef Coexpr
+      #define ActStkBlkEnts   25	/* number of entries in an astkblk */
+   #else				/* Coexpr */
+      #define ActStkBlkEnts    1	/* number of entries in an astkblk */
+   #endif				/* Coexpr */
+#endif					/* ActStkBlkEnts */
+
+#ifndef RegionCushion
+   #define RegionCushion 10		/* % memory cushion to avoid thrashing*/
+#endif					/* RegionCushion */
+
+#ifndef RegionGrowth
+   #define RegionGrowth 200		/* % region growth when full */
+#endif					/* RegionGrowth */
diff --git a/src/h/cstructs.h b/src/h/cstructs.h
new file mode 100644
index 0000000..4301805
--- /dev/null
+++ b/src/h/cstructs.h
@@ -0,0 +1,317 @@
+/*
+ * cstructs.h - structures and accompanying manifest constants for functions
+ *  in the common subdirectory.
+ */
+
+/*
+ * fileparts holds a file name broken down into parts.
+ */
+struct fileparts {			/* struct of file name parts */
+   char *dir;				/* directory */
+   char *name;				/* name */
+   char *ext;				/* extension */
+   };
+
+/*
+ * xval - holds references to literal constants
+ */
+union xval {
+   long ival;		/* integer */
+   double rval;		/*  real */
+   word sval;		/*  offset into string space of string */
+   };
+
+/*
+ * str_buf references a string buffer. Strings are built a character
+ *  at a time. When a buffer "fragment" is filled, another is allocated
+ *  and the the current string copied to it.
+ */
+struct str_buf_frag {
+   struct str_buf_frag *next;     /* next buffer fragment */
+   char s[1];                     /* variable size buffer, really > 1 */
+   };
+
+struct str_buf {
+   unsigned int size;             /* total size of current buffer */
+   char *strtimage;               /* start of string currently being built */
+   char *endimage;                /* next free character in buffer */
+   char *end;                     /* end of current buffer */
+   struct str_buf_frag *frag_lst; /* list of buffer fragments */
+   struct str_buf *next;          /* buffers can be put on free list */
+   };
+
+#define AppChar(sbuf, c) do {\
+   if ((sbuf).endimage >= (sbuf).end)\
+      new_sbuf(&(sbuf));\
+   *((sbuf).endimage)++ = (c);\
+   } while (0)
+
+/*
+ * implement contains information about the implementation of an operation.
+ */
+#define NoRsltSeq  -1L	     /* no result sequence: {} */
+#define UnbndSeq   -2L       /* unbounded result sequence: {*} */
+
+#define DoesRet    01	     /* operation (or "body" function) returns */
+#define DoesFail   02	     /* operation (or "body" function) fails */
+#define DoesSusp   04	     /* operation (or "body" function) suspends */
+#define DoesEFail 010        /* fails through error conversion */
+#define DoesFThru 020	     /* only "body" functions can "fall through" */
+
+struct implement {
+   struct implement *blink;   /* link for bucket chain in hash tables */
+   char oper_typ;             /* 'K'=keyword, 'F'=function, 'O'=operator */
+   char prefix[2];	      /* prefix to make start of name unique */
+   char *name;		      /* function/operator/keyword name */
+   char *op;		      /* operator symbol (operators only) */
+   int nargs;		      /* number of arguments operation requires */
+   int *arg_flgs;             /* array of arg flags: deref/underef, var len*/
+   long min_result;	      /* minimum result sequence length */
+   long max_result;	      /* maiximum result sequence length */
+   int resume;		      /* flag - resumption after last result */
+   int ret_flag;	      /* DoesRet, DoesFail, DoesSusp */
+   int use_rslt;              /* flag - explicitly uses result location */
+   char *comment;	      /* description of operation */
+   int ntnds;		      /* size of tnds array */
+   struct tend_var *tnds;     /* pointer to array of info about tended vars */
+   int nvars;                 /* size of vars array */
+   struct ord_var  *vars;     /* pointer to array of info about ordinary vars */
+   struct il_code *in_line;    /* inline version of the operation */
+   int iconc_flgs;	      /* flags for internal use by the compiler */
+   };
+
+/*
+ * These codes are shared between the data base and rtt. They are defined
+ *  here, though not all are used by the data base.
+ */
+#define TndDesc   1  /* a tended descriptor */
+#define TndStr    2  /* a tended character pointer */
+#define TndBlk    3  /* a tended block pointer */
+#define OtherDcl  4  /* a declaration that is not special */
+#define IsTypedef 5  /* a typedef */
+#define VArgLen   6  /* identifier for length of variable parm list */
+#define RsltLoc   7  /* the special result location of an operation */
+#define Label     8  /* label */
+#define RtParm   16  /* undereferenced parameter of run-time routine */
+#define DrfPrm   32  /* dereferenced parameter of run-time routine */
+#define VarPrm   64  /* variable part of parm list (with RtParm or DrfPrm) */
+#define PrmMark 128  /* flag - used while recognizing params of body fnc */
+#define ByRef   256  /* flag - parameter to body function passed by reference */
+
+/*
+ * Flags to indicate what types are returned from the function implementing
+ *  a body. These are unsed in determining the calling conventions
+ *  of the function.
+ */
+#define RetInt   1  /* body/function returns a C_integer */
+#define RetDbl   2  /* body/function returns a C_double */
+#define RetOther 4  /* body (not function itself) returns something else */
+#define RetNoVal 8  /* function returns no value */
+#define RetSig  16  /* function returns a signal */
+
+/*
+ * tend_var contains information about a tended variable in the "declare {...}"
+ *  action of an operation.
+ */
+struct tend_var {
+   int var_type;           /* TndDesc, TndStr, or TndBlk */
+   struct il_c *init;      /* initial value from declaration */
+   char *blk_name;         /* TndBlk: struct name of block */
+   };
+
+/*
+ * ord_var contains information about an ordinary variable in the
+ *  "declare {...}" action of an operation.
+ */
+struct ord_var {
+   char *name;        /* name of variable */
+   struct il_c *dcl;  /* declaration of variable (includes name) */
+   };
+
+/*
+ * il_code has information about an action in an operation.
+ */
+#define IL_If1     1
+#define IL_If2     2
+#define IL_Tcase1  3
+#define IL_Tcase2  4
+#define IL_Lcase   5
+#define IL_Err1    6
+#define IL_Err2    7
+#define IL_Lst     8
+#define IL_Const   9
+#define IL_Bang   10
+#define IL_And    11
+#define IL_Cnv1   12
+#define IL_Cnv2   13
+#define IL_Def1   14
+#define IL_Def2   15
+#define IL_Is     16
+#define IL_Var    17
+#define IL_Subscr 18
+#define IL_Block  19
+#define IL_Call   20
+#define IL_Abstr  21
+#define IL_VarTyp 22
+#define IL_Store  23
+#define IL_Compnt 24
+#define IL_TpAsgn 25
+#define IL_Union  26
+#define IL_Inter  27
+#define IL_New    28
+#define IL_IcnTyp 29
+#define IL_Acase  30
+
+#define CM_Fields -1
+
+union il_fld {
+   struct il_code *fld;
+   struct il_c *c_cd;
+   int *vect;
+   char *s;
+   word n;
+   };
+
+struct il_code {
+   int il_type;
+   union il_fld u[1];   /* actual number of fields varies with type */
+   };
+
+/*
+ * The following manifest constants are used to describe types, conversions,
+ *   and returned values. Non-negative numbers are reserved for types described
+ *   in the type specification system.
+ */
+#define TypAny    -1
+#define TypEmpty  -2
+#define TypVar    -3
+#define TypCInt   -4
+#define TypCDbl   -5
+#define TypCStr   -6
+#define TypEInt   -7
+#define TypECInt  -8
+#define TypTStr   -9
+#define TypTCset -10
+#define RetDesc  -11
+#define RetNVar  -12
+#define RetSVar  -13
+#define RetNone  -14
+
+/*
+ * il_c describes a piece of C code.
+ */
+#define ILC_Ref    1   /* nonmodifying reference to var. in sym. tab. */
+#define ILC_Mod    2   /* modifying reference to var. in sym. tab */
+#define ILC_Tend   3   /* tended var. local to inline block */
+#define ILC_SBuf   4   /* string buffer */
+#define ILC_CBuf   5   /* cset buffer */
+#define ILC_Ret    6   /* return statement */
+#define ILC_Susp   7   /* suspend statement */
+#define ILC_Fail   8   /* fail statement */
+#define ILC_Goto   9   /* goto */
+#define ILC_CGto  10   /* conditional goto */
+#define ILC_Lbl   11   /* label */
+#define ILC_LBrc  12   /* '{' */
+#define ILC_RBrc  13   /* '}' */
+#define ILC_Str   14   /* arbitrary string of code */
+#define ILC_EFail 15   /* errorfail statement */
+
+#define RsltIndx -1   /* symbol table index for "result" */
+
+struct il_c {
+   int il_c_type;
+   struct il_c *code[3];
+   word n;
+   char *s;
+   struct il_c *next;
+   };
+
+/*
+ * The parameter value of a run-time operation may be in one of several
+ *  different locations depending on what conversions have been done to it.
+ *  These codes are shared by rtt and iconc.
+ */
+#define PrmTend    1   /* in tended location */
+#define PrmCStr    3   /* converted to C string: tended location */
+#define PrmInt     4   /* converted to C int: non-tended location */
+#define PrmDbl     8   /* converted to C double: non-tended location */
+
+/*
+ * Kind of RLT return statement supported.
+ */
+#define TRetNone  0   /* does not support an RTL return statement */
+#define TRetBlkP  1   /* block pointer */
+#define TRetDescP 2   /* descriptor pointer */
+#define TRetCharP 3   /* character pointer */
+#define TRetCInt  4   /* C integer */
+#define TRetSpcl  5   /* RLT return statement has special form & semenatics */
+
+/*
+ * Codes for dereferencing needs.
+ */
+#define DrfNone  0  /* not a variable type */
+#define DrfGlbl  1  /* treat as a global variable */
+#define DrfCnst  2  /* type of values in variable doesn't change */
+#define DrfSpcl  3  /* special dereferencing: trapped variable */
+
+/*
+ * Information about an Icon type.
+ */
+struct icon_type {
+   char *id;		/* name of type */
+   int support_new;	/* supports RTL "new" construct */
+   int deref;		/* dereferencing needs */
+   int rtl_ret;		/* kind of RTL return supported if any */
+   char *typ;		/* for variable: initial type */
+   int num_comps;	/* for aggregate: number of type components */
+   int compnts;		/* for aggregate: index of first component */
+   char *abrv;		/* abreviation used for type tracing */
+   char *cap_id;	/* name of type with first character capitalized */
+   };
+
+/*
+ * Information about a component of an aggregate type.
+ */
+struct typ_compnt {
+   char *id;		/* name of component */
+   int n;		/* position of component within type aggragate */
+   int var;		/* flag: this component is an Icon-level variable */
+   int aggregate;	/* index of type that owns the component */
+   char *abrv;		/* abreviation used for type tracing */
+   };
+
+extern int num_typs;                 /* number of types in table */
+extern struct icon_type icontypes[]; /* table of icon types */
+
+/*
+ * Type inference needs to know where most of the standard types
+ *  reside. Some have special uses outside operations written in
+ *  RTL code, such as the null type for initializing variables, and
+ *  others have special semantics, such as trapped variables.
+ */
+extern int str_typ;                  /* index of string type */
+extern int int_typ;                  /* index of integer type */
+extern int rec_typ;                  /* index of record type */
+extern int proc_typ;                 /* index of procedure type */
+extern int coexp_typ;                /* index of co-expression type */
+extern int stv_typ;                  /* index of sub-string trapped var type */
+extern int ttv_typ;                  /* index of table-elem trapped var type */
+extern int null_typ;                 /* index of null type */
+extern int cset_typ;                 /* index of cset type */
+extern int real_typ;                 /* index of real type */
+extern int list_typ;                 /* index of list type */
+extern int tbl_typ;                  /* index of table type */
+
+extern int num_cmpnts;                 /* number of aggregate components */
+extern struct typ_compnt typecompnt[]; /* table of aggregate components */
+extern int str_var;                    /* index of trapped string variable */
+extern int trpd_tbl;                   /* index of trapped table */
+extern int lst_elem;                   /* index of list element */
+extern int tbl_val;                    /* index of table element value */
+extern int tbl_dflt;                   /* index of table default */
+
+/*
+ * minimum number of unsigned ints needed to hold the bits of a cset - only
+ *  used in translators, not in the run-time system.
+ */
+#define BVectSize 16
diff --git a/src/h/esctab.h b/src/h/esctab.h
new file mode 100644
index 0000000..0098852
--- /dev/null
+++ b/src/h/esctab.h
@@ -0,0 +1,38 @@
+/*
+ * esctab.h - table for translating single-char escapes in string literals.
+ */
+
+static unsigned char esctab[] = {
+   000,   001,   002,   003,   004,   005,   006,   007,   /* NUL-BEL */
+   010,   011,   012,   013,   014,   015,   016,   017,   /* BS -SI */
+   020,   021,   022,   023,   024,   025,   026,   027,   /* DLE-ETB */
+   030,   031,   032,   033,   034,   035,   036,   037,   /* CAN-US */
+   ' ',   '!',   '"',   '#',   '$',   '%',   '&',   '\'',  /* !"#$%&' */
+   '(',   ')',   '*',   '+',   ',',   '-',   '.',   '/',   /* ()*+,-./ */
+   000,   001,   002,   003,   004,   005,   006,   007,   /* 01234567 */
+   010,   011,   ':',   ';',   '<',   '=',   '>',   '?',   /* 89:;<=>? */
+   '@',   'A',   '\b',  'C',   0177,  033,   014,   'G',   /* @ABCDEFG */
+   'H',   'I',   'J',   'K',   '\n',  'M',  '\n',   'O',   /* HIJKLMNO */
+   'P',   'Q',   '\r',  'S',   '\t',  'U',   013,   'W',   /* PQRSTUVW */
+   'X',   'Y',   'Z',   '[',   '\\',  ']',   '^',   '_',   /* XYZ[\]^_ */
+   '`',   'a',   '\b',  'c',   0177,  033,   014,   'g',   /* `abcdefg */
+   'h',   'i',   'j',   'k',   '\n',  'm',   '\n',  'o',   /* hijklmno */
+   'p',   'q',   '\r',  's',   '\t',  'u',   013,   'w',   /* pqrstuvw */
+   'x',   'y',   'z',   '{',   '|',   '}',   '~',   0177,  /* xyz{|}~ */
+   0200,  0201,  0202,  0203,  0204,  0205,  0206,  0207,
+   0210,  0211,  0212,  0213,  0214,  0215,  0216,  0217,
+   0220,  0221,  0222,  0223,  0224,  0225,  0226,  0227,
+   0230,  0231,  0232,  0233,  0234,  0235,  0236,  0237,
+   0240,  0241,  0242,  0243,  0244,  0245,  0246,  0247,
+   0250,  0251,  0252,  0253,  0254,  0255,  0256,  0257,
+   0260,  0261,  0262,  0263,  0264,  0265,  0266,  0267,
+   0270,  0271,  0272,  0273,  0274,  0275,  0276,  0277,
+   0300,  0301,  0302,  0303,  0304,  0305,  0306,  0307,
+   0310,  0311,  0312,  0313,  0314,  0315,  0316,  0317,
+   0320,  0321,  0322,  0323,  0324,  0325,  0326,  0327,
+   0330,  0331,  0332,  0333,  0334,  0335,  0336,  0337,
+   0340,  0341,  0342,  0343,  0344,  0345,  0346,  0347,
+   0350,  0351,  0352,  0353,  0354,  0355,  0356,  0357,
+   0360,  0361,  0362,  0363,  0364,  0365,  0366,  0367,
+   0370,  0371,  0372,  0373,  0374,  0375,  0376,  0377,
+   };
diff --git a/src/h/fdefs.h b/src/h/fdefs.h
new file mode 100644
index 0000000..8f35509
--- /dev/null
+++ b/src/h/fdefs.h
@@ -0,0 +1,232 @@
+/*
+ * Definitions of functions.
+ */
+
+FncDef(abs,1)
+FncDef(acos,1)
+FncDef(any,4)
+FncDef(args,1)
+FncDef(asin,1)
+FncDef(atan,2)
+FncDef(bal,6)
+FncDef(center,3)
+FncDef(char,1)
+FncDef(chdir,1)
+FncDef(close,1)
+FncDef(collect,2)
+FncDef(copy,1)
+FncDef(cos,1)
+FncDef(cset,1)
+FncDef(delay,1)
+FncDef(delete,2)
+FncDefV(detab)
+FncDef(dtor,1)
+FncDefV(entab)
+FncDef(errorclear,0)
+FncDef(exit,1)
+FncDef(exp,2)
+FncDef(find,4)
+FncDef(flush,1)
+FncDef(function,0)
+FncDef(get,2)
+FncDef(getenv,1)
+FncDef(iand,2)
+FncDef(icom,1)
+FncDef(image,1)
+FncDef(insert,3)
+FncDef(integer,1)
+FncDef(ior,2)
+FncDef(ishift,2)
+FncDef(ixor,2)
+FncDef(key,2)
+FncDef(left,3)
+FncDef(list,2)
+FncDef(log,1)
+FncDef(many,4)
+FncDef(map,3)
+FncDef(match,4)
+FncDef(member,1)
+FncDef(move,1)
+FncDef(numeric,1)
+FncDef(ord,1)
+FncDef(pop,1)
+FncDef(pos,1)
+FncDef(pull,1)
+FncDefV(push)
+FncDefV(put)
+FncDef(read,2)
+FncDef(reads,2)
+FncDef(real,1)
+FncDef(remove,2)
+FncDef(rename,1)
+FncDef(repl,2)
+FncDef(reverse,1)
+FncDef(right,3)
+FncDef(rtod,1)
+FncDefV(runerr)
+FncDef(seek,2)
+FncDef(seq,2)
+FncDef(serial,1)
+FncDef(set,1)
+FncDef(sin,1)
+FncDef(sort,2)
+FncDef(sortf,2)
+FncDef(sqrt,1)
+FncDefV(stop)
+FncDef(string,1)
+FncDef(system,1)
+FncDef(tab,1)
+FncDef(table,1)
+FncDef(tan,1)
+FncDef(trim,2)
+FncDef(type,1)
+FncDef(upto,4)
+FncDef(where,1)
+FncDefV(write)
+FncDefV(writes)
+
+#ifdef Graphics
+   FncDefV(open)
+#else					/* Graphics */
+   FncDef(open,3)
+#endif					/* Graphics */
+
+#ifdef MultiThread
+   FncDef(display,3)
+   FncDef(name,2)
+   FncDef(proc,3)
+   FncDef(variable,3)
+#else					/* MultiThread */
+   FncDef(display,2)
+   FncDef(name,1)
+   FncDef(proc,2)
+   FncDef(variable,1)
+#endif					/* MultiThread */
+
+/*
+ * Dynamic loading.
+ */
+#ifdef LoadFunc
+   FncDef(loadfunc,2)
+#endif					/* LoadFunc */
+
+/*
+ * External functions.
+ */
+#ifdef ExternalFunctions
+   FncDefV(callout)
+#endif					/* ExternalFunctions */
+
+/*
+ * File attribute function.
+ */
+#ifdef FAttrib
+   FncDefV(fattrib)
+#endif					/* FAttrib */
+
+/*
+ * Keyboard Functions
+ */
+#ifdef KeyboardFncs
+   FncDef(getch,0)
+   FncDef(getche,0)
+   FncDef(kbhit,0)
+#endif					/* KeyboardFncs */
+
+/*
+ * Event processing functions.
+ */
+#ifdef EventMon
+   FncDef(EvGet,2)
+   FncDef(event,3)
+   FncDef(eventmask,2)
+   FncDef(opmask,2)
+#endif					/* EventMon */
+
+/*
+ * Graphics functions.
+ */
+#ifdef Graphics
+   FncDef(Active,0)
+   FncDefV(Alert)
+   FncDefV(Bg)
+   FncDefV(Clip)
+   FncDefV(Clone)
+   FncDefV(Color)
+   FncDefV(ColorValue)
+   FncDefV(CopyArea)
+   FncDefV(Couple)
+   FncDefV(DrawArc)
+   FncDefV(DrawCircle)
+   FncDefV(DrawCurve)
+   FncDefV(DrawImage)
+   FncDefV(DrawLine)
+   FncDefV(DrawPoint)
+   FncDefV(DrawPolygon)
+   FncDefV(DrawRectangle)
+   FncDefV(DrawSegment)
+   FncDefV(DrawString)
+   FncDefV(EraseArea)
+   FncDefV(Event)
+   FncDefV(Fg)
+   FncDefV(FillArc)
+   FncDefV(FillCircle)
+   FncDefV(FillPolygon)
+   FncDefV(FillRectangle)
+   FncDefV(Font)
+   FncDefV(FreeColor)
+   FncDefV(GotoRC)
+   FncDefV(GotoXY)
+   FncDefV(Lower)
+   FncDefV(NewColor)
+   FncDefV(PaletteChars)
+   FncDefV(PaletteColor)
+   FncDefV(PaletteKey)
+   FncDefV(Pattern)
+   FncDefV(Pending)
+   FncDefV(Pixel)
+   FncDef(QueryPointer,1)
+   FncDefV(Raise)
+   FncDefV(ReadImage)
+   FncDefV(TextWidth)
+   FncDef(Uncouple,1)
+   FncDefV(WAttrib)
+   FncDefV(WDefault)
+   FncDefV(WFlush)
+   FncDef(WSync,1)
+   FncDefV(WriteImage)
+   /*
+    * Native function extensions for Windows
+    */
+   #ifdef WinExtns
+      FncDefV(WinPlayMedia)
+      FncDefV(WinEditRegion)
+      FncDefV(WinButton)
+      FncDefV(WinScrollBar)
+      FncDefV(WinMenuBar)
+      FncDefV(WinColorDialog)
+      FncDefV(WinFontDialog)
+      FncDefV(WinOpenDialog)
+      FncDefV(WinSaveDialog)
+      FncDefV(WinSelectDialog)
+   #endif				/* WinExtns */
+#endif					/* Graphics */
+
+#ifdef MultiThread
+   /*
+    * These functions are part of the MultiThread extensions.
+    */
+   FncDef(cofail,1)
+   FncDef(globalnames,1)
+   FncDef(fieldnames,1)
+   FncDef(localnames,2)
+   FncDef(staticnames,2)
+   FncDef(paramnames,2)
+   FncDef(structure,1)
+   /*
+    * These functions are inherent to MultiThread and multiple Icon programs
+    */
+   FncDefV(load)
+   FncDef(parent,1)
+   FncDef(keyword,2)
+#endif					/* MultiThread */
diff --git a/src/h/features.h b/src/h/features.h
new file mode 100644
index 0000000..047b4df
--- /dev/null
+++ b/src/h/features.h
@@ -0,0 +1,77 @@
+/*
+ * features.h -- predefined symbols and &features
+ *
+ * This file consists entirely of a sequence of conditionalized calls
+ *  to the Feature() macro.  The macro is not defined here, but is
+ *  defined to different things by the the code that includes it.
+ *
+ * For the macro call  Feature(guard,symname,kwval)
+ * the parameters are:
+ *    guard	for the compiler's runtime system, an expression that must
+ *		evaluate as true for the feature to be included in &features
+ *    symname	predefined name in the preprocessor; "" if none
+ *    kwval	value produced by the &features keyword; 0 if none
+ *
+ * The translator and compiler modify this list of predefined symbols
+ * through calls to ppdef().
+ */
+
+   Feature(1, "_V9", 0)			/* Version 9 (unconditional) */
+
+#if MSWIN
+   Feature(1, "_MS_WINDOWS", "MS Windows")
+#endif					/* MSWIN */
+
+#if CYGWIN
+   Feature(1, "_CYGWIN", "Cygwin")
+#endif					/* CYGWIN */
+
+#if UNIX
+   Feature(1, "_UNIX", "UNIX")
+#endif					/* UNIX */
+
+   Feature(1, "_ASCII", "ASCII")
+
+#ifdef Coexpr
+   Feature(1, "_CO_EXPRESSIONS", "co-expressions")
+#endif					/* Coexpr */
+
+#ifdef LoadFunc
+   Feature(1, "_DYNAMIC_LOADING", "dynamic loading")
+#endif					/* LoadFunc */
+
+   Feature(1, "", "environment variables")
+
+#ifdef EventMon
+   Feature(1, "_EVENT_MONITOR", "event monitoring")
+#endif					/* EventMon */
+
+#ifdef ExternalFunctions
+   Feature(1, "_EXTERNAL_FUNCTIONS", "external functions")
+#endif					/* ExternalFunctions */
+
+#ifdef KeyboardFncs
+   Feature(1, "_KEYBOARD_FUNCTIONS", "keyboard functions")
+#endif					/* KeyboardFncs */
+
+#ifdef LargeInts
+   Feature(largeints, "_LARGE_INTEGERS", "large integers")
+#endif					/* LargeInts */
+
+#ifdef MultiThread
+   Feature(1, "_MULTITASKING", "multiple programs")
+#endif					/* MultiThread */
+
+#ifdef Pipes
+   Feature(1, "_PIPES", "pipes")
+#endif					/* Pipes */
+
+   Feature(1, "_SYSTEM_FUNCTION", "system function")
+
+#ifdef Graphics
+   Feature(1, "_GRAPHICS", "graphics")
+#endif					/* Graphics */
+
+#ifdef XWindows
+   Feature(1, "_X_WINDOW_SYSTEM", "X Windows")
+#endif					/* XWindows */
diff --git a/src/h/grammar.h b/src/h/grammar.h
new file mode 100644
index 0000000..3a49b9d
--- /dev/null
+++ b/src/h/grammar.h
@@ -0,0 +1,273 @@
+/*
+ * grammar.h -- Yacc grammar for Icon
+ *
+ * This file is combined with other files to make the Yacc input for
+ * building icont, iconc, and variant translators.
+ *
+ * Any modifications to this grammar will require corresponding changes to
+ * parserr.h, icont/tgrammar.c, iconc/cgrammar.c, and vtran/vtfiles/ident.c.
+ */
+
+program	: decls EOFX {Progend($1,$2);} ;
+
+decls	: ;
+	| decls decl ;
+
+decl	: record {Recdcl($1);} ;
+	| proc {Procdcl($1);} ;
+	| global {Globdcl($1);} ;
+	| link {Linkdcl($1);} ;
+        | invocable {Invocdcl($1);} ;
+
+invocable : INVOCABLE invoclist {Invocable($1, $2);} ;
+
+invoclist : invocop;
+	  | invoclist COMMA invocop {Invoclist($1,$2,$3);} ;
+
+invocop  : IDENT {Invocop1($1);} ;
+	 | STRINGLIT {Invocop2($1);} ;
+	 | STRINGLIT COLON INTLIT {Invocop3($1,$2,$3);} ;
+
+link	: LINK lnklist {Link($1, $2);} ;
+
+lnklist	: lnkfile ;
+	| lnklist COMMA lnkfile {Lnklist($1,$2,$3);} ;
+
+lnkfile	: IDENT {Lnkfile1($1);} ;
+	| STRINGLIT {Lnkfile2($1);} ;
+
+global	: GLOBAL {Global0($1);} idlist  {Global1($1, $2, $3);} ;
+
+record	: RECORD IDENT {Record1($1,$2);} LPAREN fldlist RPAREN {
+		Record2($1,$2,$3,$4,$5,$6);
+		} ;
+
+fldlist	: {Arglist1();} ;
+	| idlist {Arglist2($1);} ;
+
+proc	: prochead SEMICOL locals initial procbody END {
+		Proc1($1,$2,$3,$4,$5,$6);
+		} ;
+
+prochead: PROCEDURE IDENT {Prochead1($1,$2);} LPAREN arglist RPAREN {
+		Prochead2($1,$2,$3,$4,$5,$6);
+		} ;
+
+arglist	: {Arglist1();} ;
+	| idlist {Arglist2($1);} ;
+	| idlist LBRACK RBRACK {Arglist3($1,$2,$3);} ;
+
+
+idlist	: IDENT {
+		Ident($1);
+		} ;
+	| idlist COMMA IDENT {
+		Idlist($1,$2,$3);
+		} ;
+
+locals	: {Locals1();} ;
+	| locals retention idlist SEMICOL {Locals2($1,$2,$3,$4);} ;
+
+retention: LOCAL {Local($1);} ;
+	| STATIC {Static($1);} ;
+
+initial	: {Initial1();} ;
+	| INITIAL expr SEMICOL {Initial2($1,$2,$3);} ;
+
+procbody: {Procbody1();} ;
+	| nexpr SEMICOL procbody {Procbody2($1,$2,$3);} ;
+
+nexpr	: {Nexpr();} ;
+	| expr ;
+
+expr	: expr1a ;
+	| expr AND expr1a	{Bamper($1,$2,$3);} ;
+
+expr1a	: expr1 ;
+	| expr1a QMARK expr1	{Bques($1,$2,$3);} ;
+
+expr1	: expr2 ;
+	| expr2 SWAP expr1 {Bswap($1,$2,$3);} ;
+	| expr2 ASSIGN expr1 {Bassgn($1,$2,$3);} ;
+	| expr2 REVSWAP expr1 {Brswap($1,$2,$3);} ;
+	| expr2 REVASSIGN expr1 {Brassgn($1,$2,$3);} ;
+	| expr2 AUGCONCAT expr1 {Baugcat($1,$2,$3);} ;
+	| expr2 AUGLCONCAT expr1 {Bauglcat($1,$2,$3);} ;
+	| expr2 AUGDIFF expr1 {Bdiffa($1,$2,$3);} ;
+	| expr2 AUGUNION expr1 {Buniona($1,$2,$3);} ;
+	| expr2 AUGPLUS expr1 {Bplusa($1,$2,$3);} ;
+	| expr2 AUGMINUS expr1 {Bminusa($1,$2,$3);} ;
+	| expr2 AUGSTAR expr1 {Bstara($1,$2,$3);} ;
+	| expr2 AUGINTER expr1 {Bintera($1,$2,$3);} ;
+	| expr2 AUGSLASH expr1 {Bslasha($1,$2,$3);} ;
+	| expr2 AUGMOD expr1 {Bmoda($1,$2,$3);} ;
+	| expr2 AUGCARET expr1 {Bcareta($1,$2,$3);} ;
+	| expr2 AUGNMEQ expr1 {Baugeq($1,$2,$3);} ;
+	| expr2 AUGEQUIV expr1 {Baugeqv($1,$2,$3);} ;
+	| expr2 AUGNMGE expr1 {Baugge($1,$2,$3);} ;
+	| expr2 AUGNMGT expr1 {Bauggt($1,$2,$3);} ;
+	| expr2 AUGNMLE expr1 {Baugle($1,$2,$3);} ;
+	| expr2 AUGNMLT expr1 {Bauglt($1,$2,$3);} ;
+	| expr2 AUGNMNE expr1 {Baugne($1,$2,$3);} ;
+	| expr2 AUGNEQUIV expr1 {Baugneqv($1,$2,$3);} ;
+	| expr2 AUGSEQ expr1 {Baugseq($1,$2,$3);} ;
+	| expr2 AUGSGE expr1 {Baugsge($1,$2,$3);} ;
+	| expr2 AUGSGT expr1 {Baugsgt($1,$2,$3);} ;
+	| expr2 AUGSLE expr1 {Baugsle($1,$2,$3);} ;
+	| expr2 AUGSLT expr1 {Baugslt($1,$2,$3);} ;
+	| expr2 AUGSNE expr1 {Baugsne($1,$2,$3);} ;
+	| expr2 AUGQMARK expr1 {Baugques($1,$2,$3);} ;
+	| expr2 AUGAND expr1 {Baugamper($1,$2,$3);} ;
+	| expr2 AUGAT expr1 {Baugact($1,$2,$3);} ;
+
+expr2	: expr3 ;
+	| expr2 TO expr3 {To0($1,$2,$3);} ;
+	| expr2 TO expr3 BY expr3 {To1($1,$2,$3,$4,$5);} ;
+
+expr3	: expr4 ;
+	| expr4 BAR expr3 {Alt($1,$2,$3);} ;
+
+expr4	: expr5 ;
+	| expr4 SEQ expr5 {Bseq($1,$2,$3);} ;
+	| expr4 SGE expr5 {Bsge($1,$2,$3);} ;
+	| expr4 SGT expr5 {Bsgt($1,$2,$3);} ;
+	| expr4 SLE expr5 {Bsle($1,$2,$3);} ;
+	| expr4 SLT expr5 {Bslt($1,$2,$3);} ;
+	| expr4 SNE expr5 {Bsne($1,$2,$3);} ;
+	| expr4 NMEQ expr5 {Beq($1,$2,$3);} ;
+	| expr4 NMGE expr5 {Bge($1,$2,$3);} ;
+	| expr4 NMGT expr5 {Bgt($1,$2,$3);} ;
+	| expr4 NMLE expr5 {Ble($1,$2,$3);} ;
+	| expr4 NMLT expr5 {Blt($1,$2,$3);} ;
+	| expr4 NMNE expr5 {Bne($1,$2,$3);} ;
+	| expr4 EQUIV expr5 {Beqv($1,$2,$3);} ;
+	| expr4 NEQUIV expr5 {Bneqv($1,$2,$3);} ;
+
+expr5	: expr6 ;
+	| expr5 CONCAT expr6 {Bcat($1,$2,$3);} ;
+	| expr5 LCONCAT expr6 {Blcat($1,$2,$3);} ;
+
+expr6	: expr7 ;
+	| expr6 PLUS expr7 {Bplus($1,$2,$3);} ;
+	| expr6 DIFF expr7 {Bdiff($1,$2,$3);} ;
+	| expr6 UNION expr7 {Bunion($1,$2,$3);} ;
+	| expr6 MINUS expr7 {Bminus($1,$2,$3);} ;
+
+expr7	: expr8 ;
+	| expr7 STAR expr8 {Bstar($1,$2,$3);} ;
+	| expr7 INTER expr8 {Binter($1,$2,$3);} ;
+	| expr7 SLASH expr8 {Bslash($1,$2,$3);} ;
+	| expr7 MOD expr8 {Bmod($1,$2,$3);} ;
+
+expr8	: expr9 ;
+	| expr9 CARET expr8 {Bcaret($1,$2,$3);} ;
+
+expr9	: expr10 ;
+	| expr9 BACKSLASH expr10 {Blim($1,$2,$3);} ;
+	| expr9 AT expr10 {Bact($1,$2,$3);};
+	| expr9 BANG expr10 {Apply($1,$2,$3);};
+
+expr10	: expr11 ;
+	| AT expr10 {Uat($1,$2);} ;
+	| NOT expr10 {Unot($1,$2);} ;
+	| BAR expr10 {Ubar($1,$2);} ;
+	| CONCAT expr10 {Uconcat($1,$2);} ;
+	| LCONCAT expr10 {Ulconcat($1,$2);} ;
+	| DOT expr10 {Udot($1,$2);} ;
+	| BANG expr10 {Ubang($1,$2);} ;
+	| DIFF expr10 {Udiff($1,$2);} ;
+	| PLUS expr10 {Uplus($1,$2);} ;
+	| STAR expr10 {Ustar($1,$2);} ;
+	| SLASH expr10 {Uslash($1,$2);} ;
+	| CARET expr10 {Ucaret($1,$2);} ;
+	| INTER expr10 {Uinter($1,$2);} ;
+	| TILDE expr10 {Utilde($1,$2);} ;
+	| MINUS expr10 {Uminus($1,$2);} ;
+	| NMEQ expr10 {Unumeq($1,$2);} ;
+	| NMNE expr10 {Unumne($1,$2);} ;
+	| SEQ expr10 {Ulexeq($1,$2);} ;
+	| SNE expr10 {Ulexne($1,$2);} ;
+	| EQUIV expr10 {Uequiv($1,$2);} ;
+	| UNION expr10 {Uunion($1,$2);} ;
+	| QMARK expr10 {Uqmark($1,$2);} ;
+	| NEQUIV expr10 {Unotequiv($1,$2);} ;
+	| BACKSLASH expr10 {Ubackslash($1,$2);} ;
+
+expr11	: literal ;
+	| section ;
+	| return ;
+	| if ;
+	| case ;
+	| while ;
+	| until ;
+	| every ;
+	| repeat ;
+	| CREATE expr {Create($1,$2);} ;
+	| IDENT {Var($1);} ;
+	| NEXT {Next($1);} ;
+	| BREAK nexpr {Break($1,$2);} ;
+	| LPAREN exprlist RPAREN {Paren($1,$2,$3);} ;
+	| LBRACE compound RBRACE {Brace($1,$2,$3);} ;
+	| LBRACK exprlist RBRACK {Brack($1,$2,$3);} ;
+	| expr11 LBRACK exprlist RBRACK {Subscript($1,$2,$3,$4);} ;
+	| expr11 LBRACE	RBRACE {Pdco0($1,$2,$3);} ;
+	| expr11 LBRACE pdcolist RBRACE {Pdco1($1,$2,$3,$4);} ;
+	| expr11 LPAREN exprlist RPAREN {Invoke($1,$2,$3,$4);} ;
+	| expr11 DOT IDENT {Field($1,$2,$3);} ;
+	| AND FAIL {Kfail($1,$2);} ;
+	| AND IDENT {Keyword($1,$2);} ;
+
+while	: WHILE expr {While0($1,$2);} ;
+	| WHILE expr DO expr {While1($1,$2,$3,$4);} ;
+
+until	: UNTIL expr {Until0($1,$2);} ;
+	| UNTIL expr DO expr {Until1($1,$2,$3,$4);} ;
+
+every	: EVERY expr {Every0($1,$2);} ;
+	| EVERY expr DO expr {Every1($1,$2,$3,$4);} ;
+
+repeat	: REPEAT expr {Repeat($1,$2);} ;
+
+return	: FAIL {Fail($1);} ;
+	| RETURN nexpr {Return($1,$2);} ;
+	| SUSPEND nexpr {Suspend0($1,$2);} ;
+        | SUSPEND expr DO expr {Suspend1($1,$2,$3,$4);};
+
+if	: IF expr THEN expr {If0($1,$2,$3,$4);} ;
+	| IF expr THEN expr ELSE expr {If1($1,$2,$3,$4,$5,$6);} ;
+
+case	: CASE expr OF LBRACE caselist RBRACE {Case($1,$2,$3,$4,$5,$6);} ;
+
+caselist: cclause ;
+	| caselist SEMICOL cclause {Caselist($1,$2,$3);} ;
+
+cclause	: DEFAULT COLON expr {Cclause0($1,$2,$3);} ;
+	| expr COLON expr {Cclause1($1,$2,$3);} ;
+
+exprlist: nexpr                {Elst0($1);}
+	| exprlist COMMA nexpr {Elst1($1,$2,$3);} ;
+
+pdcolist: nexpr {
+		Pdcolist0($1);
+		} ;
+	| pdcolist COMMA nexpr {
+		Pdcolist1($1,$2,$3);
+		} ;
+
+literal	: INTLIT {Iliter($1);} ;
+	| REALLIT {Rliter($1);} ;
+	| STRINGLIT {Sliter($1);} ;
+	| CSETLIT {Cliter($1);} ;
+
+section	: expr11 LBRACK expr sectop expr RBRACK {Section($1,$2,$3,$4,$5,$6);} ;
+
+sectop	: COLON {Colon($1);} ;
+	| PCOLON {Pcolon($1);} ;
+	| MCOLON {Mcolon($1);} ;
+
+compound: nexpr ;
+	| nexpr SEMICOL compound {Compound($1,$2,$3);} ;
+
+program	: error decls EOFX ;
+proc	: prochead error procbody END ;
+expr	: error ;
diff --git a/src/h/graphics.h b/src/h/graphics.h
new file mode 100644
index 0000000..fa56f79
--- /dev/null
+++ b/src/h/graphics.h
@@ -0,0 +1,447 @@
+/*
+ * graphics.h - macros and types used in Icon's graphics interface.
+ */
+
+#ifdef XWindows
+   #include "../h/xwin.h"
+#endif					/* XWindows */
+
+#ifdef WinGraphics
+   #include "../h/mswin.h"
+#endif					/* WinGraphics */
+
+#ifndef MAXXOBJS
+   #define MAXXOBJS 256
+#endif					/* MAXXOBJS */
+
+#ifndef MAXCOLORNAME
+   #define MAXCOLORNAME 40
+#endif					/* MAXCOLORNAME */
+
+#ifndef MAXFONTWORD
+   #define MAXFONTWORD 40
+#endif					/* MAXFONTWORD */
+
+#define POLLSLEEP	20	 /* milliseconds sleep while awaiting event */
+
+#define DEFAULTFONTSIZE 14
+
+#define FONTATT_SPACING		0x01000000
+#define FONTFLAG_MONO		0x00000001
+#define FONTFLAG_PROPORTIONAL	0x00000002
+
+#define FONTATT_SERIF		0x02000000
+#define FONTFLAG_SANS		0x00000004
+#define FONTFLAG_SERIF		0x00000008
+
+#define FONTATT_SLANT		0x04000000
+#define FONTFLAG_ROMAN		0x00000010
+#define FONTFLAG_ITALIC		0x00000020
+#define FONTFLAG_OBLIQUE	0x00000040
+
+#define FONTATT_WEIGHT		0x08000000
+#define FONTFLAG_LIGHT		0x00000100
+#define FONTFLAG_MEDIUM		0x00000200
+#define FONTFLAG_DEMI		0x00000400
+#define FONTFLAG_BOLD		0x00000800
+
+#define FONTATT_WIDTH		0x10000000
+#define FONTFLAG_CONDENSED	0x00001000
+#define FONTFLAG_NARROW		0x00002000
+#define FONTFLAG_NORMAL		0x00004000
+#define FONTFLAG_WIDE		0x00008000
+#define FONTFLAG_EXTENDED	0x00010000
+
+/*
+ * EVENT HANDLING
+ *
+ * Each window keeps an associated queue of events waiting to be
+ * processed.  The queue consists of <eventcode,x,y> triples,
+ * where eventcodes are strings for normal keyboard events, and
+ * integers for mouse and special keystroke events.
+ *
+ * The main queue is an icon list.  In addition, there is a queue of
+ * old keystrokes maintained for cooked mode operations, maintained
+ * in a little circular array of chars.
+ */
+#define EQ_MOD_CONTROL (1L<<16L)
+#define EQ_MOD_META    (1L<<17L)
+#define EQ_MOD_SHIFT   (1L<<18L)
+
+#define EVQUESUB(w,i) *evquesub(w,i)
+#define EQUEUELEN 256
+
+/*
+ * mode bits for the Icon window context (as opposed to X context)
+ */
+
+#define ISINITIAL(w)    ((w)->window->bits & 1)
+#define ISINITIALW(ws)  ((ws)->bits & 1)
+#define ISCURSORON(w)   ((w)->window->bits & 2)
+#define ISCURSORONW(ws) ((ws->bits) & 2)
+#define ISMAPPED(w)	((w)->window->bits & 4)
+#define ISREVERSE(w)    ((w)->context->bits & 8)
+#define ISXORREVERSE(w)	((w)->context->bits & 16)
+#define ISXORREVERSEW(w) ((w)->bits & 16)
+#define ISCLOSED(w)	((w)->window->bits & 64)
+#define ISRESIZABLE(w)	((w)->window->bits & 128)
+#define ISEXPOSED(w)    ((w)->window->bits & 256)
+#define ISCEOLON(w)     ((w)->window->bits & 512)
+#define ISECHOON(w)     ((w)->window->bits & 1024)
+
+#define SETCURSORON(w)  ((w)->window->bits |= 2)
+/* 4 is available */
+#define SETMAPPED(w)   ((w)->window->bits |= 4)
+#define SETREVERSE(w)   ((w)->context->bits |= 8)
+#define SETXORREVERSE(w) ((w)->context->bits |= 16)
+#define SETCLOSED(w)	((w)->window->bits |= 64)
+#define SETRESIZABLE(w)	((w)->window->bits |= 128)
+#define SETEXPOSED(w)   ((w)->window->bits |= 256)
+#define SETCEOLON(w)    ((w)->window->bits |= 512)
+#define SETECHOON(w)    ((w)->window->bits |= 1024)
+
+#define CLRCURSORON(w)  ((w)->window->bits &= ~2)
+#define CLRMAPPED(w)    ((w)->window->bits &= ~4)
+#define CLRREVERSE(w)   ((w)->context->bits &= ~8)
+#define CLRXORREVERSE(w) ((w)->context->bits &= ~16)
+#define CLRCLOSED(w)	((w)->window->bits &= ~64)
+#define CLRRESIZABLE(w)	((w)->window->bits &= ~128)
+#define CLREXPOSED(w)   ((w)->window->bits &= ~256)
+#define CLRCEOLON(w)    ((w)->window->bits &= ~512)
+#define CLRECHOON(w)    ((w)->window->bits &= ~1024)
+
+#ifdef XWindows
+   #define ISZOMBIE(w)     ((w)->window->bits & 1)
+   #define SETZOMBIE(w)    ((w)->window->bits |= 1)
+   #define CLRZOMBIE(w)    ((w)->window->bits &= ~1)
+#endif					/* XWindows */
+
+#ifdef WinGraphics
+   #define ISTOBEHIDDEN(ws)  ((ws)->bits & 4096)
+   #define SETTOBEHIDDEN(ws) ((ws)->bits |= 4096)
+   #define CLRTOBEHIDDEN(ws) ((ws)->bits &= ~4096)
+#endif					/* WinGraphics */
+
+/*
+ * Window Resources
+ * Icon "Resources" are a layer on top of the window system resources,
+ * provided in order to facilitate resource sharing and minimize the
+ * number of calls to the window system.  Resources are reference counted.
+ * These data structures are simple sets of pointers
+ * into internal window system structures.
+ */
+
+/*
+ * Fonts are allocated within displays.
+ */
+typedef struct _wfont {
+   int		refcount;
+   int		serial;			/* serial # */
+   struct _wfont *previous, *next;
+   char		*name;			/* name for WAttrib and fontsearch */
+
+   #ifdef XWindows
+      int	height;			/* font height */
+      XFontStruct *fsp;			/* X font pointer */
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      HFONT	font;
+      LONG	ascent;
+      LONG	descent;
+      LONG	charwidth;
+      LONG	height;
+   #endif				/* WinGraphics */
+
+   } wfont, *wfp;
+
+/*
+ * These structures and definitions are used for colors and images.
+ */
+typedef struct {
+   long red, green, blue;		/* color components, linear 0 - 65535*/
+   } LinearColor;
+
+struct palentry {			/* entry for one palette member */
+   LinearColor clr;			/* RGB value of color */
+   char used;				/* nonzero if char is used */
+   char valid;				/* nonzero if entry is valid & opaque */
+   char transpt;			/* nonzero if char is transparent */
+   };
+
+struct imgdata {			/* image loaded from a file */
+   int width, height;			/* image dimensions */
+   struct palentry *paltbl;		/* pointer to palette table */
+   unsigned char *data;			/* pointer to image data */
+   };
+
+struct imgmem {
+   int x, y, width, height;
+
+   #ifdef XWindows
+      XImage *im;
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      COLORREF *crp;
+   #endif				/* WinGraphics */
+   };
+
+#define TCH1 '~'			/* usual transparent character */
+#define TCH2 0377			/* alternate transparent character */
+#define PCH1 ' '			/* punctuation character */
+#define PCH2 ','			/* punctuation character */
+
+#define GIFMAX 256			/* maximum colors in a GIF file */
+
+#ifdef XWindows
+/*
+ * Displays are maintained in a global list in rwinrsc.r.
+ */
+typedef struct _wdisplay {
+   int		refcount;
+   int		serial;			/* serial # */
+   char		name[MAXDISPLAYNAME];
+   Display *	display;
+   Visual *	visual;
+   GC		icongc;
+   Colormap	cmap;
+   double	gamma;
+   int		screen;
+   int		numFonts;
+   wfp		fonts;
+   int          numColors;		/* number of allocated color structs */
+   int          cpSize;			/* max number of slots before realloc */
+   struct wcolor **colrptrs;		/* array of pointers to those colors */
+   Cursor	cursors[NUMCURSORSYMS];
+   struct _wdisplay *previous, *next;
+   } *wdp;
+#endif					/* XWindows */
+
+/*
+ * "Context" comprises the graphics context, and the font (i.e. text context).
+ * Foreground and background colors (pointers into the display color table)
+ * are stored here to reduce the number of window system queries.
+ * Contexts are allocated out of a global array in rwinrsrc.c.
+ */
+typedef struct _wcontext {
+   int		refcount;
+   int		serial;			/* serial # */
+   struct _wcontext *previous, *next;
+   int		clipx, clipy, clipw, cliph;
+   char		*patternname;
+   wfp		font;
+   int		dx, dy;
+   int		fillstyle;
+   int		drawop;
+   double	gamma;			/* gamma correction value */
+   int		bits;			/* context bits */
+
+   #ifdef XWindows
+      wdp	display;
+      GC	gc;			/* X graphics context */
+      wclrp	fg, bg;
+      int	linestyle;
+      int	linewidth;
+      int	leading;		/* inter-line leading */
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      LOGPEN	pen;
+      LOGPEN	bgpen;
+      LOGBRUSH	brush;
+      LOGBRUSH	bgbrush;
+      HRGN	cliprgn;
+      HBITMAP	pattern;
+      SysColor	fg, bg;
+      char	*fgname, *bgname;
+      int	leading, bkmode;
+   #endif				/* WinGraphics*/
+
+   } wcontext, *wcp;
+
+/*
+ * Native facilities include the following child controls (windows) that
+ * persist on the canvas and intercept various events.
+ */
+#ifdef WinGraphics
+   #define CHILD_BUTTON 0
+   #define CHILD_SCROLLBAR 1
+   #define CHILD_EDIT 2
+   typedef struct childcontrol {
+      int  type;			/* what kind of control? */
+      HWND win;				/* child window handle */
+      HFONT font;
+      char *id;				/* child window string id */
+      } childcontrol;
+#endif					/* WinGraphics */
+
+/*
+ * "Window state" includes the actual X window and references to a large
+ * number of resources allocated on a per-window basis.  Windows are
+ * allocated out of a global array in rwinrsrc.c.  Windows remember the
+ * first WMAXCOLORS colors they allocate, and deallocate them on clearscreen.
+ */
+typedef struct _wstate {
+   int		refcount;		/* reference count */
+   int		serial;			/* serial # */
+   struct _wstate *previous, *next;
+   int		pixheight;		/* backing pixmap height, in pixels */
+   int		pixwidth;		/* pixmap width, in pixels */
+   char		*windowlabel;		/* window label */
+   char		*iconimage;		/* icon pixmap file name */
+   char		*iconlabel;		/* icon label */
+   struct imgdata initimage;		/* initial image data */
+   struct imgdata initicon;		/* initial icon image data */
+   int		y, x;			/* current cursor location, in pixels*/
+   int		pointery, pointerx;	/* current mouse location, in pixels */
+   int		posy, posx;		/* desired upper lefthand corner */
+   unsigned int	height;			/* window height, in pixels */
+   unsigned int	width;			/* window width, in pixels */
+   int		bits;			/* window bits */
+   int		theCursor;		/* index into cursor table */
+   word		timestamp;		/* last event time stamp */
+   char		eventQueue[EQUEUELEN];  /* queue of cooked-mode keystrokes */
+   int		eQfront, eQback;
+   char		*cursorname;
+   struct descrip filep, listp;		/* icon values for this window */
+
+   #ifdef XWindows
+      wdp	display;
+      Window	win;			/* X window */
+      Pixmap	pix;			/* current screen state */
+      Pixmap	initialPix;		/* an initial image to display */
+      Window	iconwin;		/* icon window */
+      Pixmap	iconpix;		/* icon pixmap */
+      int	normalx, normaly;	/* pos to remember when maximized */
+      int	normalw, normalh;	/* size to remember when maximized */
+      int	numColors;		/* allocated color info */
+      short	*theColors;		/* indices into display color table */
+      int	numiColors;		/* allocated color info for the icon */
+      short	*iconColors;		/* indices into display color table */
+      int	iconic;			/* window state; icon, window or root*/
+      int	iconx, icony;		/* location of icon */
+      unsigned int iconw, iconh;	/* width and height of icon */
+      long	wmhintflags;		/* window manager hints */
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      HWND	win;			/* client window */
+      HWND	iconwin;		/* client window when iconic */
+      HBITMAP	pix;			/* backing bitmap */
+      HBITMAP	iconpix;		/* backing bitmap */
+      HBITMAP	initialPix;		/* backing bitmap */
+      HBITMAP	theOldPix;
+      int	hasCaret;
+      HCURSOR	curcursor;
+      HCURSOR	savedcursor;
+      HMENU	menuBar;
+      int	nmMapElems;
+      char **	menuMap;
+      HWND	focusChild;
+      int	nChildren;
+      childcontrol *child;
+   #endif				/* WinGraphics */
+
+   } wstate, *wsp;
+
+/*
+ * Icon window file variables are actually pointers to "bindings"
+ * of a window and a context.  They are allocated out of a global
+ * array in rwinrsrc.c.  There is one binding per Icon window value.
+ */
+typedef struct _wbinding {
+   int refcount;
+   int serial;
+   struct _wbinding *previous, *next;
+   wcp context;
+   wsp window;
+   } wbinding, *wbp;
+
+/*
+ * Table entry for string <-> integer mapping.
+ */
+typedef struct {
+   char *s;
+   int i;
+   } stringint, *siptr;
+
+
+/*
+ * Gamma Correction value to compensate for nonlinear monitor color response
+ */
+#ifndef GammaCorrection
+   #define GammaCorrection 2.5
+#endif					/* GammaCorrection */
+
+/*
+ * Attributes
+ */
+#define A_ASCENT	1
+#define A_BG		2
+#define A_CANVAS	3
+#define A_CEOL		4
+#define A_CLIPH		5
+#define A_CLIPW		6
+#define A_CLIPX		7
+#define A_CLIPY		8
+#define A_COL		9
+#define A_COLUMNS	10
+#define A_CURSOR	11
+#define A_DEPTH		12
+#define A_DESCENT	13
+#define A_DISPLAY	14
+#define A_DISPLAYHEIGHT	15
+#define A_DISPLAYWIDTH	16
+#define A_DRAWOP	17
+#define A_DX		18
+#define A_DY		19
+#define A_ECHO		20
+#define A_FG		21
+#define A_FHEIGHT	22
+#define A_FILLSTYLE	23
+#define A_FONT		24
+#define A_FWIDTH	25
+#define A_GAMMA		26
+#define A_GEOMETRY	27
+#define A_HEIGHT	28
+#define A_ICONIC	29
+#define A_ICONIMAGE     30
+#define A_ICONLABEL	31
+#define A_ICONPOS	32
+#define A_IMAGE		33
+#define A_LABEL		34
+#define A_LEADING	35
+#define A_LINES		36
+#define A_LINESTYLE	37
+#define A_LINEWIDTH	38
+#define A_PATTERN	39
+#define A_POINTERCOL	40
+#define A_POINTERROW	41
+#define A_POINTERX	42
+#define A_POINTERY	43
+#define A_POINTER	44
+#define A_POS		45
+#define A_POSX		46
+#define A_POSY		47
+#define A_RESIZE	48
+#define A_REVERSE	49
+#define A_ROW		50
+#define A_ROWS		51
+#define A_SIZE		52
+#define A_VISUAL	53
+#define A_WIDTH		54
+#define A_WINDOWLABEL   55
+#define A_X		56
+#define A_Y		57
+
+#define NUMATTRIBS	57
+
+/*
+ * flags for ConsoleFlags
+ */
+/* I/O redirection flags */
+#define StdOutRedirect        1
+#define StdErrRedirect        2
+#define StdInRedirect         4
+#define OutputToBuf           8
diff --git a/src/h/grttin.h b/src/h/grttin.h
new file mode 100644
index 0000000..1247ca2
--- /dev/null
+++ b/src/h/grttin.h
@@ -0,0 +1,278 @@
+/*
+ * Group of include files for input to rtt.
+ *   rtt reads these files for preprocessor directives and typedefs, but
+ *   does not output any code from them.
+ */
+#include "../h/define.h"
+#include "../h/arch.h"
+#include "../h/config.h"
+#include "../h/version.h"
+
+#ifndef NoTypeDefs
+   #include "../h/typedefs.h"
+#endif					/* NoTypeDefs */
+
+/*
+ * Macros that must be expanded by rtt.
+ */
+
+/*
+ * Declaration for library routine.
+ */
+#begdef LibDcl(nm,n,pn)
+   #passthru OpBlock(nm,n,pn,0)
+
+   int O##nm(nargs,cargp)
+   int nargs;
+   register dptr cargp;
+#enddef					/* LibDcl */
+
+/*
+ * Error exit from non top-level routines. Set tentative values for
+ *   error number and error value; these errors will but put in
+ *   effect if the run-time error routine is called.
+ */
+#begdef ReturnErrVal(err_num, offending_val, ret_val)
+   do {
+   t_errornumber = err_num;
+   t_errorvalue = offending_val;
+   t_have_val = 1;
+   return ret_val;
+   } while (0)
+#enddef					/* ReturnErrVal */
+
+#begdef ReturnErrNum(err_num, ret_val)
+   do {
+   t_errornumber = err_num;
+   t_errorvalue = nulldesc;
+   t_have_val = 0;
+   return ret_val;
+   } while (0)
+#enddef					/* ReturnErrNum */
+
+/*
+ * Code expansions for exits from C code for top-level routines.
+ */
+#define Fail		return A_Resume
+#define Return		return A_Continue
+
+/*
+ * RunErr encapsulates a call to the function err_msg, followed
+ *  by Fail.  The idea is to avoid the problem of calling
+ *  runerr directly and forgetting that it may actually return.
+ */
+
+#define RunErr(n,dp) do {\
+   err_msg((int)n,dp);\
+   Fail;\
+   } while (0)
+
+/*
+ * Protection macro.
+ */
+#define Protect(notnull,orelse) do {if ((notnull)==NULL) orelse;} while(0)
+
+#ifdef EventMon
+/*
+ * perform what amounts to "function inlining" of EVVal
+ */
+#begdef EVVal(value,event)
+   do {
+      if (is:null(curpstate->eventmask)) break;
+      else if (!Testb((word)event, curpstate->eventmask)) break;
+      MakeInt(value, &(curpstate->parent->eventval));
+      actparent(event);
+   } while (0)
+#enddef					/* EVVal */
+#begdef EVValD(dp,event)
+   do {
+      if (is:null(curpstate->eventmask)) break;
+      else if (!Testb((word)event, curpstate->eventmask)) break;
+      curpstate->parent->eventval = *(dp);
+      actparent(event);
+   } while (0)
+#enddef					/* EVValD */
+#begdef EVValX(bp,event)
+   do {
+      struct progstate *parent = curpstate->parent;
+      if (is:null(curpstate->eventmask)) break;
+      else if (!Testb((word)event, curpstate->eventmask)) break;
+      parent->eventval.dword = D_Coexpr;
+      BlkLoc(parent->eventval) = (union block *)(bp);
+      actparent(event);
+   } while (0)
+#enddef					/* EVValX */
+
+#define InterpEVVal(arg1,arg2)  { ExInterp; EVVal(arg1,arg2); EntInterp; }
+#define InterpEVValD(arg1,arg2) { ExInterp; EVValD(arg1,arg2); EntInterp; }
+#define InterpEVValX(arg1,arg2) { ExInterp; EVValX(arg1,arg2); EntInterp; }
+
+/*
+ * Macro with construction of event descriptor.
+ */
+
+#begdef Desc_EVValD(bp, code, type)
+   do {
+   eventdesc.dword = type;
+   eventdesc.vword.bptr = (union block *)(bp);
+   EVValD(&eventdesc, code);
+   } while (0)
+#enddef					/* Desc_EVValD */
+
+#else					/* EventMon */
+   #define EVVal(arg1,arg2)
+   #define EVValD(arg1,arg2)
+   #define EVValX(arg1,arg2)
+   #define InterpEVVal(arg1,arg2)
+   #define InterpEVValD(arg1,arg2)
+   #define InterpEVValX(arg1,arg2)
+   #define Desc_EVValD(bp, code, type)
+#endif					/* EventMon */
+
+/*
+ * dummy typedefs for things defined in #include files
+ */
+typedef int clock_t, time_t, fd_set;
+
+#ifdef ReadDirectory
+   typedef int DIR;
+#endif					/* ReadDirectory */
+
+/*
+ * graphics
+ */
+#ifdef Graphics
+   typedef int wbp, wsp, wcp, wdp, wclrp, wfp;
+   typedef int wbinding, wstate, wcontext, wfont;
+   typedef int siptr, stringint;
+   typedef int XRectangle, XPoint, XSegment, XArc, SysColor, LinearColor;
+   typedef int LONG, SHORT;
+
+   #ifdef XWindows
+      typedef int Atom, Time, XSelectionEvent, XErrorEvent, XErrorHandler;
+      typedef int XGCValues, XColor, XFontStruct, XWindowAttributes, XEvent;
+      typedef int XExposeEvent, XKeyEvent, XButtonEvent, XConfigureEvent;
+      typedef int XSizeHints, XWMHints, XClassHint, XTextProperty;
+      typedef int Colormap, XVisualInfo, va_list;
+      typedef int *Display, Cursor, GC, Window, Pixmap, Visual, KeySym;
+      typedef int WidgetClass, XImage, XpmAttributes;
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      typedef int clock_t, jmp_buf, MINMAXINFO, OSVERSIONINFO, BOOL_CALLBACK;
+      typedef int int_PASCAL, LRESULT_CALLBACK, MSG, BYTE, WORD, DWORD;
+      typedef int HINSTANCE, LPSTR, HBITMAP, WNDCLASS, PAINTSTRUCT, POINT, RECT;
+      typedef int HWND, HDC, UINT, WPARAM, LPARAM, HANDLE, HPEN, HBRUSH, SIZE;
+      typedef int COLORREF, HFONT, LOGFONT, TEXTMETRIC, FONTENUMPROC, FARPROC;
+      typedef int LOGPALETTE, HPALETTE, PALETTEENTRY, HCURSOR, BITMAP, HDIB;
+      typedef int va_list, LOGPEN, LOGBRUSH, LPVOID, MCI_PLAY_PARMS;
+      typedef int MCI_OPEN_PARMS, MCI_STATUS_PARMS, MCI_SEQ_SET_PARMS;
+      typedef int CHOOSEFONT, CHOOSECOLOR, OPENFILENAME, HMENU, LPBITMAPINFO;
+      typedef int childcontrol, CPINFO, BITMAPINFO, BITMAPINFOHEADER, RGBQUAD;
+      typedef int BOOL, LPMSG, STARTUPINFO;
+   #endif				/* WinGraphics */
+
+   /*
+    * Convenience macros to make up for RTL's long-windedness.
+    */
+   #begdef CnvCShort(desc, s)
+      {
+      C_integer tmp;
+      if (!cnv:C_integer(desc,tmp) || tmp > 0x7FFF || tmp < -0x8000)
+         runerr(101,desc);
+      s = (short) tmp;
+      }
+   #enddef				/* CnvCShort */
+
+   #define CnvCInteger(d,i) \
+      if (!cnv:C_integer(d,i)) runerr(101,d);
+
+   #define DefCInteger(d,default,i) \
+      if (!def:C_integer(d,default,i)) runerr(101,d);
+
+   #define CnvString(din,dout) \
+      if (!cnv:string(din,dout)) runerr(103,din);
+
+   #define CnvTmpString(din,dout) \
+      if (!cnv:tmp_string(din,dout)) runerr(103,din);
+
+   /*
+    * conventions supporting optional initial window arguments:
+    *
+    * All routines declare argv[argc] as their parameters
+    * Macro OptWindow checks argv[0] and assigns _w_ and warg if it is a window
+    * warg serves as a base index and is added everywhere argv is indexed
+    * n is used to denote the actual number of "objects" in the call
+    * Macro ReturnWindow returns either the initial window argument, or &window
+    */
+   #begdef OptWindow(w)
+      if (argc>warg && is:file(argv[warg])) {
+         if ((BlkLoc(argv[warg])->file.status & Fs_Window) == 0)
+            runerr(140,argv[warg]);
+         if ((BlkLoc(argv[warg])->file.status & (Fs_Read|Fs_Write)) == 0)
+            runerr(142,argv[warg]);
+         (w) = (wbp)BlkLoc(argv[warg])->file.fd;
+         if (ISCLOSED(w))
+            runerr(142,argv[warg]);
+         warg++;
+         }
+      else {
+         if (!(is:file(kywd_xwin[XKey_Window]) &&
+            (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window)))
+               runerr(140,kywd_xwin[XKey_Window]);
+         if (!(BlkLoc(kywd_xwin[XKey_Window])->file.status&(Fs_Read|Fs_Write)))
+            runerr(142,kywd_xwin[XKey_Window]);
+         (w) = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;
+         if (ISCLOSED(w))
+            runerr(142,kywd_xwin[XKey_Window]);
+         }
+   #enddef				/* OptWindow */
+
+   #begdef ReturnWindow
+         if (!warg) return kywd_xwin[XKey_Window];
+         else return argv[0]
+   #enddef				/* ReturnWindow */
+
+   #begdef CheckArgMultiple(mult)
+      {
+      if ((argc-warg) % (mult)) runerr(146);
+      n = (argc-warg)/mult;
+      if (!n) runerr(146);
+      }
+   #enddef				/* CheckArgMultiple */
+
+   /*
+    * calloc to make sure uninit'd entries are zeroed.
+    */
+   #begdef GRFX_ALLOC(var,type)
+      do {
+         var = (struct type *)calloc(1, sizeof(struct type));
+         if (var == NULL) ReturnErrNum(305, NULL);
+         var->refcount = 1;
+      } while(0)
+   #enddef				/* GRFX_ALLOC */
+
+   #begdef GRFX_LINK(var, chain)
+      do {
+         var->next = chain;
+         var->previous = NULL;
+         if (chain) chain->previous = var;
+         chain = var;
+      } while(0)
+   #enddef				/* GRFX_LINK */
+
+   #begdef GRFX_UNLINK(var, chain)
+      do {
+         if (var->previous) var->previous->next = var->next;
+         else chain = var->next;
+         if (var->next) var->next->previous = var->previous;
+         free(var);
+      } while(0)
+   #enddef				/* GRFX_UNLINK */
+
+#endif					/* Graphics */
+
+#ifdef FAttrib
+   typedef unsigned long mode_t;
+   typedef int HFILE, OFSTRUCT, FILETIME, SYSTEMTIME;
+#endif					/* FAttrib */
diff --git a/src/h/gsupport.h b/src/h/gsupport.h
new file mode 100644
index 0000000..d56f1d0
--- /dev/null
+++ b/src/h/gsupport.h
@@ -0,0 +1,13 @@
+/*
+ * Group of include files for translators, etc.
+ */
+
+#include "../h/define.h"
+
+#include "../h/arch.h"
+#include "../h/config.h"
+#include "../h/sys.h"
+#include "../h/typedefs.h"
+#include "../h/cstructs.h"
+#include "../h/mproto.h"
+#include "../h/cpuconf.h"
diff --git a/src/h/header.h b/src/h/header.h
new file mode 100644
index 0000000..3b131f1
--- /dev/null
+++ b/src/h/header.h
@@ -0,0 +1,28 @@
+/*
+ * Interpreter code file header - this is written at the start of
+ *  an icode file after the start-up program.
+ */
+struct header {
+   word hsize;			/* size of interpreter code */
+   word trace;			/* initial value of &trace */
+
+   word Records;
+   word Ftab;			/* location of record/field table */
+   word Fnames;			/* location of names of fields */
+   word Globals;		/* location of global variables */
+   word Gnames;			/* location of names of globals */
+   word Statics;		/* location of static variables */
+   word Strcons;		/* location of identifier table */
+   word Filenms;		/* location of ipc/file name table */
+
+   #ifdef FieldTableCompression
+      short FtabWidth;		/* width of field table entries, 1 | 2 | 4 */
+      short FoffWidth;		/* width of field offset entries, 1 | 2 | 4 */
+      word Nfields;		/* number of field names */
+      word Fo;			/* The start of the Fo array */
+      word Bm;			/* The start of the Bm array */
+   #endif				/* FieldTableCompression */
+
+   word linenums;		/* location of ipc/line number table */
+   word config[16];		/* icode version */
+   };
diff --git a/src/h/kdefs.h b/src/h/kdefs.h
new file mode 100644
index 0000000..752841f
--- /dev/null
+++ b/src/h/kdefs.h
@@ -0,0 +1,70 @@
+/*
+ * ../h/kdefs.h -- Keyword list.
+ *
+ * Created mechanically by mkkwd.icn -- DO NOT EDIT.
+ */
+
+KDef(allocated,K_ALLOCATED)
+KDef(ascii,K_ASCII)
+KDef(clock,K_CLOCK)
+KDef(col,K_COL)
+KDef(collections,K_COLLECTIONS)
+KDef(column,K_COLUMN)
+KDef(control,K_CONTROL)
+KDef(cset,K_CSET)
+KDef(current,K_CURRENT)
+KDef(date,K_DATE)
+KDef(dateline,K_DATELINE)
+KDef(digits,K_DIGITS)
+KDef(dump,K_DUMP)
+KDef(e,K_E)
+KDef(error,K_ERROR)
+KDef(errornumber,K_ERRORNUMBER)
+KDef(errortext,K_ERRORTEXT)
+KDef(errorvalue,K_ERRORVALUE)
+KDef(errout,K_ERROUT)
+KDef(eventcode,K_EVENTCODE)
+KDef(eventsource,K_EVENTSOURCE)
+KDef(eventvalue,K_EVENTVALUE)
+KDef(fail,K_FAIL)
+KDef(features,K_FEATURES)
+KDef(file,K_FILE)
+KDef(host,K_HOST)
+KDef(input,K_INPUT)
+KDef(interval,K_INTERVAL)
+KDef(lcase,K_LCASE)
+KDef(ldrag,K_LDRAG)
+KDef(letters,K_LETTERS)
+KDef(level,K_LEVEL)
+KDef(line,K_LINE)
+KDef(lpress,K_LPRESS)
+KDef(lrelease,K_LRELEASE)
+KDef(main,K_MAIN)
+KDef(mdrag,K_MDRAG)
+KDef(meta,K_META)
+KDef(mpress,K_MPRESS)
+KDef(mrelease,K_MRELEASE)
+KDef(null,K_NULL)
+KDef(output,K_OUTPUT)
+KDef(phi,K_PHI)
+KDef(pi,K_PI)
+KDef(pos,K_POS)
+KDef(progname,K_PROGNAME)
+KDef(random,K_RANDOM)
+KDef(rdrag,K_RDRAG)
+KDef(regions,K_REGIONS)
+KDef(resize,K_RESIZE)
+KDef(row,K_ROW)
+KDef(rpress,K_RPRESS)
+KDef(rrelease,K_RRELEASE)
+KDef(shift,K_SHIFT)
+KDef(source,K_SOURCE)
+KDef(storage,K_STORAGE)
+KDef(subject,K_SUBJECT)
+KDef(time,K_TIME)
+KDef(trace,K_TRACE)
+KDef(ucase,K_UCASE)
+KDef(version,K_VERSION)
+KDef(window,K_WINDOW)
+KDef(x,K_X)
+KDef(y,K_Y)
diff --git a/src/h/lexdef.h b/src/h/lexdef.h
new file mode 100644
index 0000000..25ff909
--- /dev/null
+++ b/src/h/lexdef.h
@@ -0,0 +1,75 @@
+/*
+ * lexdef.h -- common definitions for use with the lexical analyzer.
+ */
+
+/*
+ * Miscellaneous globals.
+ */
+extern int yychar;		/* parser's current input token type */
+extern int yynerrs;		/* number of errors in parse */
+extern int nocode;		/* true to suppress code generation */
+
+extern int in_line;		/* current line number in input */
+extern int incol;		/* current column number in input */
+extern int peekc;		/* one character look-ahead */
+extern FILE *srcfile;		/* current input file */
+
+extern int tfatals;		/* total fatal errors */
+
+/*
+ * Token table structure.
+ */
+
+struct toktab {
+   char *t_word;		/* token */
+   int  t_type;			/* token type returned by yylex */
+   int  t_flags;		/* flags for semicolon insertion */
+   };
+
+extern struct toktab toktab[];	/* token table */
+extern struct toktab *restab[];	/* reserved word index */
+
+#define T_Ident		&toktab[0]
+#define T_Int		&toktab[1]
+#define T_Real		&toktab[2]
+#define T_String	&toktab[3]
+#define T_Cset		&toktab[4]
+#define T_Eof		&toktab[5]
+
+/*
+ * t_flags values for token table.
+ */
+
+#define Beginner 1		/* token can follow a semicolon */
+#define Ender    2		/* token can precede a semicolon */
+
+/*
+ * optab contains token information along with pointers to implementation
+ *  information for each operator. Special symbols are also included.
+ */
+#define Unary  1
+#define Binary 2
+
+struct optab {
+   struct toktab tok;        /* token information for the operator symbol */
+   int expected;	     /* what is expected in data base: Unary/Binary */
+   struct implement *unary;  /* data base entry for unary version */
+   struct implement *binary; /* data base entry for binary version */
+   };
+
+extern struct optab optab[]; /* operator table */
+extern int asgn_loc;         /* index in optab of assignment */
+extern int semicol_loc;      /* index in optab of semicolon */
+extern int plus_loc;         /* index in optab of addition */
+extern int minus_loc;        /* index in optab of subtraction */
+
+/*
+ * Miscellaneous.
+ */
+
+#define isoctal(c) ((c)>='0'&&(c)<='7')	/* macro to test for octal digit */
+#define NextChar   nextchar()		/* macro to get next character */
+#define PushChar(c) peekc=(c)		/* macro to push back a character */
+
+#define Comment '#'			/* comment beginner */
+#define Escape  '\\'			/* string literal escape character */
diff --git a/src/h/monitor.h b/src/h/monitor.h
new file mode 100644
index 0000000..e359e9e
--- /dev/null
+++ b/src/h/monitor.h
@@ -0,0 +1,213 @@
+/*
+ * This file contains definitions for the various event codes and values
+ * that go to make up event streams.
+ */
+
+/*
+ * Note: the blank character should *not* be used as an event code.
+ */
+
+#ifdef EventMon
+
+/*
+ * Allocation events use lowercase codes.
+ */
+#define E_Lrgint	'\114'		/* Large integer allocation */
+#define E_Real		'\144'		/* Real allocation */
+#define E_Cset		'\145'		/* Cset allocation */
+#define E_File		'\147'		/* File allocation */
+#define E_Record	'\150'		/* Record allocation */
+#define E_Tvsubs	'\151'		/* Substring tv allocation */
+#define E_External	'\152'		/* External allocation */
+#define E_List		'\153'		/* List allocation */
+#define E_Lelem		'\155'		/* List element allocation */
+#define E_Table		'\156'		/* Table allocation */
+#define E_Telem		'\157'		/* Table element allocation */
+#define E_Tvtbl		'\160'		/* Table-element tv allocation */
+#define E_Set		'\161'		/* Set allocation */
+#define E_Selem		'\164'		/* Set element allocation */
+#define E_Slots		'\167'		/* Hash header allocation */
+#define E_Coexpr	'\170'		/* Co-expression allocation */
+#define E_Refresh	'\171'		/* Refresh allocation */
+#define E_Alien		'\172'		/* Alien allocation */
+#define E_Free		'\132'		/* Free region */
+#define E_String	'\163'		/* String allocation */
+
+/*
+ * Some other monitoring codes.
+ */
+#define	E_BlkDeAlc	'\055'		/* Block deallocation */
+#define	E_StrDeAlc	'\176'		/* String deallocation */
+
+/*
+ * These are not "events"; they are provided for uniformity in tools
+ *  that deal with types.
+ */
+#define E_Integer	'\100'		/* Integer value pseudo-event */
+#define E_Null		'\044'		/* Null value pseudo-event */
+#define E_Proc		'\045'		/* Procedure value pseudo-event */
+#define E_Kywdint	'\136'		/* Integer keyword value pseudo-event */
+#define E_Kywdpos	'\046'		/* Position value pseudo-event */
+#define E_Kywdsubj	'\052'		/* Subject value pseudo-event */
+
+/*
+ * Codes for main sequence events
+ */
+
+   /*
+    * Timing events
+    */
+#define E_Tick		'\056'		/* Clock tick */
+
+   /*
+    * Code-location event
+    */
+#define E_Loc		'\174'		/* Location change */
+#define E_Line		'\355'		/* Line change */
+
+   /*
+    * Virtual-machine instructions
+    */
+#define E_Opcode	'\117'		/* Virtual-machine instruction */
+
+   /*
+    * Type-conversion events
+    */
+#define E_Aconv		'\111'		/* Conversion attempt */
+#define E_Tconv		'\113'		/* Conversion target */
+#define E_Nconv		'\116'		/* Conversion not needed */
+#define E_Sconv		'\121'		/* Conversion success */
+#define E_Fconv		'\112'		/* Conversion failure */
+
+   /*
+    * Structure events
+    */
+#define	E_Lbang		'\301'		/* List generation */
+#define	E_Lcreate	'\302'		/* List creation */
+#define	E_Lget		'\356'		/* List get/pop -- only E_Lget used */
+#define	E_Lpop		'\356'		/* List get/pop */
+#define	E_Lpull		'\304'		/* List pull */
+#define	E_Lpush		'\305'		/* List push */
+#define	E_Lput		'\306'		/* List put */
+#define	E_Lrand		'\307'		/* List random reference */
+#define	E_Lref		'\310'		/* List reference */
+#define E_Lsub		'\311'		/* List subscript */
+#define	E_Rbang		'\312'		/* Record generation */
+#define	E_Rcreate	'\313'		/* Record creation */
+#define	E_Rrand		'\314'		/* Record random reference */
+#define	E_Rref		'\315'		/* Record reference */
+#define E_Rsub		'\316'		/* Record subscript */
+#define	E_Sbang		'\317'		/* Set generation */
+#define	E_Screate	'\320'		/* Set creation */
+#define	E_Sdelete	'\321'		/* Set deletion */
+#define	E_Sinsert	'\322'		/* Set insertion */
+#define	E_Smember	'\323'		/* Set membership */
+#define	E_Srand		'\336'		/* Set random reference */
+#define	E_Sval		'\324'		/* Set value */
+#define	E_Tbang		'\325'		/* Table generation */
+#define	E_Tcreate	'\326'		/* Table creation */
+#define	E_Tdelete	'\327'		/* Table deletion */
+#define	E_Tinsert	'\330'		/* Table insertion */
+#define	E_Tkey		'\331'		/* Table key generation */
+#define	E_Tmember	'\332'		/* Table membership */
+#define	E_Trand		'\337'		/* Table random reference */
+#define	E_Tref		'\333'		/* Table reference */
+#define	E_Tsub		'\334'		/* Table subscript */
+#define	E_Tval		'\335'		/* Table value */
+
+   /*
+    * Scanning events
+    */
+
+#define E_Snew		'\340'		/* Scanning environment creation */
+#define E_Sfail		'\341'		/* Scanning failure */
+#define E_Ssusp		'\342'		/* Scanning suspension */
+#define E_Sresum	'\343'		/* Scanning resumption */
+#define E_Srem		'\344'		/* Scanning environment removal */
+#define E_Spos		'\346'		/* Scanning position */
+
+   /*
+    * Assignment
+    */
+
+#define E_Assign	'\347'		/* Assignment */
+#define	E_Value		'\350'		/* Value assigned */
+
+   /*
+    * Sub-string assignment
+    */
+
+#define E_Ssasgn	'\354'		/* Sub-string assignment */
+   /*
+    * Interpreter stack events
+    */
+
+#define E_Intcall	'\351'		/* interpreter call */
+#define E_Intret	'\352'		/* interpreter return */
+#define E_Stack		'\353'		/* stack depth */
+
+   /*
+    * Expression events
+    */
+#define E_Ecall		'\143'		/* Call of operation */
+#define E_Efail		'\146'		/* Failure from expression */
+#define E_Bsusp		'\142'		/* Suspension from operation */
+#define E_Esusp		'\141'		/* Suspension from alternation */
+#define E_Lsusp		'\154'		/* Suspension from limitation */
+#define E_Eresum	'\165'		/* Resumption of expression */
+#define E_Erem		'\166'		/* Removal of a suspended generator */
+
+   /*
+    * Co-expression events
+    */
+
+#define E_Coact		'\101'		/* Co-expression activation */
+#define E_Coret		'\102'		/* Co-expression return */
+#define E_Cofail	'\104'		/* Co-expression failure */
+
+   /*
+    * Procedure events
+    */
+
+#define E_Pcall		'\103'		/* Procedure call */
+#define E_Pfail		'\106'		/* Procedure failure */
+#define E_Pret		'\122'		/* Procedure return */
+#define E_Psusp		'\123'		/* Procedure suspension */
+#define E_Presum	'\125'		/* Procedure resumption */
+#define E_Prem		'\126'		/* Suspended procedure removal */
+
+#define E_Fcall		'\072'		/* Function call */
+#define E_Ffail		'\115'		/* Function failure */
+#define E_Fret		'\120'		/* Function return */
+#define E_Fsusp		'\127'		/* Function suspension */
+#define E_Fresum	'\131'		/* Function resumption */
+#define E_Frem		'\133'		/* Function suspension removal */
+
+#define E_Ocall		'\134'		/* Operator call */
+#define E_Ofail		'\135'		/* Operator failure */
+#define E_Oret		'\140'		/* Operator return */
+#define E_Osusp		'\173'		/* Operator suspension */
+#define E_Oresum	'\175'		/* Operator resumption */
+#define E_Orem		'\177'		/* Operator suspension removal */
+
+   /*
+    * Garbage collections
+    */
+
+#define E_Collect	'\107'		/* Garbage collection */
+#define E_EndCollect	'\360'		/* End of garbage collection */
+#define E_TenureString	'\361'		/* Tenure a string region */
+#define E_TenureBlock	'\362'		/* Tenure a block region */
+
+/*
+ * Termination Events
+ */
+#define E_Error		'\105'		/* Run-time error */
+#define E_Exit		'\130'		/* Program exit */
+
+   /*
+    * I/O events
+    */
+#define E_MXevent	'\370'		/* monitor input event */
+
+#endif					/* EventMon */
diff --git a/src/h/mproto.h b/src/h/mproto.h
new file mode 100644
index 0000000..f6f633b
--- /dev/null
+++ b/src/h/mproto.h
@@ -0,0 +1,54 @@
+/*
+ * mproto.h -- prototypes for functions common to several modules.
+ */
+
+#define NewStruct(type) alloc(sizeof(struct type))
+
+pointer	alloc		(unsigned int n);
+unsigned short *bitvect	(char *image, int len);
+char	*canonize	(char *path);
+void	clear_sbuf	(struct str_buf *sbuf);
+int	cmp_pre		(char *pre1, char *pre2);
+void	cset_init	(FILE *f, unsigned short *bv);
+void	db_chstr	(char *s1, char *s2);
+void	db_close	(void);
+void	db_code		(struct implement *ip);
+void	db_dscrd	(struct implement *ip);
+void	db_err1		(int fatal, char *s1);
+void	db_err2		(int fatal, char *s1, char *s2);
+struct implement *db_ilkup (char *id, struct implement **tbl);
+struct implement *db_impl  (int oper_typ);
+int	db_open		(char *s, char **lrgintflg);
+char	*db_string	(void);
+int	db_tbl		(char *section, struct implement **tbl);
+char	*findexe	(char *name, char *buf, size_t len);
+char	*findonpath	(char *name, char *buf, size_t len);
+char	*followsym	(char *name, char *buf, size_t len);
+struct fileparts *fparse(char *s);
+void	free_stbl	(void);
+void	id_comment	(FILE *f);
+void	init_sbuf	(struct str_buf *sbuf);
+void	init_str	(void);
+long	longwrite	(char *s, long len, FILE *file);
+char	*makename	(char *dest, char *d, char *name, char *e);
+long	millisec	(void);
+struct il_code *new_il	(int il_type, int size);
+void	new_sbuf	(struct str_buf *sbuf);
+void	nxt_pre		(char *pre, char *nxt, int n);
+char	*pathfind	(char *buf, char *path, char *name, char *extn);
+int	ppch		(void);
+void	ppdef		(char *name, char *value);
+void	ppecho		(void);
+int	ppinit		(char *fname, char *inclpath, int m4flag);
+int	prt_i_str	(FILE *f, char *s, int len);
+char	*relfile	(char *prog, char *mod);
+char	*salloc		(char *s);
+int	smatch		(char *s, char *t);
+char	*spec_str	(char *s);
+char	*str_install	(struct str_buf *sbuf);
+int	tonum		(int c);
+void	lear_sbuf	(struct str_buf *sbuf);
+
+#ifndef SysOpt
+   int	getopt		(int argc, char * const argv[], const char *optstring);
+#endif					/* NoSysOpt */
diff --git a/src/h/mswin.h b/src/h/mswin.h
new file mode 100644
index 0000000..2734cb1
--- /dev/null
+++ b/src/h/mswin.h
@@ -0,0 +1,201 @@
+/*
+ * mswin.h - macros and types used in the MS Windows graphics interface.
+ */
+
+#define DRAWOP_AND			R2_MASKPEN
+#define DRAWOP_ANDINVERTED		R2_MASKNOTPEN
+#define DRAWOP_ANDREVERSE		R2_NOTMASKPEN
+#define DRAWOP_CLEAR			R2_BLACK
+#define DRAWOP_COPY			R2_COPYPEN
+#define DRAWOP_COPYINVERTED		R2_NOTCOPYPEN
+#define DRAWOP_EQUIV			R2_NOTXORPEN
+#define DRAWOP_INVERT			R2_NOT
+#define DRAWOP_NAND			R2_MASKNOTPEN
+#define DRAWOP_NOOP			R2_NOP
+#define DRAWOP_NOR			R2_MERGENOTPEN
+#define DRAWOP_OR			R2_MERGEPEN
+#define DRAWOP_ORINVERTED		R2_MERGEPENNOT
+#define DRAWOP_ORREVERSE		R2_NOTMERGEPEN
+#define DRAWOP_REVERSE			R2_USER1
+#define DRAWOP_SET			R2_WHITE
+#define DRAWOP_XOR			R2_XORPEN
+
+#define TEXTWIDTH(w,s,n) textWidth(w, s, n)
+#define SCREENDEPTH(w) getdepth(w)
+#define ASCENT(w)  ((w)->context->font->ascent)
+#define ASCENTC(wc)  ((wc)->font->ascent)
+#define DESCENT(w) ((w)->context->font->descent)
+#define LEADING(w) ((w)->context->leading)
+#define FHEIGHT(w) ((w)->context->font->height)
+#define FHEIGHTC(wc) ((wc)->font->height)
+#define FWIDTH(w)  ((w)->context->font->charwidth)
+#define FWIDTHC(wc)  ((wc)->font->charwidth)
+#define LINEWIDTH(w) ((w)->context->pen.lopnWidth.x)
+#define DISPLAYHEIGHT(w) devicecaps(w, VERTRES)
+#define DISPLAYWIDTH(w) devicecaps(w, HORZRES)
+#define wsync(w) /* noop */
+#define SysColor unsigned long
+#define RED(x) GetRValue(x)
+#define GREEN(x) GetGValue(x)
+#define BLUE(x) GetBValue(x)
+#define ARCWIDTH(arc) (arc).width
+#define ARCHEIGHT(arc) (arc).height
+/*
+ * These get fixed up in the window-system-specific code
+ */
+#define RECX(rec) (rec).left
+#define RECY(rec) (rec).top
+#define RECWIDTH(rec) (rec).right
+#define RECHEIGHT(rec) (rec).bottom
+/*
+ *
+ */
+#define ANGLE(ang) (ang)
+#define EXTENT(ang) (ang)
+#define FULLARC 2 * Pi
+#define ISICONIC(w) (IsIconic((w)->window->iconwin))
+#define ISFULLSCREEN(w) 0
+#define ISROOTWIN(w) (0) 0
+#define ISNORMALWINDOW(w) 0
+#define ICONFILENAME(w) ""
+#define ICONLABEL(w) ((w)->window->iconlabel)
+#define WINDOWLABEL(w) ((w)->window->windowlabel)
+
+#define MAXDESCENDER(w) DESCENT(w)
+
+/*
+ * gemeotry bitmasks
+ */
+#define GEOM_WIDTH           1
+#define GEOM_HEIGHT          2
+#define GEOM_POSX            4
+#define GEOM_POSY            8
+/*
+ * fill styles
+ */
+#define FS_SOLID             1
+#define FS_STIPPLE           2
+#define FS_OPAQUESTIPPLE     4
+/*
+ * the special ROP code for mode reverse
+ */
+#define R2_USER1            (R2_LAST << 1)
+/*
+ * window states
+ */
+#define WS_NORMAL            0
+#define WS_MIN               1
+#define WS_MAX               2
+
+/*
+ * input masks
+ */
+#define PointerMotionMask    1
+
+/*
+ * something I think should be #defined
+ */
+#define EOS                  '\0'
+
+/* size of the working buffer, used for dialog messages and such */
+#define PMSTRBUFSIZE         2048
+/*
+ * the bitmasks for the modifier keys
+ */
+#define ControlMask          (1L << 16L)
+#define Mod1Mask             (2L << 16L)
+#define ShiftMask            (4L << 16L)
+#define VirtKeyMask          (8L << 16L)
+
+/* some macros for Windows */
+
+#define MAKERGB(r,g,b) RGB(r,g,b)
+#define RGB16TO8(x) if ((x) > 0xff) (x) = (((x) >> 8) & 0xff)
+#define hidecrsr(ws) if (ws->hasCaret) HideCaret(ws->iconwin)
+#define showcrsr(ws) if (ws->hasCaret) ShowCaret(ws->iconwin)
+#define FNTWIDTH(size) ((size) & 0xFFFF)
+#define FNTHEIGHT(size) ((size) >> 16)
+#define MAKEFNTSIZE(height, width) (((height) << 16) | (width))
+#define WaitForEvent(msgnum, msgstruc) ObtainEvents(NULL, WAIT_EVT, msgnum, msgstruc)
+
+/*
+ * "get" means remove them from the Icon list and put them on the ghost que
+ */
+#define EVQUEGET(ws,d) { \
+  int i;\
+  if (!c_get((struct b_list *)BlkLoc((ws)->listp),&d)) fatalerr(0,NULL); \
+  if (Qual(d)) {\
+      (ws)->eventQueue[(ws)->eQfront++] = *StrLoc(d); \
+      if ((ws)->eQfront >= EQUEUELEN) (ws)->eQfront = 0; \
+      (ws)->eQback = (ws)->eQfront; \
+      } \
+  }
+#define EVQUEEMPTY(ws) (BlkLoc((ws)->listp)->list.size == 0)
+
+#define SHARED          0
+#define MUTABLE         1
+#define MAXCOLORNAME	40
+/*
+ * color structure, inspired by X code (xwin.h)
+ */
+typedef struct wcolor {
+  int		refcount;
+  char		name[6+MAXCOLORNAME];	/* name for WAttrib & WColor reads */
+  SysColor	c;
+  int           type;			/* SHARED or MUTABLE */
+} *wclrp;
+
+/*
+ * we make the segment structure look like this so that we can
+ * cast it to POINTL structures that can be passed to GpiPolyLineDisjoint
+ */
+typedef struct {
+   LONG x1, y1;
+   LONG x2, y2;
+   } XSegment;
+
+typedef POINT XPoint;
+typedef RECT XRectangle;
+
+typedef struct {
+  LONG x, y;
+  LONG width, height;
+  double angle1, angle2;
+  } XArc;
+
+/*
+ * macros performing row/column to pixel y,x translations
+ * computation is 1-based and depends on the current font's size.
+ * exception: XTOCOL as defined is 0-based, because that's what its
+ * clients seem to need.
+ */
+#define ROWTOY(wb, row)  ((row - 1) * LEADING(wb) + ASCENT(wb))
+#define COLTOX(wb, col)  ((col - 1) * FWIDTH(wb))
+#define YTOROW(wb, y)    (((y) - ASCENT(w)) /  LEADING(wb) + 1)
+#define XTOCOL(w,x)  (!FWIDTH(w) ? (x) : ((x) / FWIDTH(w)))
+
+/*
+ * system size values
+ */
+#define BORDERWIDTH      (GetSystemMetrics(SM_CXBORDER)) /* 1 */
+#define BORDERHEIGHT     (GetSystemMetrics(SM_CYBORDER)) /* 1 */
+#define TITLEHEIGHT      (GetSystemMetrics(SM_CYCAPTION)) /* 20 */
+#define FRAMEWIDTH	 (GetSystemMetrics(SM_CXFRAME))   /* 4 */
+#define FRAMEHEIGHT	 (GetSystemMetrics(SM_CYFRAME))   /* 4 */
+
+#define STDLOCALS(w) \
+   wcp wc = (w)->context;\
+   wsp ws = (w)->window;\
+   HWND stdwin = ws->win;\
+   HBITMAP stdpix = ws->pix;\
+   HDC stddc = CreateWinDC(w);\
+   HDC pixdc = CreatePixDC(w, stddc);
+
+#define STDFONT \
+   { if(stdwin)SelectObject(stddc, wc->font->font); SelectObject(pixdc,wc->font->font); }
+
+#define FREE_STDLOCALS(w) do { SelectObject(pixdc, (w)->window->theOldPix); ReleaseDC((w)->window->iconwin, stddc); DeleteDC(pixdc); } while (0)
+
+#define MAXXOBJS 8
+
+#define GammaCorrection 1.0
diff --git a/src/h/odefs.h b/src/h/odefs.h
new file mode 100644
index 0000000..acb9981
--- /dev/null
+++ b/src/h/odefs.h
@@ -0,0 +1,54 @@
+/*
+ * Operator definitions.
+ *
+ * Fields are:
+ *    name
+ *    number of arguments
+ *    string representation
+ *    dereference arguments flag: -1 = don't, 0 = do
+ */
+
+OpDef(asgn,2,":=",-1)
+OpDef(bang,1,"!",-1)
+OpDef(cater,2,"||",0)
+OpDef(compl,1,"~",0)
+OpDef(diff,2,"--",0)
+OpDef(divide,2,"/",0)
+OpDef(eqv,2,"===",0)
+OpDef(inter,2,"**",0)
+OpDef(lconcat,2,"|||",0)
+OpDef(lexeq,2,"==",0)
+OpDef(lexge,2,">>=",0)
+OpDef(lexgt,2,">>",0)
+OpDef(lexle,2,"<<=",0)
+OpDef(lexlt,2,"<<",0)
+OpDef(lexne,2,"~==",0)
+OpDef(minus,2,"-",0)
+OpDef(mod,2,"%",0)
+OpDef(mult,2,"*",0)
+OpDef(neg,1,"-",0)
+OpDef(neqv,2,"~===",0)
+OpDef(nonnull,1,"\\",-1)
+OpDef(null,1,"/",-1)
+OpDef(number,1,"+",0)
+OpDef(numeq,2,"=",0)
+OpDef(numge,2,">=",0)
+OpDef(numgt,2,">",0)
+OpDef(numle,2,"<=",0)
+OpDef(numlt,2,"<",0)
+OpDef(numne,2,"~=",0)
+OpDef(plus,2,"+",0)
+OpDef(powr,2,"^",0)
+OpDef(random,1,"?",-1)
+OpDef(rasgn,2,"<-",-1)
+OpDef(refresh,1,"^",0)
+OpDef(rswap,2,"<->",-1)
+OpDef(sect,3,"[:]",-1)
+OpDef(size,1,"*",0)
+OpDef(subsc,2,"[]",-1)
+OpDef(swap,2,":=:",-1)
+OpDef(tabmat,1,"=",0)
+OpDef(toby,3,"...",0)
+OpDef(union,2,"++",0)
+OpDef(value,1,".",0)
+/* OpDef(llist,1,"[...]",0) */
diff --git a/src/h/opdefs.h b/src/h/opdefs.h
new file mode 100644
index 0000000..8f32e30
--- /dev/null
+++ b/src/h/opdefs.h
@@ -0,0 +1,140 @@
+/*
+ * Opcode definitions used in icode.
+ */
+
+/*
+ * Operators. These must be in the same order as in odefs.h.  Not very nice,
+ *  but it'll have to do until we think of another way to do this.  (It's
+ *  always been thus.)
+ */
+#define Op_Asgn		  1
+#define Op_Bang		  2
+#define Op_Cat		  3
+#define Op_Compl	  4
+#define Op_Diff		  5
+#define Op_Div		  6
+#define Op_Eqv		  7
+#define Op_Inter	  8
+#define Op_Lconcat	  9
+#define Op_Lexeq	 10
+#define Op_Lexge	 11
+#define Op_Lexgt	 12
+#define Op_Lexle	 13
+#define Op_Lexlt	 14
+#define Op_Lexne	 15
+#define Op_Minus	 16
+#define Op_Mod		 17
+#define Op_Mult		 18
+#define Op_Neg		 19
+#define Op_Neqv		 20
+#define Op_Nonnull	 21
+#define Op_Null		 22
+#define Op_Number	 23
+#define Op_Numeq	 24
+#define Op_Numge	 25
+#define Op_Numgt	 26
+#define Op_Numle	 27
+#define Op_Numlt	 28
+#define Op_Numne	 29
+#define Op_Plus		 30
+#define Op_Power	 31
+#define Op_Random	 32
+#define Op_Rasgn	 33
+#define Op_Refresh	 34
+#define Op_Rswap	 35
+#define Op_Sect		 36
+#define Op_Size		 37
+#define Op_Subsc	 38
+#define Op_Swap		 39
+#define Op_Tabmat	 40
+#define Op_Toby		 41
+#define Op_Unions	 42
+#define Op_Value	 43
+/*
+ * Other instructions.
+ */
+#define Op_Bscan	 44
+#define Op_Ccase	 45
+#define Op_Chfail	 46
+#define Op_Coact	 47
+#define Op_Cofail	 48
+#define Op_Coret	 49
+#define Op_Create	 50
+#define Op_Cset		 51
+#define Op_Dup		 52
+#define Op_Efail	 53
+#define Op_Eret		 54
+#define Op_Escan	 55
+#define Op_Esusp	 56
+#define Op_Field	 57
+#define Op_Goto		 58
+#define Op_Init		 59
+#define Op_Int		 60
+#define Op_Invoke	 61
+#define Op_Keywd	 62
+#define Op_Limit	 63
+#define Op_Line		 64
+#define Op_Llist	 65
+#define Op_Lsusp	 66
+#define Op_Mark		 67
+#define Op_Pfail	 68
+#define Op_Pnull	 69
+#define Op_Pop		 70
+#define Op_Pret		 71
+#define Op_Psusp	 72
+#define Op_Push1	 73
+#define Op_Pushn1	 74
+#define Op_Real		 75
+#define Op_Sdup		 76
+#define Op_Str		 77
+#define Op_Unmark	 78
+#define Op_Var		 80
+#define Op_Arg		 81
+#define Op_Static	 82
+#define Op_Local	 83
+#define Op_Global	 84
+#define Op_Mark0	 85
+#define Op_Quit		 86
+#define Op_FQuit	 87
+#define Op_Tally	 88
+#define Op_Apply	 89
+
+/*
+ * "Absolute" address operations.  These codes are inserted in the
+ * icode at run-time by the interpreter to overwrite operations
+ * that initially compute a location relative to locations not known until
+ * the icode file is loaded.
+ */
+#define Op_Acset	 90
+#define Op_Areal	 91
+#define Op_Astr		 92
+#define Op_Aglobal	 93
+#define Op_Astatic	 94
+#define Op_Agoto	 95
+#define Op_Amark	 96
+
+#define Op_Noop		 98
+
+#define Op_Colm		108		/* column number */
+
+/*
+ * Declarations and such -- used by the linker but not the run-time system.
+ */
+
+#define Op_Proc		101
+#define Op_Declend	102
+#define Op_End		103
+#define Op_Link		104
+#define Op_Version	105
+#define Op_Con		106
+#define Op_Filen	107
+
+/*
+ * Global symbol table declarations.
+ */
+#define Op_Record	105
+#define Op_Impl		106
+#define Op_Error	107
+#define Op_Trace	108
+#define Op_Lab		109
+#define Op_Invocable	110
diff --git a/src/h/parserr.h b/src/h/parserr.h
new file mode 100644
index 0000000..e8c92d4
--- /dev/null
+++ b/src/h/parserr.h
@@ -0,0 +1,177 @@
+/*
+ * parserr.h -- table of parser error messages.
+ *
+ * Each entry maps a syntax error from a particular Yacc state into a
+ * descriptive message.  This file needs to be updated whenever the
+ * grammar is changed.
+ */
+
+static struct errmsg {
+   int	e_state;		/* parser state number */
+   char *e_mesg;		/* message text */
+   } errtab[] = {
+
+     0, "invalid declaration",
+     1, "end of file expected",
+     2, "invalid declaration",
+    12, "missing semicolon",
+    14, "link list expected",
+    15, "invocable list expected",
+    17, "invalid declaration",
+    18, "missing record name",
+    21, "invalid global declaration",
+    30, "missing procedure name",
+    32, "missing field list in record declaration",
+    34, "missing end",
+    35, "missing semicolon or operator",
+    50, "invalid argument for unary operator",
+    51, "invalid argument for unary operator",
+    52, "invalid argument for unary operator",
+    53, "invalid argument for unary operator",
+    54, "invalid argument for unary operator",
+    55, "invalid argument for unary operator",
+    56, "invalid argument for unary operator",
+    57, "invalid argument for unary operator",
+    58, "invalid argument for unary operator",
+    59, "invalid argument for unary operator",
+    60, "invalid argument for unary operator",
+    61, "invalid argument for unary operator",
+    62, "invalid argument for unary operator",
+    63, "invalid argument for unary operator",
+    64, "invalid argument for unary operator",
+    65, "invalid argument for unary operator",
+    66, "invalid argument for unary operator",
+    67, "invalid argument for unary operator",
+    68, "invalid argument for unary operator",
+    69, "invalid argument for unary operator",
+    70, "invalid argument for unary operator",
+    71, "invalid argument for unary operator",
+    72, "invalid argument for unary operator",
+    73, "invalid argument for unary operator",
+    83, "invalid create expression",
+    86, "invalid break expression",
+    87, "invalid expression list",
+    88, "invalid compound expression",
+    89, "invalid expression list",
+    90, "invalid keyword construction",
+    96, "invalid return expression",
+    97, "invalid suspend expression",
+    98, "invalid if control expression",
+    99, "invalid case control expression",
+   100, "invalid while control expression",
+   101, "invalid until control expression",
+   102, "invalid every control expression",
+   103, "invalid repeat expression",
+   106, "missing link file name",
+   107, "missing operation name",
+   108, "missing number of arguments",
+   109, "missing parameter list in procedure declaration",
+   111, "invalid procedure body",
+   112, "invalid local declaration",
+   113, "invalid initial expression",
+   117, "invalid expression",
+   118, "invalid argument",
+   119, "invalid argument",
+   120, "invalid argument in assignment",
+   121, "invalid argument in assignment",
+   122, "invalid argument in assignment",
+   123, "invalid argument in assignment",
+   124, "invalid argument in augmented assignment",
+   125, "invalid argument in augmented assignment",
+   126, "invalid argument in augmented assignment",
+   127, "invalid argument in augmented assignment",
+   128, "invalid argument in augmented assignment",
+   129, "invalid argument in augmented assignment",
+   130, "invalid argument in augmented assignment",
+   131, "invalid argument in augmented assignment",
+   132, "invalid argument in augmented assignment",
+   133, "invalid argument in augmented assignment",
+   134, "invalid argument in augmented assignment",
+   135, "invalid argument in augmented assignment",
+   136, "invalid argument in augmented assignment",
+   137, "invalid argument in augmented assignment",
+   138, "invalid argument in augmented assignment",
+   139, "invalid argument in augmented assignment",
+   140, "invalid argument in augmented assignment",
+   141, "invalid argument in augmented assignment",
+   142, "invalid argument in augmented assignment",
+   143, "invalid argument in augmented assignment",
+   144, "invalid argument in augmented assignment",
+   145, "invalid argument in augmented assignment",
+   146, "invalid argument in augmented assignment",
+   147, "invalid argument in augmented assignment",
+   148, "invalid argument in augmented assignment",
+   149, "invalid argument in augmented assignment",
+   150, "invalid argument in augmented assignment",
+   151, "invalid argument in augmented assignment",
+   152, "invalid to clause",
+   153, "invalid argument in alternation",
+   154, "invalid argument",
+   155, "invalid argument",
+   156, "invalid argument",
+   157, "invalid argument",
+   158, "invalid argument",
+   159, "invalid argument",
+   160, "invalid argument",
+   161, "invalid argument",
+   162, "invalid argument",
+   163, "invalid argument",
+   164, "invalid argument",
+   165, "invalid argument",
+   166, "invalid argument",
+   167, "invalid argument",
+   168, "invalid argument",
+   169, "invalid argument",
+   170, "invalid argument",
+   171, "invalid argument",
+   172, "invalid argument",
+   173, "invalid argument",
+   174, "invalid argument",
+   175, "invalid argument",
+   176, "invalid argument",
+   177, "invalid argument",
+   178, "invalid argument",
+   179, "invalid argument",
+   180, "invalid argument",
+   181, "invalid argument",
+   182, "invalid subscript",
+   183, "invalid pdco list",
+   184, "invalid expression list",
+   185, "invalid field name",
+   212, "missing right parenthesis",
+   214, "missing right brace",
+   216, "missing right bracket",
+   222, "missing then",
+   223, "missing of",
+   228, "missing identifier",
+   233, "missing right parenthesis",
+   235, "missing end",
+   236, "invalid declaration",
+   237, "missing semicolon or operator",
+   303, "missing right bracket",
+   306, "missing right brace",
+   308, "missing right parenthesis",
+   311, "invalid expression list",
+   313, "invalid expression",
+   315, "invalid do clause",
+   316, "invalid then clause",
+   317, "missing left brace",
+   318, "invalid do clause",
+   319, "invalid do clause",
+   320, "invalid do clause",
+   322, "invalid parameter list",
+   328, "invalid by clause",
+   330, "invalid section",
+   335, "invalid pdco list",
+   341, "invalid case clause",
+   346, "missing right bracket",
+   348, "missing right bracket or ampersand",
+   350, "invalid else clause",
+   351, "missing right brace or semicolon",
+   353, "missing colon",
+   354, "missing colon or ampersand",
+   359, "invalid case clause",
+   360, "invalid default clause",
+   361, "invalid case clause",
+    -1,  "syntax error"
+   };
diff --git a/src/h/rexterns.h b/src/h/rexterns.h
new file mode 100644
index 0000000..804424c
--- /dev/null
+++ b/src/h/rexterns.h
@@ -0,0 +1,223 @@
+/*
+ * External declarations for the run-time system.
+ */
+
+/*
+ * External declarations common to the compiler and interpreter.
+ */
+
+extern struct b_proc *op_tbl;   /* operators available for string invocation */
+extern int op_tbl_sz;           /* number of operators in op_tbl */
+extern int debug_info;		/* flag: debugging information is available */
+extern int err_conv;		/* flag: error conversion is supported */
+extern int dodump;		/* termination dump */
+extern int line_info;		/* flag: line information is available */
+extern char *file_name;		/* source file for current execution point */
+extern int line_num;		/* line number for current execution point */
+
+extern unsigned char allchars[];/* array for making one-character strings */
+extern char *blkname[];		/* print names for block types. */
+extern char *currend;		/* current end of memory region */
+extern dptr *quallist;		/* start of qualifier list */
+extern int bsizes[];		/* sizes of blocks */
+extern int firstd[];		/* offset (words) of first descrip. */
+extern uword segsize[];		/* size of hash bucket segment */
+extern int k_level;		/* value of &level */
+
+extern struct b_coexpr *stklist;/* base of co-expression stack list */
+extern struct b_cset blankcs;   /* ' ' */
+extern struct b_cset lparcs;    /* '(' */
+extern struct b_cset rparcs;    /* ')' */
+extern struct b_cset fullcs;    /* cset containing all characters */
+extern struct descrip blank;	/* blank */
+extern struct descrip emptystr;	/* empty string */
+
+extern struct descrip kywd_dmp; /* descriptor for &dump */
+extern struct descrip nullptr;	/* descriptor with null block pointer */
+extern struct descrip lcase;	/* lowercase string */
+extern struct descrip letr;	/* letter "r" */
+extern struct descrip maps2;	/* second argument to map() */
+extern struct descrip maps3;	/* third argument to map() */
+extern struct descrip nulldesc;	/* null value */
+extern struct descrip onedesc;	/* one */
+extern struct descrip ucase;	/* uppercase string */
+extern struct descrip zerodesc;	/* zero */
+
+extern word mstksize;		/* size of main stack in words */
+extern word stksize;		/* size of co-expression stacks in words */
+extern word qualsize;		/* size of string qualifier list */
+extern word memcushion;		/* memory region cushion factor */
+extern word memgrowth;		/* memory region growth factor */
+extern uword stattotal;		/* cumulative total of all static allocations */
+				/* N.B. not currently set */
+
+extern struct tend_desc *tend;  /* chain of tended descriptors */
+
+/*
+ * Externals that are conditional on features.
+ */
+#ifdef FncTrace
+   extern struct descrip kywd_ftrc;	/* descriptor for &ftrace */
+#endif					/* FncTrace */
+
+#ifdef Polling
+   extern int pollctr;
+#endif					/* Polling */
+
+#ifdef EventMon
+   extern char typech[];
+   extern word oldsum;
+   extern struct descrip csetdesc;	/* cset descriptor */
+   extern struct descrip eventdesc;	/* event descriptor */
+   extern struct b_iproc mt_llist;
+   extern struct descrip rzerodesc;	/* real descriptor */
+   extern struct b_real realzero;	/* real zero block */
+#endif					/* EventMon */
+
+/*
+ * Externals conditional on multithreading.
+ */
+   extern struct region rootstring;
+   extern struct region rootblock;
+#ifndef MultiThread
+   extern dptr glbl_argp;		/* argument pointer */
+   extern struct region *curstring;
+   extern struct region *curblock;
+   extern struct descrip k_current;	/* &current */
+   extern char *k_errortext;		/* value of &errortext */
+   extern int have_errval;		/* &errorvalue has a legal value */
+   extern int k_errornumber;		/* value of &errornumber */
+   extern int t_errornumber;		/* tentative k_errornumber value */
+   extern int t_have_val;		/* tentative have_errval flag */
+   extern struct b_file k_errout;	/* value of &errout */
+   extern struct b_file k_input;	/* value of &input */
+   extern struct b_file k_output;	/* value of &output */
+   extern struct descrip k_errorvalue;	/* value of &errorvalue */
+   extern struct descrip kywd_err;	/* &error */
+   extern struct descrip kywd_pos;	/* descriptor for &pos */
+   extern struct descrip kywd_prog;	/* descriptor for &prog */
+   extern struct descrip kywd_ran;	/* descriptor for &random */
+   extern struct descrip k_subject;	/* &subject */
+   extern struct descrip kywd_trc;	/* descriptor for &trace */
+   extern struct descrip k_eventcode;	/* &eventcode */
+   extern struct descrip k_eventsource;	/* &eventsource */
+   extern struct descrip k_eventvalue;	/* &eventvalue */
+   extern struct descrip k_main;	/* value of &main */
+   extern struct descrip t_errorvalue;	/* tentative k_errorvalue value */
+   extern uword blktotal;		/* cumul total of all block allocs */
+   extern uword strtotal;		/* cumul total of all string allocs */
+   extern word coll_tot;		/* total number of collections */
+   extern word coll_stat;		/* collections from static reqests */
+   extern word coll_str;		/* collections from string requests */
+   extern word coll_blk;		/* collections from block requests */
+   extern dptr globals;			/* start of global variables */
+   extern dptr eglobals;		/* end of global variables */
+   extern dptr gnames;			/* start of global variable names */
+   extern dptr egnames;			/* end of global variable names */
+   extern dptr estatics;		/* end of static variables */
+   extern int n_globals;		/* number of global variables */
+   extern int n_statics;		/* number of static variables */
+   extern struct b_coexpr *mainhead;	/* &main */
+#endif					/* MultiThread */
+
+/*
+ * Externals that differ between compiler and interpreter.
+ */
+#if !COMPILER
+   /*
+    * External declarations for the interpreter.
+    */
+
+   extern int ixinited;			/* iconx has initialized */
+   extern inst ipc;			/* interpreter program counter */
+   extern int ilevel;			/* interpreter level */
+   extern int ntended;			/* number of active tended descriptors*/
+   extern struct b_cset k_ascii;	/* value of &ascii */
+   extern struct b_cset k_cset;		/* value of &cset */
+   extern struct b_cset k_digits;	/* value of &lcase */
+   extern struct b_cset k_lcase;	/* value of &lcase */
+   extern struct b_cset k_letters;	/* value of &letters */
+   extern struct b_cset k_ucase;	/* value of &ucase */
+   extern struct descrip tended[];	/* tended descriptors */
+   extern struct ef_marker *efp;	/* expression frame pointer */
+   extern struct gf_marker *gfp;	/* generator frame pointer */
+   extern struct pf_marker *pfp;	/* procedure frame pointer */
+   extern word *sp;			/* interpreter stack pointer */
+   extern word *stack;			/* interpreter stack base */
+   extern word *stackend;		/* end of evaluation stack */
+
+   extern struct pstrnm pntab[];
+   extern int pnsize;
+
+   #ifdef MultiThread
+      extern struct progstate *curpstate;
+      extern struct progstate rootpstate;
+      extern int noMTevents;		/* no MT events during GC */
+   #else				/* MultiThread */
+      extern char *code;		/* start of icode */
+      extern char *ecode;		/* end of icode */
+      extern dptr statics;		/* start of static variables */
+      extern char *strcons;		/* start of the string constants */
+      extern dptr fnames;		/* field names */
+      extern dptr efnames;		/* end of field names */
+      extern word *records;
+      extern int *ftabp;		/* field table pointer */
+      #ifdef FieldTableCompression
+         extern word ftabwidth, foffwidth;
+         extern unsigned char *ftabcp;
+         extern short *ftabsp;
+      #endif				/* FieldTableCompression */
+      extern dptr xargp;
+      extern word xnargs;
+
+      extern word lastop;
+   #endif				/* MultiThread */
+
+#else					/* COMPILER */
+
+   extern struct descrip statics[];	/* array of static variables */
+   extern struct b_proc *builtins[];	/* pointers to builtin functions */
+   extern int noerrbuf;			/* error buffering */
+   extern struct p_frame *pfp;		/* procedure frame pointer */
+   extern struct descrip trashcan;	/* dummy descriptor, never read */
+   extern int largeints;		/* flag: large integers supported */
+
+#endif					/* COMPILER */
+
+/*
+ * graphics
+ */
+#ifdef Graphics
+
+   extern stringint attribs[], drawops[];
+   extern wbp wbndngs;
+   extern wcp wcntxts;
+   extern wsp wstates;
+   extern int GraphicsLeft, GraphicsUp, GraphicsRight, GraphicsDown;
+   extern int GraphicsHome, GraphicsPrior, GraphicsNext, GraphicsEnd;
+   extern int win_highwater, canvas_serial, context_serial;
+   extern clock_t starttime;		/* start time in milliseconds */
+
+   #ifndef MultiThread
+      extern struct descrip kywd_xwin[];
+      extern struct descrip lastEventWin;
+      extern int lastEvFWidth, lastEvLeading, lastEvAscent;
+      extern struct descrip amperCol;
+      extern struct descrip amperRow;
+      extern struct descrip amperX;
+      extern struct descrip amperY;
+      extern struct descrip amperInterval;
+      extern uword xmod_control, xmod_shift, xmod_meta;
+   #endif				/* MultiThread */
+
+   #ifdef XWindows
+      extern struct _wdisplay * wdsplys;
+      extern stringint cursorsyms[];
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      extern HINSTANCE mswinInstance;
+      extern int ncmdShow;
+   #endif				/* WinGraphics */
+
+#endif					/* Graphics */
diff --git a/src/h/rmacros.h b/src/h/rmacros.h
new file mode 100644
index 0000000..cce26dd
--- /dev/null
+++ b/src/h/rmacros.h
@@ -0,0 +1,687 @@
+/*
+ *  Definitions for macros and manifest constants used in the compiler
+ *  interpreter.
+ */
+
+/*
+ *  Definitions common to the compiler and interpreter.
+ */
+
+/*
+ * Constants that are not likely to vary between implementations.
+ */
+
+#define BitOffMask (IntBits-1)
+#define CsetSize (256/IntBits)	/* number of ints to hold 256 cset
+				 *  bits. Use (256/IntBits)+1 if
+				 *  256 % IntBits != 0 */
+#define MinListSlots	    8	/* number of elements in an expansion
+				 * list element block  */
+
+#define MaxCvtLen	   257	/* largest string in conversions; the extra
+				 *  one is for a terminating null */
+#define MaxReadStr	   512	/* largest string to read() in one piece */
+#define MaxIn		  32767	/* largest number of bytes to read() at once */
+#define RandA        1103515245	/* random seed multiplier */
+#define RandC	      453816694	/* random seed additive constant */
+#define RanScale 4.65661286e-10	/* random scale factor = 1/(2^31-1) */
+
+#define Pi 3.14159265358979323846264338327950288419716939937511
+
+/*
+ * File status flags in status field of file blocks.
+ */
+#define Fs_Read		 01	/* read access */
+#define Fs_Write	 02	/* write access */
+#define Fs_Create	 04	/* file created on open */
+#define Fs_Append	010	/* append mode */
+#define Fs_Pipe		020	/* reading/writing on a pipe */
+#define Fs_Untrans    01000	/* untranslated mode file */
+#define Fs_Directory  02000	/* reading a directory */
+#define Fs_Reading     0100     /* last file operation was read */
+#define Fs_Writing     0200     /* last file operation was write */
+
+#ifdef Graphics
+   #define Fs_Window   0400	/* reading/writing on a window */
+
+   #define XKey_Window 0
+   #define XKey_Fg 1
+
+   #ifndef SHORT
+      #define SHORT int
+   #endif				/* SHORT */
+   #ifndef LONG
+      #define LONG int
+   #endif				/* LONG */
+
+   /*
+    * Perform a "C" return, not processed by RTT
+    */
+   #define VanquishReturn(s) return s;
+#endif					/* Graphics */
+
+/*
+ * Codes returned by runtime support routines.
+ *  Note, some conversion routines also return type codes. Other routines may
+ *  return positive values other than return codes. sort() places restrictions
+ *  on Less, Equal, and Greater.
+ */
+
+#define Less		-1
+#define Equal		0
+#define Greater		1
+
+#define CvtFail		-2
+#define Cvt		-3
+#define NoCvt		-4
+#define Failed		-5
+#define Defaulted	-6
+#define Succeeded	-7
+#define Error		-8
+
+#define GlobalName	0
+#define StaticName	1
+#define ParamName	2
+#define LocalName	3
+
+/*
+ * Pointer to block.
+ */
+#define BlkLoc(d)	((d).vword.bptr)
+
+/*
+ * Check for null-valued descriptor.
+ */
+#define ChkNull(d)	((d).dword==D_Null)
+
+/*
+ * Check for equivalent descriptors.
+ */
+#define EqlDesc(d1,d2)	((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2))
+
+/*
+ * Integer value.
+ */
+#define IntVal(d)	((d).vword.integr)
+
+/*
+ * Offset from top of block to value of variable.
+ */
+#define Offset(d)	((d).dword & OffsetMask)
+
+/*
+ * Check for pointer.
+ */
+#define Pointer(d)	((d).dword & F_Ptr)
+
+/*
+ * Check for qualifier.
+ */
+#define Qual(d)		(!((d).dword & F_Nqual))
+
+/*
+ * Length of string.
+ */
+#define StrLen(q)	((q).dword)
+
+/*
+ * Location of first character of string.
+ */
+#define StrLoc(q)	((q).vword.sptr)
+
+/*
+ * Assign a C string to a descriptor. Assume it is reasonable to use the
+ *   descriptor expression more than once, but not the string expression.
+ */
+#define AsgnCStr(d,s) (StrLoc(d) = (s), StrLen(d) = strlen(StrLoc(d)))
+
+/*
+ * Type of descriptor.
+ */
+#define Type(d)		(int)((d).dword & TypeMask)
+
+/*
+ * Check for variable.
+ */
+#define Var(d)		((d).dword & F_Var)
+
+/*
+ * Location of the value of a variable.
+ */
+#define VarLoc(d)	((d).vword.descptr)
+
+/*
+ *  Important note:  The code that follows is not strictly legal C.
+ *   It tests to see if pointer p2 is between p1 and p3. This may
+ *   involve the comparison of pointers in different arrays, which
+ *   is not well-defined.  The casts of these pointers to unsigned "words"
+ *   (longs or ints, depending) works with all C compilers and architectures
+ *   on which Icon has been implemented.  However, it is possible it will
+ *   not work on some system.  If it doesn't, there may be a "false
+ *   positive" test, which is likely to cause a memory violation or a
+ *   loop. It is not practical to implement Icon on a system on which this
+ *   happens.
+ */
+
+#define InRange(p1,p2,p3) ((uword)(p2) >= (uword)(p1) && (uword)(p2) < (uword)(p3))
+
+/*
+ * Get floating-point number from real block.
+ */
+#ifdef Double
+   #define GetReal(dp,res) *((struct size_dbl *)&(res)) =\
+         *((struct size_dbl *)&(BlkLoc(*dp)->realblk.realval))
+#else					/* Double */
+   #define GetReal(dp,res)	res = BlkLoc(*dp)->realblk.realval
+#endif					/* Double */
+
+/*
+ * Absolute value, maximum, and minimum.
+ * N.B. UNSAFE MACROS: may evaluate arguments multiple times.
+ */
+#define Abs(x)		(((x) < 0) ? (-(x)) : (x))
+#define Max(x,y)        ((x)>(y)?(x):(y))
+#define Min(x,y)        ((x)<(y)?(x):(y))
+
+/*
+ * Number of elements of a C array, and element size.
+ */
+#define ElemCount(a) (sizeof(a)/sizeof(a[0]))
+#define ElemSize(a) (sizeof(a[0]))
+
+/*
+ * Construct an integer descriptor.
+ */
+#define MakeInt(i,dp)		do { \
+			 (dp)->dword = D_Integer; \
+			 IntVal(*dp) = (word)(i); \
+			 } while (0)
+
+/*
+ * Construct a string descriptor.
+ */
+#define MakeStr(s,len,dp)      do { \
+			 StrLoc(*dp) = (s); \
+			 StrLen(*dp) = (len); \
+			 } while (0)
+
+/*
+ * Offset in word of cset bit.
+ */
+#define CsetOff(b)	((b) & BitOffMask)
+
+/*
+ * Set bit b in cset c.
+ */
+#define Setb(b,c)	(*CsetPtr(b,c) |= (01 << CsetOff(b)))
+
+/*
+ * Test bit b in cset c.
+ */
+#define Testb(b,c)	((*CsetPtr(b,c) >> CsetOff(b)) & 01)
+
+/*
+ * Check whether a set or table needs resizing.
+ */
+#define SP(p) ((struct b_set *)p)
+#define TooCrowded(p) \
+   ((SP(p)->size > MaxHLoad*(SP(p)->mask+1)) && (SP(p)->hdir[HSegs-1] == NULL))
+#define TooSparse(p) \
+   ((SP(p)->hdir[1] != NULL) && (SP(p)->size < MinHLoad*(SP(p)->mask+1)))
+
+/*
+ * Definitions and declarations used for storage management.
+ */
+#define F_Mark		0100000		/* bit for marking blocks */
+
+/*
+ * Argument values for the built-in Icon user function "collect()".
+ */
+#define Static  1			/* collection is for static region */
+#define Strings	2			/* collection is for strings */
+#define Blocks	3			/* collection is for blocks */
+
+/*
+ * Get type of block pointed at by x.
+ */
+#define BlkType(x)   (*(word *)x)
+
+/*
+ * BlkSize(x) takes the block pointed to by x and if the size of
+ *  the block as indicated by bsizes[] is nonzero it returns the
+ *  indicated size; otherwise it returns the second word in the
+ *  block contains the size.
+ */
+#define BlkSize(x) (bsizes[*(word *)x & ~F_Mark] ? \
+		     bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1))
+
+/*
+ * Here are the events we support (in addition to keyboard characters)
+ */
+#define MOUSELEFT	(-1)
+#define MOUSEMID	(-2)
+#define MOUSERIGHT	(-3)
+#define MOUSELEFTUP	(-4)
+#define MOUSEMIDUP	(-5)
+#define MOUSERIGHTUP	(-6)
+#define MOUSELEFTDRAG	(-7)
+#define MOUSEMIDDRAG	(-8)
+#define MOUSERIGHTDRAG	(-9)
+#define RESIZED		(-10)
+#define LASTEVENTCODE	RESIZED
+
+/*
+ * Type codes (descriptors and blocks).
+ */
+#define T_String	-1	/* string -- for reference; not used */
+#define T_Null		 0	/* null value */
+#define T_Integer	 1	/* integer */
+
+#ifdef LargeInts
+   #define T_Lrgint	 2	/* long integer */
+#endif					/* LargeInts */
+
+#define T_Real		 3	/* real number */
+#define T_Cset		 4	/* cset */
+#define T_File		 5	/* file */
+#define T_Proc		 6	/* procedure */
+#define T_Record	 7	/* record */
+#define T_List		 8	/* list header */
+#define T_Lelem		 9	/* list element */
+#define T_Set		10	/* set header */
+#define T_Selem		11	/* set element */
+#define T_Table		12	/* table header */
+#define T_Telem		13	/* table element */
+#define T_Tvtbl		14	/* table element trapped variable */
+#define T_Slots		15	/* set/table hash slots */
+#define T_Tvsubs	16	/* substring trapped variable */
+#define T_Refresh	17	/* refresh block */
+#define T_Coexpr	18	/* co-expression */
+#define T_External	19	/* external block */
+#define T_Kywdint	20	/* integer keyword */
+#define T_Kywdpos	21	/* keyword &pos */
+#define T_Kywdsubj	22	/* keyword &subject */
+#define T_Kywdwin	23	/* keyword &window */
+#define T_Kywdstr	24	/* string keyword */
+#define T_Kywdevent	25	/* keyword &eventsource, etc. */
+
+#define MaxType		26	/* maximum type number */
+
+/*
+ * Definitions for keywords.
+ */
+
+#define k_pos kywd_pos.vword.integr	/* value of &pos */
+#define k_random kywd_ran.vword.integr	/* value of &random */
+#define k_trace kywd_trc.vword.integr	/* value of &trace */
+#define k_dump kywd_dmp.vword.integr	/* value of &dump */
+
+#ifdef FncTrace
+   #define k_ftrace kywd_ftrc.vword.integr	/* value of &ftrace */
+#endif					/* FncTrace */
+
+/*
+ * Descriptor types and flags.
+ */
+
+#define D_Null		(T_Null     | D_Typecode)
+#define D_Integer	(T_Integer  | D_Typecode)
+
+#ifdef LargeInts
+   #define D_Lrgint	(T_Lrgint | D_Typecode | F_Ptr)
+#endif					/* LargeInts */
+
+#define D_Real		(T_Real     | D_Typecode | F_Ptr)
+#define D_Cset		(T_Cset     | D_Typecode | F_Ptr)
+#define D_File		(T_File     | D_Typecode | F_Ptr)
+#define D_Proc		(T_Proc     | D_Typecode | F_Ptr)
+#define D_List		(T_List     | D_Typecode | F_Ptr)
+#define D_Lelem		(T_Lelem    | D_Typecode | F_Ptr)
+#define D_Table		(T_Table    | D_Typecode | F_Ptr)
+#define D_Telem		(T_Telem    | D_Typecode | F_Ptr)
+#define D_Set		(T_Set      | D_Typecode | F_Ptr)
+#define D_Selem		(T_Selem    | D_Typecode | F_Ptr)
+#define D_Record	(T_Record   | D_Typecode | F_Ptr)
+#define D_Tvsubs	(T_Tvsubs   | D_Typecode | F_Ptr | F_Var)
+#define D_Tvtbl		(T_Tvtbl    | D_Typecode | F_Ptr | F_Var)
+#define D_Kywdint	(T_Kywdint  | D_Typecode | F_Ptr | F_Var)
+#define D_Kywdpos	(T_Kywdpos  | D_Typecode | F_Ptr | F_Var)
+#define D_Kywdsubj	(T_Kywdsubj | D_Typecode | F_Ptr | F_Var)
+#define D_Refresh	(T_Refresh  | D_Typecode | F_Ptr)
+#define D_Coexpr	(T_Coexpr   | D_Typecode | F_Ptr)
+#define D_External	(T_External | D_Typecode | F_Ptr)
+#define D_Slots		(T_Slots    | D_Typecode | F_Ptr)
+#define D_Kywdwin	(T_Kywdwin  | D_Typecode | F_Ptr | F_Var)
+#define D_Kywdstr	(T_Kywdstr  | D_Typecode | F_Ptr | F_Var)
+#define D_Kywdevent	(T_Kywdevent| D_Typecode | F_Ptr | F_Var)
+
+#define D_Var		(F_Var | F_Nqual | F_Ptr)
+#define D_Typecode	(F_Nqual | F_Typecode)
+
+#define TypeMask	63	/* type mask */
+#define OffsetMask	(~(D_Var)) /* offset mask for variables */
+
+/*
+ * "In place" dereferencing.
+ */
+#define Deref(d) if (Var(d)) deref(&d, &d)
+
+/*
+ * Construct a substring trapped variable.
+ */
+#define SubStr(dest,var,len,pos)\
+   if ((var)->dword == D_Tvsubs)\
+      (dest)->vword.bptr = (union block *)alcsubs(len, (pos) +\
+         BlkLoc(*(var))->tvsubs.sspos - 1, &BlkLoc(*(var))->tvsubs.ssvar);\
+   else\
+      (dest)->vword.bptr = (union block *)alcsubs(len, pos, (var));\
+   (dest)->dword = D_Tvsubs;
+
+/*
+ * Find debug struct in procedure frame, assuming debugging is enabled.
+ *  Note that there is always one descriptor in array even if it is not
+ *  being used.
+ */
+#define PFDebug(pf) ((struct debug *)((char *)(pf).tend.d +\
+   sizeof(struct descrip) * ((pf).tend.num ? (pf).tend.num : 1)))
+
+/*
+ * Macro for initialized procedure block.
+ */
+#define B_IProc(n) struct {word title; word blksize; int (*ccode)();\
+   word nparam; word ndynam; word nstatic; word fstatic;\
+   struct sdescrip quals[n];}
+
+#define ssize    (curstring->size)
+#define strbase  (curstring->base)
+#define strend   (curstring->end)
+#define strfree  (curstring->free)
+
+#define abrsize  (curblock->size)
+#define blkbase  (curblock->base)
+#define blkend   (curblock->end)
+#define blkfree  (curblock->free)
+
+#if COMPILER
+
+   #ifdef Graphics
+      #define Poll() if (!pollctr--) pollctr = pollevent()
+   #else				/* Graphics */
+      #define Poll()
+   #endif				/* Graphics */
+
+#else					/* COMPILER */
+
+   /*
+    * Definitions for the interpreter.
+    */
+
+   /*
+    * Codes returned by invoke to indicate action.
+    */
+   #define I_Builtin	201	/* A built-in routine is to be invoked */
+   #define I_Fail	202	/* goal-directed evaluation failed */
+   #define I_Continue	203	/* Continue execution in the interp loop */
+   #define I_Vararg	204	/* A function with a variable number of args */
+
+   /*
+    * Generator types.
+    */
+   #define G_Csusp		1
+   #define G_Esusp		2
+   #define G_Psusp		3
+   #define G_Fsusp		4
+   #define G_Osusp		5
+
+   /*
+    * Evaluation stack overflow margin
+    */
+   #define PerilDelta 100
+
+   /*
+    * Macros for pushing values on the interpreter stack.
+    */
+
+   /*
+    * Push descriptor.
+    */
+   #define PushDescSP(SP,d)  {*++SP=((d).dword); SP++; *SP =((d).vword.integr);}
+
+   /*
+    * Push null-valued descriptor.
+    */
+   #define PushNullSP(SP)	{*++SP = D_Null; SP++; *SP = 0;}
+
+   /*
+    * Push word.
+    */
+   #define PushValSP(SP,v)	{*++SP = (word)(v);}
+
+   /*
+    * Shorter Versions of the Push*SP macros that assume sp points to the top
+    * of the stack.
+    */
+   #define PushDesc(d)		PushDescSP(sp,d)
+   #define PushNull		PushNullSP(sp)
+   #define PushVal(x)		PushValSP(sp,x)
+   #define PushAVal(x)		PushValSP(sp,x)
+
+   /*
+    * Macros related to function and operator definition.
+    */
+
+   /*
+    * Procedure block for a function.
+    */
+
+   #define FncBlock(f,nargs,deref) \
+      struct b_iproc Cat(B,f) = {\
+      T_Proc,\
+      Vsizeof(struct b_proc),\
+      Cat(Z,f),\
+      nargs,\
+      -1,\
+      deref, 0,\
+      {sizeof(Lit(f))-1,Lit(f)}};
+
+   /*
+    * Procedure block for an operator.
+    */
+   #define OpBlock(f,nargs,sname,xtrargs)\
+      struct b_iproc Cat(B,f) = {\
+      T_Proc,\
+      Vsizeof(struct b_proc),\
+      Cat(O,f),\
+      nargs,\
+      -1,\
+      xtrargs,\
+      0,\
+      {sizeof(sname)-1,sname}};
+
+   /*
+    * Operator declaration.
+    */
+   #define OpDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(cargp) register dptr cargp;
+
+   /*
+    * Operator declaration with extra working argument.
+    */
+   #define OpDclE(nm,n,pn) OpBlock(nm,-n,pn,0) Cat(O,nm)(cargp) register dptr cargp;
+
+   /*
+    * Agent routine declaration.
+    */
+   #define AgtDcl(nm) Cat(A,nm)(cargp) register dptr cargp;
+
+   /*
+    * Macros to access Icon arguments in C functions.
+    */
+
+   /*
+    * n-th argument.
+    */
+   #define Arg(n)	(cargp[n])
+
+   /*
+    * Type field of n-th argument.
+    */
+   #define ArgType(n)	(cargp[n].dword)
+
+   /*
+    * Value field of n-th argument.
+    */
+   #define ArgVal(n)	(cargp[n].vword.integr)
+
+   /*
+    * Specific arguments.
+    */
+   #define Arg0	(cargp[0])
+   #define Arg1	(cargp[1])
+   #define Arg2	(cargp[2])
+   #define Arg3	(cargp[3])
+   #define Arg4	(cargp[4])
+   #define Arg5	(cargp[5])
+   #define Arg6	(cargp[6])
+   #define Arg7	(cargp[7])
+   #define Arg8	(cargp[8])
+
+   /*
+    * Miscellaneous macro definitions.
+    */
+
+   #ifdef MultiThread
+      #define glbl_argp (curpstate->Glbl_argp)
+      #define kywd_err  (curpstate->Kywd_err)
+      #define kywd_pos  (curpstate->Kywd_pos)
+      #define kywd_prog  (curpstate->Kywd_prog)
+      #define kywd_ran  (curpstate->Kywd_ran)
+      #define k_eventcode (curpstate->eventcode)
+      #define k_eventsource (curpstate->eventsource)
+      #define k_eventvalue (curpstate->eventval)
+      #define k_subject (curpstate->ksub)
+      #define kywd_trc  (curpstate->Kywd_trc)
+      #define mainhead (curpstate->Mainhead)
+      #define code (curpstate->Code)
+      #define ecode (curpstate->Ecode)
+      #define records (curpstate->Records)
+      #define ftabp (curpstate->Ftabp)
+      #ifdef FieldTableCompression
+         #define ftabwidth (curpstate->Ftabwidth)
+         #define foffwidth (curpstate->Foffwidth)
+         #define ftabcp (curpstate->Ftabcp)
+         #define ftabsp (curpstate->Ftabsp)
+         #define focp (curpstate->Focp)
+         #define fosp (curpstate->Fosp)
+         #define fo (curpstate->Fo)
+         #define bm (curpstate->Bm)
+      #endif				/* FieldTableCompression */
+      #define fnames (curpstate->Fnames)
+      #define efnames (curpstate->Efnames)
+      #define globals (curpstate->Globals)
+      #define eglobals (curpstate->Eglobals)
+      #define gnames (curpstate->Gnames)
+      #define egnames (curpstate->Egnames)
+      #define statics (curpstate->Statics)
+      #define estatics (curpstate->Estatics)
+      #define n_globals (curpstate->NGlobals)
+      #define n_statics (curpstate->NStatics)
+      #define strcons (curpstate->Strcons)
+      #define filenms (curpstate->Filenms)
+      #define efilenms (curpstate->Efilenms)
+      #define ilines (curpstate->Ilines)
+      #define elines (curpstate->Elines)
+      #define current_line_ptr (curpstate->Current_line_ptr)
+
+      #ifdef Graphics
+         #define amperX   (curpstate->AmperX)
+         #define amperY   (curpstate->AmperY)
+         #define amperRow (curpstate->AmperRow)
+         #define amperCol (curpstate->AmperCol)
+         #define amperInterval (curpstate->AmperInterval)
+         #define lastEventWin (curpstate->LastEventWin)
+         #define lastEvFWidth (curpstate->LastEvFWidth)
+         #define lastEvLeading (curpstate->LastEvLeading)
+         #define lastEvAscent (curpstate->LastEvAscent)
+         #define kywd_xwin (curpstate->Kywd_xwin)
+         #define xmod_control (curpstate->Xmod_Control)
+         #define xmod_shift (curpstate->Xmod_Shift)
+         #define xmod_meta (curpstate->Xmod_Meta)
+      #endif				/* Graphics */
+
+      #ifdef EventMon
+         #define linenum  (curpstate->Linenum)
+         #define column   (curpstate->Column)
+         #define lastline (curpstate->Lastline)
+         #define lastcol  (curpstate->Lastcol)
+      #endif				/* EventMon */
+
+      #define coexp_ser (curpstate->Coexp_ser)
+      #define list_ser  (curpstate->List_ser)
+      #define set_ser   (curpstate->Set_ser)
+      #define table_ser (curpstate->Table_ser)
+
+      #define curstring (curpstate->stringregion)
+      #define curblock  (curpstate->blockregion)
+      #define strtotal  (curpstate->stringtotal)
+      #define blktotal  (curpstate->blocktotal)
+
+      #define coll_tot  (curpstate->colltot)
+      #define coll_stat (curpstate->collstat)
+      #define coll_str  (curpstate->collstr)
+      #define coll_blk  (curpstate->collblk)
+
+      #define lastop    (curpstate->Lastop)
+      #define lastopnd  (curpstate->Lastopnd)
+
+      #define xargp     (curpstate->Xargp)
+      #define xnargs    (curpstate->Xnargs)
+
+      #define k_current     (curpstate->K_current)
+      #define k_errornumber (curpstate->K_errornumber)
+      #define k_errortext   (curpstate->K_errortext)
+      #define k_errorvalue  (curpstate->K_errorvalue)
+      #define have_errval   (curpstate->Have_errval)
+      #define t_errornumber (curpstate->T_errornumber)
+      #define t_have_val    (curpstate->T_have_val)
+      #define t_errorvalue  (curpstate->T_errorvalue)
+
+      #define k_main        (curpstate->K_main)
+      #define k_errout      (curpstate->K_errout)
+      #define k_input       (curpstate->K_input)
+      #define k_output      (curpstate->K_output)
+
+      #define ENTERPSTATE(p) if (((p)!=NULL)) { curpstate = (p); }
+   #endif				/* MultiThread */
+
+#endif					/* COMPILER */
+
+/*
+ * Constants controlling expression evaluation.
+ */
+#if COMPILER
+   #define A_Resume	-1	/* expression failed: resume a generator */
+   #define A_Continue	-2	/* expression returned: continue execution */
+   #define A_FallThru	-3      /* body function: fell through end of code */
+   #define A_Coact	1	/* co-expression activation */
+   #define A_Coret	2	/* co-expression return */
+   #define A_Cofail	3	/* co-expression failure */
+#else					/* COMPILER */
+   #define A_Resume	1	/* routine failed */
+   #define A_Pret_uw	2	/* interp unwind for Op_Pret */
+   #define A_Unmark_uw	3	/* interp unwind for Op_Unmark */
+   #define A_Pfail_uw	4	/* interp unwind for Op_Pfail */
+   #define A_Lsusp_uw	5	/* interp unwind for Op_Lsusp */
+   #define A_Eret_uw	6	/* interp unwind for Op_Eret */
+   #define A_Continue	7	/* routine returned */
+   #define A_Coact	8	/* co-expression activated */
+   #define A_Coret	9	/* co-expression returned */
+   #define A_Cofail	10	/* co-expression failed */
+   #ifdef MultiThread
+      #define A_MTEvent	11	/* multithread event */
+   #endif				/* MultiThread */
+#endif					/* COMPILER */
+
+/*
+ * Address of word containing cset bit b (c is a struct descrip of type Cset).
+ */
+#define CsetPtr(b,c)	(BlkLoc(c)->cset.bits + (((b)&0377) >> LogIntBits))
diff --git a/src/h/rproto.h b/src/h/rproto.h
new file mode 100644
index 0000000..3a5cc30
--- /dev/null
+++ b/src/h/rproto.h
@@ -0,0 +1,481 @@
+/*
+ * Prototypes for run-time functions.
+ */
+
+/*
+ * Prototypes common to the compiler and interpreter.
+ */
+void		EVInit		(void);
+int		activate	(dptr val, struct b_coexpr *ncp, dptr result);
+word		add		(word a,word b);
+void		addmem (struct b_set *ps, struct b_selem *pe, union block **pl);
+struct astkblk	*alcactiv	(void);
+struct b_cset	*alccset	(void);
+struct b_file	*alcfile	(FILE *fd,int status,dptr name);
+union block	*alchash	(int tcode);
+struct b_list	*alclist	(uword size);
+struct b_lelem	*alclstb	(uword nslots,uword first,uword nused);
+struct b_real	*alcreal	(double val);
+struct b_slots	*alcsegment	(word nslots);
+struct b_selem	*alcselem	(dptr mbr,uword hn);
+char		*alcstr		(char	*s,word slen);
+struct b_telem	*alctelem	(void);
+struct b_tvtbl	*alctvtbl	(dptr tbl,dptr ref,uword hashnum);
+int		anycmp		(dptr dp1,dptr dp2);
+int		bfunc		(void);
+struct b_proc	*bi_strprc	(dptr s, C_integer arity);
+void		c_exit		(int i);
+int		c_get		(struct b_list *hp, struct descrip *res);
+void		c_put		(struct descrip *l, struct descrip *val);
+int		cnv_c_dbl	(dptr s, double *d);
+int		cnv_c_int	(dptr s, C_integer *d);
+int		cnv_c_str	(dptr s, dptr d);
+int		cnv_cset	(dptr s, dptr d);
+int		cnv_ec_int	(dptr s, C_integer *d);
+int		cnv_eint	(dptr s, dptr d);
+int		cnv_int		(dptr s, dptr d);
+int		cnv_real	(dptr s, dptr d);
+int		cnv_str		(dptr s, dptr d);
+int		cnv_tcset	(struct b_cset *cbuf, dptr s, dptr d);
+int		cnv_tstr	(char *sbuf, dptr s, dptr d);
+int		co_chng		(struct b_coexpr *ncp, struct descrip *valloc,
+				   struct descrip *rsltloc,
+				   int swtch_typ, int first);
+void		co_init		(struct b_coexpr *sblkp);
+void		coclean		(word *old);
+void		coacttrace	(struct b_coexpr *ccp,struct b_coexpr *ncp);
+void		cofailtrace	(struct b_coexpr *ccp,struct b_coexpr *ncp);
+void		corettrace	(struct b_coexpr *ccp,struct b_coexpr *ncp);
+int		coswitch	(word *old, word *new, int first);
+int		cplist		(dptr dp1,dptr dp2,word i,word j);
+int		cpset		(dptr dp1,dptr dp2,word size);
+void		cpslots		(dptr dp1,dptr slotptr,word i, word j);
+int		csetcmp		(unsigned int *cs1,unsigned int *cs2);
+int		cssize		(dptr dp);
+word		cvpos		(long pos,long len);
+void		datainit	(void);
+void		deallocate	(union block *bp);
+int		def_c_dbl	(dptr s, double df, double * d);
+int		def_c_int	(dptr s, C_integer df, C_integer * d);
+int		def_c_str	(dptr s, char * df, dptr d);
+int		def_cset	(dptr s, struct b_cset * df, dptr d);
+int		def_ec_int	(dptr s, C_integer df, C_integer * d);
+int		def_eint	(dptr s, C_integer df, dptr d);
+int		def_int		(dptr s, C_integer df, dptr d);
+int		def_real	(dptr s, double df, dptr d);
+int		def_str		(dptr s, dptr df, dptr d);
+int		def_tcset (struct b_cset *cbuf,dptr s,struct b_cset *df,dptr d);
+int		def_tstr	(char *sbuf, dptr s, dptr df, dptr d);
+word		div3		(word a,word b);
+int		doasgn		(dptr dp1,dptr dp2);
+int		doimage		(int c,int q);
+int		dp_pnmcmp	(struct pstrnm *pne,dptr dp);
+void		drunerr		(int n, double v);
+void		dumpact		(struct b_coexpr *ce);
+void		env_int	(char *name,word *variable,int non_neg, uword limit);
+int		equiv		(dptr dp1,dptr dp2);
+int		err		(void);
+void		err_msg		(int n, dptr v);
+void		error		(char *s1, char *s2);
+void		fatalerr	(int n,dptr v);
+int		findcol		(word *ipc);
+char		*findfile	(word *ipc);
+int		findipc		(int line);
+int		findline	(word *ipc);
+int		findloc		(word *ipc);
+void		fpetrap		(int);
+int		getvar		(char *s,dptr vp);
+uword		hash		(dptr dp);
+union block	**hchain	(union block *pb,uword hn);
+union block	*hgfirst	(union block *bp, struct hgstate *state);
+union block	*hgnext		(union block*b,struct hgstate*s,union block *e);
+union block	*hmake		(int tcode,word nslots,word nelem);
+void		icon_init	(char *name, int *argcp, char *argv[]);
+void		iconhost	(char *hostname);
+int		idelay		(int n);
+int		interp		(int fsig,dptr cargp);
+void		irunerr		(int n, C_integer v);
+int		lexcmp		(dptr dp1,dptr dp2);
+word		longread	(char *s,int width,long len,FILE *fname);
+union block	**memb		(union block *pb,dptr x,uword hn, int *res);
+void		mksubs		(dptr var,dptr val,word i,word j, dptr result);
+word		mod3		(word a,word b);
+word		mul		(word a,word b);
+word		neg		(word a);
+void		new_context	(int fsig, dptr cargp); /* w/o Coexpr: a stub */
+int		numcmp		(dptr dp1,dptr dp2,dptr dp3);
+void		outimage	(FILE *f,dptr dp,int noimage);
+struct b_coexpr	*popact		(struct b_coexpr *ce);
+word		prescan		(dptr d);
+int		pstrnmcmp	(struct pstrnm *a,struct pstrnm *b);
+int		pushact		(struct b_coexpr *ce, struct b_coexpr *actvtr);
+int		putstr		(FILE *f,dptr d);
+char		*qsearch	(char *key, char *base, int nel, int width,
+				   int (*cmp)());
+int		qtos		(dptr dp,char *sbuf);
+int		 radix		(int sign, register int r, register char *s,
+				   register char *end_s, union numeric *result);
+char		*reserve	(int region, word nbytes);
+void		retderef		(dptr valp, word *low, word *high);
+void		segvtrap	(int);
+void		stkdump		(int);
+word		sub		(word a,word b);
+void		syserr		(char *s);
+struct b_coexpr	*topact		(struct b_coexpr *ce);
+void		xmfree		(void);
+
+#ifdef MultiThread
+   void	resolve			(struct progstate *pstate);
+   struct b_coexpr *loadicode (char *name, struct b_file *theInput,
+      struct b_file *theOutput, struct b_file *theError,
+      C_integer bs, C_integer ss, C_integer stk);
+   void actparent (int eventcode);
+   int mt_activate   (dptr tvalp, dptr rslt, struct b_coexpr *ncp);
+#else					/* MultiThread */
+   void	resolve			(void);
+#endif					/* MultiThread */
+
+#ifdef EventMon
+   void EVAsgn	(dptr dx);
+#endif					/* EventMon */
+
+#ifdef ExternalFunctions
+   dptr	extcall			(dptr x, int nargs, int *signal);
+#endif					/* ExternalFunctions */
+
+#ifdef LargeInts
+   struct b_bignum *alcbignum	(word n);
+   word		bigradix	(int sign, int r, char *s, char *x,
+						   union numeric *result);
+   double	bigtoreal	(dptr da);
+   int		realtobig	(dptr da, dptr dx);
+   int		bigtos		(dptr da, dptr dx);
+   void		bigprint	(FILE *f, dptr da);
+   int		cpbignum	(dptr da, dptr db);
+   int		bigadd		(dptr da, dptr db, dptr dx);
+   int		bigsub		(dptr da, dptr db, dptr dx);
+   int		bigmul		(dptr da, dptr db, dptr dx);
+   int		bigdiv		(dptr da, dptr db, dptr dx);
+   int		bigmod		(dptr da, dptr db, dptr dx);
+   int		bigneg		(dptr da, dptr dx);
+   int		bigpow		(dptr da, dptr db, dptr dx);
+   int		bigpowri        (double a, dptr db, dptr drslt);
+   int		bigand		(dptr da, dptr db, dptr dx);
+   int		bigor		(dptr da, dptr db, dptr dx);
+   int		bigxor		(dptr da, dptr db, dptr dx);
+   int		bigshift	(dptr da, dptr db, dptr dx);
+   word		bigcmp		(dptr da, dptr db);
+   int		bigrand		(dptr da, dptr dx);
+#endif					/* LargeInts */
+
+#ifdef FAttrib
+   char *make_mode(mode_t st_mode);
+#endif					/* FAttrib */
+
+#ifdef Graphics
+   /*
+    * portable graphics routines in rwindow.r and rwinrsc.r
+    */
+   wcp	alc_context	(wbp w);
+   wbp	alc_wbinding	(void);
+   wsp	alc_winstate	(void);
+   int	atobool		(char *s);
+   void	c_push		(dptr l,dptr val);  /* in fstruct.r */
+   int	docircles	(wbp w, int argc, dptr argv, int fill);
+   void	drawCurve	(wbp w, XPoint *p, int n);
+   char	*evquesub	(wbp w, int i);
+   void	genCurve	(wbp w, XPoint *p, int n, void (*h)());
+   wsp	getactivewindow	(void);
+   int	getpattern	(wbp w, char *answer);
+   struct palentry *palsetup(int p);
+   int	palnum		(dptr d);
+   int	parsecolor	(wbp w, char *s, long *r, long *g, long *b);
+   int	parsefont	(char *s, char *fam, int *sty, int *sz);
+   int	parsegeometry	(char *buf, SHORT *x, SHORT *y, SHORT *w, SHORT *h);
+   int	parsepattern	(char *s, int len, int *w, int *nbits, C_integer *bits);
+   void	qevent		(wsp ws, dptr e, int x, int y, uword t, long f);
+   int	readGIF		(char *fname, int p, struct imgdata *d);
+   int	rectargs	(wbp w, int argc, dptr argv, int i,
+			   word *px, word *py, word *pw, word *ph);
+   char	*rgbkey		(int p, double r, double g, double b);
+   int	setsize		(wbp w, char *s);
+   char	*si_i2s		(siptr sip, int i);
+   int	si_s2i		(siptr sip, char *s);
+   int	ulcmp		(pointer p1, pointer p2);
+   int	wattrib		(wbp w, char *s, long len, dptr answer, char *abuf);
+   int	wgetche		(wbp w, dptr res);
+   int	wgetchne	(wbp w, dptr res);
+   int	wgetevent	(wbp w, dptr res);
+   int	wgetstrg	(char *s, long maxlen, FILE *f);
+   void	wgoto		(wbp w, int row, int col);
+   int	wlongread	(char *s, int elsize, int nelem, FILE *f);
+   void	wputstr		(wbp w, char *s, int len);
+   int	writeGIF	(wbp w, char *filename,
+			  int x, int y, int width, int height);
+   int	xyrowcol	(dptr dx);
+
+   /*
+    * graphics implementation routines supplied for each platform
+    * (excluding those defined as macros for X-windows)
+    */
+   int	SetPattern	(wbp w, char *name, int len);
+   int	SetPatternBits	(wbp w, int width, C_integer *bits, int nbits);
+   int	allowresize	(wbp w, int on);
+   int	blimage		(wbp w, int x, int y, int wd, int h,
+			  int ch, unsigned char *s, word len);
+   int	capture		(wbp w, int x, int y, int width, int hgt, short *data);
+   wcp	clone_context	(wbp w);
+   int	copyArea	(wbp w,wbp w2,int x,int y,int wd,int h,int x2,int y2);
+   int	do_config	(wbp w, int status);
+   int	dumpimage	(wbp w, char *filename, unsigned int x, unsigned int y,
+			   unsigned int width, unsigned int height);
+   void	eraseArea	(wbp w, int x, int y, int width, int height);
+   void	fillrectangles	(wbp w, XRectangle *recs, int nrecs);
+   void	free_binding	(wbp w);
+   void	free_context	(wcp wc);
+   void	free_mutable	(wbp w, int mute_index);
+   int	free_window	(wsp ws);
+   void	freecolor	(wbp w, char *s);
+   char	*get_mutable_name (wbp w, int mute_index);
+   void	getbg		(wbp w, char *answer);
+   void	getcanvas	(wbp w, char *s);
+   int	getdefault	(wbp w, char *prog, char *opt, char *answer);
+   void	getdisplay	(wbp w, char *answer);
+   void	getdrawop	(wbp w, char *answer);
+   void	getfg		(wbp w, char *answer);
+   void	getfntnam	(wbp w, char *answer);
+   void	geticonic	(wbp w, char *answer);
+   int	geticonpos	(wbp w, char *s);
+   void	getlinestyle	(wbp w, char *answer);
+   int	getpixel_init	(wbp w, struct imgmem *imem);
+   int	getpixel_term	(wbp w, struct imgmem *imem);
+   int	getpixel	(wbp w,int x,int y,long *rv,char *s,struct imgmem *im);
+   void	getpointername	(wbp w, char *answer);
+   int	getpos		(wbp w);
+   int	getvisual	(wbp w, char *answer);
+   int	isetbg		(wbp w, int bg);
+   int	isetfg		(wbp w, int fg);
+   int	lowerWindow	(wbp w);
+   int	mutable_color	(wbp w, dptr argv, int ac, int *retval);
+   int	nativecolor	(wbp w, char *s, long *r, long *g, long *b);
+
+   int pollevent	(void);
+   void wflush		(wbp w);
+
+   int	query_pointer	(wbp w, XPoint *pp);
+   int	query_rootpointer (XPoint *pp);
+   int	raiseWindow	(wbp w);
+   int	readimage	(wbp w, char *filename, int x, int y, int *status);
+   int	rebind		(wbp w, wbp w2);
+   int	set_mutable	(wbp w, int i, char *s);
+   int	setbg		(wbp w, char *s);
+   int	setcanvas	(wbp w, char *s);
+   void	setclip		(wbp w);
+   int	setcursor	(wbp w, int on);
+   int	setdisplay	(wbp w, char *s);
+   int	setdrawop	(wbp w, char *val);
+   int	setfg		(wbp w, char *s);
+   int	setfillstyle	(wbp w, char *s);
+   int	setfont		(wbp w, char **s);
+   int	setgamma	(wbp w, double gamma);
+   int	setgeometry	(wbp w, char *geo);
+   int	setheight	(wbp w, SHORT new_height);
+   int	seticonicstate	(wbp w, char *s);
+   int	seticonlabel	(wbp w, char *val);
+   int	seticonpos	(wbp w, char *s);
+   int	setimage	(wbp w, char *val);
+   int	setleading	(wbp w, int i);
+   int	setlinestyle	(wbp w, char *s);
+   int	setlinewidth	(wbp w, LONG linewid);
+   int	setpointer	(wbp w, char *val);
+   int	setwidth	(wbp w, SHORT new_width);
+   int	setwindowlabel	(wbp w, char *val);
+   int	strimage	(wbp w, int x, int y, int width, int height,
+			   struct palentry *e, unsigned char *s,
+			   word len, int on_icon);
+   void	toggle_fgbg	(wbp w);
+   int	walert		(wbp w, int volume);
+   void	warpPointer	(wbp w, int x, int y);
+   int	wclose		(wbp w);
+   void	wflush		(wbp w);
+   int	wgetq		(wbp w, dptr res);
+   FILE	*wopen		(char *nm, struct b_list *hp, dptr attr, int n, int *e);
+   int	wputc		(int ci, wbp w);
+   #ifndef wsync
+   void	wsync		(wbp w);
+   #endif				/* wsync */
+   void	xdis		(wbp w, char *s, int n);
+
+   #ifdef XWindows
+      /*
+       * Implementation routines specific to X-Windows
+       */
+      void	unsetclip		(wbp w);
+      int	moveResizeWindow	(wbp w, int x, int y, int wd, int h);
+      int	resetfg			(wbp w);
+      int	setfgrgb		(wbp w, int r, int g, int b);
+      int	setbgrgb		(wbp w, int r, int g, int b);
+
+      XColor	xcolor			(wbp w, LinearColor clr);
+      LinearColor	lcolor		(wbp w, XColor color);
+      int	pixmap_open		(wbp w, dptr attribs, int argc);
+      int	pixmap_init		(wbp w);
+      int	remap			(wbp w, int x, int y);
+      int	seticonimage		(wbp w, dptr dp);
+      int	translate_key_event	(XKeyEvent *k1, char *s, KeySym *k2);
+      wdp	alc_display		(char *s);
+      void	free_display		(wdp wd);
+      wfp	alc_font		(wbp w, char **s);
+      wfp	tryfont			(wbp w, char *s);
+      wclrp	alc_rgb			(wbp w, char *s, unsigned int r,
+					   unsigned int g, unsigned int b,
+					   int is_iconcolor);
+      int	alc_centry		(wdp wd);
+      wclrp	alc_color		(wbp w, char *s);
+      void	copy_colors		(wbp w1, wbp w2);
+      void	free_xcolor		(wbp w, unsigned long c);
+      void	free_xcolors		(wbp w, int extent);
+      int	go_virtual		(wbp w);
+      int	resizePixmap		(wbp w, int width, int height);
+      void	wflushall		(void);
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      /*
+       * Implementation routines specific to MS Windows
+       */
+      int playmedia		(wbp w, char *s);
+      char *nativecolordialog	(wbp w,long r,long g, long b,char *s);
+      int nativefontdialog	(wbp w, char *buf, int flags, int fheight);
+      char *nativeopendialog	(wbp w,char *s1,char *s2,char *s3,int i,int j);
+      char *nativeselectdialog	(wbp w,struct b_list *,char *s);
+      char *nativesavedialog	(wbp w,char *s1,char *s2,char *s3,int i,int j);
+      HFONT mkfont		(char *s);
+      int sysTextWidth		(wbp w, char *s, int n);
+      int sysFontHeight		(wbp w);
+      int mswinsystem		(char *s);
+      void UpdateCursorPos	(wsp ws, wcp wc);
+      LRESULT_CALLBACK WndProc	(HWND, UINT, WPARAM, LPARAM);
+      HDC CreateWinDC		(wbp);
+      HDC CreatePixDC		(wbp, HDC);
+      HBITMAP loadimage	(wbp wb, char *filename, unsigned int *width,
+			unsigned int *height, int atorigin, int *status);
+      void wfreersc();
+      int getdepth(wbp w);
+      HBITMAP CreateBitmapFromData(char *data);
+      int resizePixmap(wbp w, int width, int height);
+      int textWidth(wbp w, char *s, int n);
+      int	seticonimage		(wbp w, dptr dp);
+      int devicecaps(wbp w, int i);
+      void fillarcs(wbp wb, XArc *arcs, int narcs);
+      void drawarcs(wbp wb, XArc *arcs, int narcs);
+      void drawlines(wbinding *wb, XPoint *points, int npoints);
+      void drawpoints(wbinding *wb, XPoint *points, int npoints);
+      void drawrectangles(wbp wb, XRectangle *recs, int nrecs);
+      void fillpolygon(wbp w, XPoint *pts, int npts);
+      void drawsegments(wbinding *wb, XSegment *segs, int nsegs);
+      void drawstrng(wbinding *wb, int x, int y, char *s, int slen);
+      void unsetclip(wbp w);
+
+   #endif				/* WinGraphics */
+
+#endif					/* Graphics */
+
+/*
+ * Prototypes for the run-time system.
+ */
+
+struct b_external *alcextrnl	(int n);
+struct b_record *alcrecd	(int nflds,union block *recptr);
+struct b_tvsubs *alcsubs	(word len,word pos,dptr var);
+int	bfunc		(void);
+long	ckadd		(long i, long j);
+long	ckmul		(long i, long j);
+long	cksub		(long i, long j);
+void	cmd_line	(int argc, char **argv, dptr rslt);
+struct b_coexpr *create	(continuation fnc,struct b_proc *p,int ntmp,int wksz);
+int	collect		(int region);
+void	cotrace		(struct b_coexpr *ccp, struct b_coexpr *ncp,
+			   int swtch_typ, dptr valloc);
+int	cvcset		(dptr dp,int * *cs,int *csbuf);
+int	cvnum		(dptr dp,union numeric *result);
+int	cvreal		(dptr dp,double *r);
+void	deref		(dptr dp1, dptr dp2);
+void	envset		(void);
+int	eq		(dptr dp1,dptr dp2);
+int	get_name	(dptr dp1, dptr dp2);
+int	getch		(void);
+int	getche		(void);
+double	getdbl		(dptr dp);
+int	getimage	(dptr dp1, dptr dp2);
+int	getstrg		(char *buf, int maxi, struct b_file *fbp);
+void	hgrow		(union block *bp);
+void	hshrink		(union block *bp);
+C_integer iipow		(C_integer n1, C_integer n2);
+void	init		(char *name, int *argcp, char *argv[], int trc_init);
+int	kbhit		(void);
+int	mkreal		(double r,dptr dp);
+int	nthcmp		(dptr d1,dptr d2);
+void	nxttab		(C_integer *col, dptr *tablst, dptr endlst,
+			   C_integer *last, C_integer *interval);
+int	order		(dptr dp);
+int	printable	(int c);
+int	ripow		(double r, C_integer n, dptr rslt);
+void	rtos		(double n,dptr dp,char *s);
+int	sig_rsm		(void);
+struct b_proc *strprc	(dptr s, C_integer arity);
+int	subs_asgn	(dptr dest, const dptr src);
+int	trcmp3		(struct dpair *dp1,struct dpair *dp2);
+int	trefcmp		(dptr d1,dptr d2);
+int	tvalcmp		(dptr d1,dptr d2);
+int	tvcmp4		(struct dpair *dp1,struct dpair *dp2);
+int	tvtbl_asgn	(dptr dest, const dptr src);
+void	varargs		(dptr argp, int nargs, dptr rslt);
+
+#ifdef MultiThread
+   struct b_coexpr *alccoexp (long icodesize, long stacksize);
+#else					/* MultiThread */
+   struct b_coexpr *alccoexp (void);
+#endif					/* MultiThread */
+
+#if COMPILER
+
+   struct b_refresh *alcrefresh	(int na, int nl, int nt, int wk_sz);
+   void	atrace			(void);
+   void	ctrace			(void);
+   void	failtrace		(void);
+   void	initalloc		(void);
+   int	invoke			(int n, dptr args, dptr rslt, continuation c);
+   void	rtrace			(void);
+   void	strace			(void);
+   void	tracebk			(struct p_frame *lcl_pfp, dptr argp);
+   int	xdisp			(struct p_frame *fp, dptr dp, int n, FILE *f);
+
+#else					/* COMPILER */
+
+   struct b_refresh *alcrefresh	(word *e, int nl, int nt);
+   void	atrace			(dptr dp);
+   void	ctrace			(dptr dp, int nargs, dptr arg);
+   void	failtrace		(dptr dp);
+   int	invoke			(int nargs, dptr *cargs, int *n);
+   void	rtrace			(dptr dp, dptr rval);
+   void	strace			(dptr dp, dptr rval);
+   void	tracebk			(struct pf_marker *lcl_pfp, dptr argp);
+   int	xdisp			(struct pf_marker *fp, dptr dp, int n, FILE *f);
+
+   #define Fargs dptr cargp
+   int	Obscan			(int nargs, Fargs);
+   int	Ocreate			(word *entryp, Fargs);
+   int	Oescan			(int nargs, Fargs);
+   int	Ofield			(int nargs, Fargs);
+   int	Olimit			(int nargs, Fargs);
+   int	Ollist			(int nargs, Fargs);
+   int	Omkrec			(int nargs, Fargs);
+
+   #ifdef MultiThread
+      void	initalloc	(word codesize, struct progstate *p);
+   #else				/* MultiThread */
+      void	initalloc	(word codesize);
+   #endif				/* MultiThread */
+
+#endif					/* COMPILER */
diff --git a/src/h/rstructs.h b/src/h/rstructs.h
new file mode 100644
index 0000000..5ee3fbb
--- /dev/null
+++ b/src/h/rstructs.h
@@ -0,0 +1,555 @@
+/*
+ * Run-time data structures.
+ */
+
+/*
+ * Structures common to the compiler and interpreter.
+ */
+
+/*
+ * Run-time error numbers and text.
+ */
+struct errtab {
+   int err_no;			/* error number */
+   char *errmsg;		/* error message */
+   };
+
+/*
+ * Descriptor
+ */
+
+struct descrip {		/* descriptor */
+   word dword;			/*   type field */
+   union {
+      word integr;		/*   integer value */
+      char *sptr;		/*   pointer to character string */
+      union block *bptr;	/*   pointer to a block */
+      dptr descptr;		/*   pointer to a descriptor */
+      } vword;
+   };
+
+struct sdescrip {
+   word length;			/*   length of string */
+   char *string;		/*   pointer to string */
+   };
+
+#ifdef LargeInts
+struct b_bignum {		/* large integer block */
+   word title;			/*   T_Lrgint */
+   word blksize;		/*   block size */
+   word msd, lsd;		/*   most and least significant digits */
+   int sign;			/*   sign; 0 positive, 1 negative */
+   DIGIT digits[1];		/*   digits */
+   };
+#endif					/* LargeInts */
+
+struct b_real {			/* real block */
+   word title;			/*   T_Real */
+   double realval;		/*   value */
+   };
+
+struct b_cset {			/* cset block */
+   word title;			/*   T_Cset */
+   word size;			/*   size of cset */
+   unsigned int bits[CsetSize];		/*   array of bits */
+   };
+
+struct b_file {			/* file block */
+   word title;			/*   T_File */
+   FILE *fd;			/*   Unix file descriptor */
+   word status;			/*   file status */
+   struct descrip fname;	/*   file name (string qualifier) */
+   };
+
+struct b_lelem {		/* list-element block */
+   word title;			/*   T_Lelem */
+   word blksize;		/*   size of block */
+   union block *listprev;	/*   previous list-element block */
+   union block *listnext;	/*   next list-element block */
+   word nslots;			/*   total number of slots */
+   word first;			/*   index of first used slot */
+   word nused;			/*   number of used slots */
+   struct descrip lslots[1];	/*   array of slots */
+   };
+
+struct b_list {			/* list-header block */
+   word title;			/*   T_List */
+   word size;			/*   current list size */
+   word id;			/*   identification number */
+   union block *listhead;	/*   pointer to first list-element block */
+   union block *listtail;	/*   pointer to last list-element block */
+   };
+
+struct b_proc {			/* procedure block */
+   word title;			/*   T_Proc */
+   word blksize;		/*   size of block */
+
+   #if COMPILER
+      int (*ccode)();
+   #else				/* COMPILER */
+      union {			/*   entry points for */
+         int (*ccode)();	/*     C routines */
+         uword ioff;		/*     and icode as offset */
+         pointer icode;		/*     and icode as absolute pointer */
+         } entryp;
+   #endif				/* COMPILER */
+
+   word nparam;			/*   number of parameters */
+   word ndynam;			/*   number of dynamic locals */
+   word nstatic;		/*   number of static locals */
+   word fstatic;		/*   index (in global table) of first static */
+
+   struct descrip pname;	/*   procedure name (string qualifier) */
+   struct descrip lnames[1];	/*   list of local names (qualifiers) */
+   };
+
+struct b_record {		/* record block */
+   word title;			/*   T_Record */
+   word blksize;		/*   size of block */
+   word id;			/*   identification number */
+   union block *recdesc;	/*   pointer to record constructor */
+   struct descrip fields[1];	/*   fields */
+   };
+
+/*
+ * Alternate uses for procedure block fields, applied to records.
+ */
+#define nfields	nparam		/* number of fields */
+#define recnum nstatic		/* record number */
+#define recid fstatic		/* record serial number */
+#define recname	pname		/* record name */
+
+struct b_selem {		/* set-element block */
+   word title;			/*   T_Selem */
+   union block *clink;		/*   hash chain link */
+   uword hashnum;		/*   hash number */
+   struct descrip setmem;	/*   the element */
+   };
+
+/*
+ * A set header must be a proper prefix of a table header,
+ *  and a set element must be a proper prefix of a table element.
+ */
+struct b_set {			/* set-header block */
+   word title;			/*   T_Set */
+   word size;			/*   size of the set */
+   word id;			/*   identification number */
+   word mask;			/*   mask for slot num, equals n slots - 1 */
+   struct b_slots *hdir[HSegs];	/*   directory of hash slot segments */
+   };
+
+struct b_table {		/* table-header block */
+   word title;			/*   T_Table */
+   word size;			/*   current table size */
+   word id;			/*   identification number */
+   word mask;			/*   mask for slot num, equals n slots - 1 */
+   struct b_slots *hdir[HSegs];	/*   directory of hash slot segments */
+   struct descrip defvalue;	/*   default table element value */
+   };
+
+struct b_slots {		/* set/table hash slots */
+   word title;			/*   T_Slots */
+   word blksize;		/*   size of block */
+   union block *hslots[HSlots];	/*   array of slots (HSlots * 2^n entries) */
+   };
+
+struct b_telem {		/* table-element block */
+   word title;			/*   T_Telem */
+   union block *clink;		/*   hash chain link */
+   uword hashnum;		/*   for ordering chain */
+   struct descrip tref;		/*   entry value */
+   struct descrip tval;		/*   assigned value */
+   };
+
+struct b_tvsubs {		/* substring trapped variable block */
+   word title;			/*   T_Tvsubs */
+   word sslen;			/*   length of substring */
+   word sspos;			/*   position of substring */
+   struct descrip ssvar;	/*   variable that substring is from */
+   };
+
+struct b_tvtbl {		/* table element trapped variable block */
+   word title;			/*   T_Tvtbl */
+   union block *clink;		/*   pointer to table header block */
+   uword hashnum;		/*   hash number */
+   struct descrip tref;		/*   entry value */
+   };
+
+struct b_external {		/* external block */
+   word title;			/*   T_External */
+   word blksize;		/*   size of block */
+   word exdata[1];		/*   words of external data */
+   };
+
+struct astkblk {		  /* co-expression activator-stack block */
+   int nactivators;		  /*   valid activator entries in this block */
+   struct astkblk *astk_nxt;	  /*   next activator block */
+   struct actrec {		  /*   activator record */
+      word acount;		  /*     number of calls by this activator */
+      struct b_coexpr *activator; /*     the activator itself */
+      } arec[ActStkBlkEnts];
+   };
+
+/*
+ * Structure for keeping set/table generator state across a suspension.
+ */
+struct hgstate {		/* hashed-structure generator state */
+   int segnum;			/* current segment number */
+   word slotnum;		/* current slot number */
+   word tmask;			/* structure mask before suspension */
+   word sgmask[HSegs];		/* mask in use when the segment was created */
+   uword sghash[HSegs];		/* hashnum in process when seg was created */
+   };
+
+/*
+ * Structure for chaining tended descriptors.
+ */
+struct tend_desc {
+   struct tend_desc *previous;
+   int num;
+   struct descrip d[1]; /* actual size of array indicated by num */
+   };
+
+/*
+ * Structure for mapping string names of functions and operators to block
+ * addresses.
+ */
+struct pstrnm {
+   char *pstrep;
+   struct b_proc *pblock;
+   };
+
+struct dpair {
+   struct descrip dr;
+   struct descrip dv;
+   };
+
+/*
+ * Allocated memory region structure.  Each program has linked lists of
+ * string and block regions.
+ */
+struct region {
+   word  size;				/* allocated region size in bytes */
+   char *base;				/* start of region */
+   char *end;				/* end of region */
+   char *free;				/* free pointer */
+   struct region *prev, *next;		/* forms a linked list of regions */
+   struct region *Gprev, *Gnext;	/* global (all programs) lists */
+   };
+
+#ifdef Double
+   /*
+    * Data type the same size as a double but without alignment requirements.
+    */
+   struct size_dbl {
+      char s[sizeof(double)];
+      };
+#endif					/* Double */
+
+#if COMPILER
+
+/*
+ * Structures for the compiler.
+ */
+   struct p_frame {
+      struct p_frame *old_pfp;
+      struct descrip *old_argp;
+      struct descrip *rslt;
+      continuation succ_cont;
+      struct tend_desc tend;
+      };
+   #endif				/* COMPILER */
+
+/*
+ * when debugging is enabled a debug struct is placed after the tended
+ *  descriptors in the procedure frame.
+ */
+struct debug {
+   struct b_proc *proc;
+   char *old_fname;
+   int old_line;
+   };
+
+union numeric {			/* long integers or real numbers */
+   long integer;
+   double real;
+   #ifdef LargeInts
+      struct b_bignum *big;
+   #endif				/* LargeInts */
+   };
+
+#if COMPILER
+struct b_coexpr {		/* co-expression stack block */
+   word title;			/*   T_Coexpr */
+   word size;			/*   number of results produced */
+   word id;			/*   identification number */
+   struct b_coexpr *nextstk;	/*   pointer to next allocated stack */
+   continuation fnc;		/*   function containing co-expression code */
+   struct p_frame *es_pfp;	/*   current procedure frame pointer */
+   dptr es_argp;		/*   current argument pointer */
+   struct tend_desc *es_tend;	/*   current tended pointer */
+   char *file_name;		/*   current file name */
+   word line_num;		/*   current line_number */
+   dptr tvalloc;		/*   where to place transmitted value */
+   struct descrip freshblk;	/*   refresh block pointer */
+   struct astkblk *es_actstk;	/*   pointer to activation stack structure */
+   word cstate[CStateSize];	/*   C state information */
+   struct p_frame pf;           /*   initial procedure frame */
+   };
+
+struct b_refresh {		/* co-expression block */
+   word title;			/*   T_Refresh */
+   word blksize;		/*   size of block */
+   word nlocals;		/*   number of local variables */
+   word nargs;			/*   number of arguments */
+   word ntemps;                 /*   number of temporary descriptors */
+   word wrk_size;		/*   size of non-descriptor work area */
+   struct descrip elems[1];	/*   locals and arguments */
+   };
+
+#else					/* COMPILER */
+
+/*
+ * Structures for the interpreter.
+ */
+
+/*
+ * Declarations for entries in tables associating icode location with
+ *  source program location.
+ */
+struct ipc_fname {
+   word ipc;		/* offset of instruction into code region */
+   word fname;		/* offset of file name into string region */
+   };
+
+struct ipc_line {
+   word ipc;		/* offset of instruction into code region */
+   int line;		/* line number */
+   };
+
+#ifdef MultiThread
+/*
+ * Program state encapsulation.  This consists of the VARIABLE parts of
+ * many global structures.
+ */
+struct progstate {
+   long hsize;				/* size of the icode */
+   struct progstate *parent;
+   struct descrip parentdesc;		/* implicit "&parent" */
+   struct descrip eventmask;		/* implicit "&eventmask" */
+   struct descrip opcodemask;		/* implicit "&opcodemask" */
+   struct descrip eventcode;		/* &eventcode */
+   struct descrip eventval;		/* &eventval */
+   struct descrip eventsource;		/* &eventsource */
+   dptr Glbl_argp;			/* global argp */
+
+   /*
+    * trapped variable keywords' values
+    */
+   struct descrip Kywd_err;
+   struct descrip Kywd_pos;
+   struct descrip ksub;
+   struct descrip Kywd_prog;
+   struct descrip Kywd_ran;
+   struct descrip Kywd_trc;
+   struct b_coexpr *Mainhead;
+   char *Code;
+   char *Ecode;
+   word *Records;
+   int *Ftabp;
+   #ifdef FieldTableCompression
+      short Ftabwidth, Foffwidth;
+      unsigned char *Ftabcp, *Focp;
+      short *Ftabsp, *Fosp;
+      int *Fo;
+      char *Bm;
+   #endif				/* FieldTableCompression */
+   dptr Fnames, Efnames;
+   dptr Globals, Eglobals;
+   dptr Gnames, Egnames;
+   dptr Statics, Estatics;
+   int NGlobals, NStatics;
+   char *Strcons;
+   struct ipc_fname *Filenms, *Efilenms;
+   struct ipc_line *Ilines, *Elines;
+   struct ipc_line * Current_line_ptr;
+
+   #ifdef Graphics
+      struct descrip AmperX, AmperY, AmperRow, AmperCol;/* &x, &y, &row, &col */
+      struct descrip AmperInterval;			/* &interval */
+      struct descrip LastEventWin;			/* last Event() win */
+      int LastEvFWidth;
+      int LastEvLeading;
+      int LastEvAscent;
+      uword PrevTimeStamp;				/* previous timestamp */
+      uword Xmod_Control, Xmod_Shift, Xmod_Meta;	/* control,shift,meta */
+      struct descrip Kywd_xwin[2];			/* &window + ... */
+   #endif				/* Graphics */
+
+   #ifdef EventMon
+      word Linenum, Column, Lastline, Lastcol;
+   #endif				/* EventMon */
+
+   word Coexp_ser;			/* this program's serial numbers */
+   word List_ser;
+   word Set_ser;
+   word Table_ser;
+
+   uword stringtotal;			/* cumulative total allocation */
+   uword blocktotal;			/* cumulative total allocation */
+   word colltot;			/* total number of collections */
+   word collstat;			/* number of static collect requests */
+   word collstr;			/* number of string collect requests */
+   word collblk;			/* number of block collect requests */
+   struct region *stringregion;
+   struct region *blockregion;
+
+   word Lastop;
+
+   dptr Xargp;
+   word Xnargs;
+
+   struct descrip K_current;
+   int K_errornumber;
+   char *K_errortext;
+   struct descrip K_errorvalue;
+   int Have_errval;
+   int T_errornumber;
+   int T_have_val;
+   struct descrip T_errorvalue;
+
+   struct descrip K_main;
+   struct b_file K_errout;
+   struct b_file K_input;
+   struct b_file K_output;
+   };
+
+#endif					/* MultiThread */
+
+/*
+ * Frame markers
+ */
+struct ef_marker {		/* expression frame marker */
+   inst ef_failure;		/*   failure ipc */
+   struct ef_marker *ef_efp;	/*   efp */
+   struct gf_marker *ef_gfp;	/*   gfp */
+   word ef_ilevel;		/*   ilevel */
+   };
+
+struct pf_marker {		/* procedure frame marker */
+   word pf_nargs;		/*   number of arguments */
+   struct pf_marker *pf_pfp;	/*   saved pfp */
+   struct ef_marker *pf_efp;	/*   saved efp */
+   struct gf_marker *pf_gfp;	/*   saved gfp */
+   dptr pf_argp;		/*   saved argp */
+   inst pf_ipc;			/*   saved ipc */
+   word pf_ilevel;		/*   saved ilevel */
+   dptr pf_scan;		/*   saved scanning environment */
+
+   #ifdef MultiThread
+      struct progstate *pf_prog;/*   saved program state pointer */
+   #endif				/* MultiThread */
+
+   struct descrip pf_locals[1];	/*   descriptors for locals */
+   };
+
+struct gf_marker {		/* generator frame marker */
+   word gf_gentype;		/*   type */
+   struct ef_marker *gf_efp;	/*   efp */
+   struct gf_marker *gf_gfp;	/*   gfp */
+   inst gf_ipc;			/*   ipc */
+   struct pf_marker *gf_pfp;	/*   pfp */
+   dptr gf_argp;		/*   argp */
+   };
+
+/*
+ * Generator frame marker dummy -- used only for sizing "small"
+ *  generator frames where procedure information need not be saved.
+ *  The first five members here *must* be identical to those for
+ *  gf_marker.
+ */
+struct gf_smallmarker {		/* generator frame marker */
+   word gf_gentype;		/*   type */
+   struct ef_marker *gf_efp;	/*   efp */
+   struct gf_marker *gf_gfp;	/*   gfp */
+   inst gf_ipc;			/*   ipc */
+   };
+
+/*
+ * b_iproc blocks are used to statically initialize information about
+ *  functions.	They are identical to b_proc blocks except for
+ *  the pname field which is a sdescrip (simple/string descriptor) instead
+ *  of a descrip.  This is done because unions cannot be initialized.
+ */
+
+struct b_iproc {		/* procedure block */
+   word ip_title;		/*   T_Proc */
+   word ip_blksize;		/*   size of block */
+   int (*ip_entryp)();		/*   entry point (code) */
+   word ip_nparam;		/*   number of parameters */
+   word ip_ndynam;		/*   number of dynamic locals */
+   word ip_nstatic;		/*   number of static locals */
+   word ip_fstatic;		/*   index (in global table) of first static */
+
+   struct sdescrip ip_pname;	/*   procedure name (string qualifier) */
+   struct descrip ip_lnames[1];	/*   list of local names (qualifiers) */
+   };
+
+struct b_coexpr {		/* co-expression stack block */
+   word title;			/*   T_Coexpr */
+   word size;			/*   number of results produced */
+   word id;			/*   identification number */
+   struct b_coexpr *nextstk;	/*   pointer to next allocated stack */
+   struct pf_marker *es_pfp;	/*   current pfp */
+   struct ef_marker *es_efp;	/*   efp */
+   struct gf_marker *es_gfp;	/*   gfp */
+   struct tend_desc *es_tend;	/*   current tended pointer */
+   dptr es_argp;		/*   argp */
+   inst es_ipc;			/*   ipc */
+   word es_ilevel;		/*   interpreter level */
+   word *es_sp;			/*   sp */
+   dptr tvalloc;		/*   where to place transmitted value */
+   struct descrip freshblk;	/*   refresh block pointer */
+   struct astkblk *es_actstk;	/*   pointer to activation stack structure */
+
+   #ifdef MultiThread
+      struct progstate *program;
+   #endif				/* MultiThread */
+
+   word cstate[CStateSize];	/*   C state information */
+   };
+
+struct b_refresh {		/* co-expression block */
+   word title;			/*   T_Refresh */
+   word blksize;		/*   size of block */
+   word *ep;			/*   entry point */
+   word numlocals;		/*   number of locals */
+   struct pf_marker pfmkr;	/*   marker for enclosing procedure */
+   struct descrip elems[1];	/*   arguments and locals, including Arg0 */
+   };
+
+#endif					/* COMPILER */
+
+union block {			/* general block */
+   struct b_real realblk;
+   struct b_cset cset;
+   struct b_file file;
+   struct b_proc proc;
+   struct b_list list;
+   struct b_lelem lelem;
+   struct b_table table;
+   struct b_telem telem;
+   struct b_set set;
+   struct b_selem selem;
+   struct b_record record;
+   struct b_tvsubs tvsubs;
+   struct b_tvtbl tvtbl;
+   struct b_refresh refresh;
+   struct b_coexpr coexpr;
+   struct b_external externl;
+   struct b_slots slots;
+
+   #ifdef LargeInts
+      struct b_bignum bignumblk;
+   #endif				/* LargeInts */
+   };
diff --git a/src/h/rt.h b/src/h/rt.h
new file mode 100644
index 0000000..4531dc9
--- /dev/null
+++ b/src/h/rt.h
@@ -0,0 +1,27 @@
+#ifndef RT_DOT_H	/* only include once */
+#define RT_DOT_H 1
+
+/*
+ * Include files.
+ */
+
+#include "../h/define.h"
+#include "../h/arch.h"
+#include "../h/config.h"
+#include "../h/sys.h"
+#include "../h/typedefs.h"
+#include "../h/cstructs.h"
+#include "../h/mproto.h"
+#include "../h/cpuconf.h"
+#include "../h/monitor.h"
+#include "../h/rmacros.h"
+#include "../h/rstructs.h"
+
+#ifdef Graphics
+   #include "../h/graphics.h"
+#endif					/* Graphics */
+
+#include "../h/rexterns.h"
+#include "../h/rproto.h"
+
+#endif					/* RT_DOT_H */
diff --git a/src/h/sys.h b/src/h/sys.h
new file mode 100644
index 0000000..fecfd96
--- /dev/null
+++ b/src/h/sys.h
@@ -0,0 +1,75 @@
+/*
+ * sys.h -- system include files.
+ */
+
+/*
+ * Universal (Standard 1989 ANSI C) includes.
+ */
+#include <ctype.h>
+#include <errno.h>
+#include <limits.h>
+#include <math.h>
+#include <setjmp.h>
+#include <signal.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+/*
+ * POSIX (1003.1-1996) includes.
+ */
+#include <dirent.h>
+#include <fcntl.h>
+#include <grp.h>
+#include <pwd.h>
+#include <termios.h>
+#include <unistd.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/times.h>
+#include <sys/types.h>
+#include <sys/utsname.h>
+
+/*
+ * Operating-system-dependent includes.
+ */
+#if MSWIN
+   #include <windows.h>
+   #include <sys/cygwin.h>
+   #include <sys/select.h>
+   
+   #ifdef WinGraphics
+      #define int_PASCAL int PASCAL
+      #define LRESULT_CALLBACK LRESULT CALLBACK
+      #define BOOL_CALLBACK BOOL CALLBACK
+      #include <mmsystem.h>
+      #include <process.h>
+      #include "../wincap/dibutil.h"
+   #endif				/* WinGraphics */
+
+   #undef Type
+   #undef lst1
+   #undef lst2
+#endif					/* MSWIN */
+
+/*
+ * Window-system-dependent includes.
+ */
+#ifdef XWindows
+   #ifdef HaveXpmFormat
+      #include "../xpm/xpm.h"
+   #else				/* HaveXpmFormat */
+      #include <X11/Xlib.h>
+   #endif				/* HaveXpmFormat */
+   #include <X11/Xutil.h>
+   #include <X11/Xos.h>
+   #include <X11/Xatom.h>
+#endif					/* XWindows */
+
+/*
+ * Feature-dependent includes.
+ */
+#ifdef LoadFunc
+   #include <dlfcn.h>
+#endif					/* LoadFunc */
diff --git a/src/h/typedefs.h b/src/h/typedefs.h
new file mode 100644
index 0000000..984af9a
--- /dev/null
+++ b/src/h/typedefs.h
@@ -0,0 +1,81 @@
+/*
+ * typedefs for the run-time system.
+ */
+
+typedef int ALIGN;		/* pick most stringent type for alignment */
+typedef unsigned int DIGIT;
+
+/*
+ * Default sizing and such.
+ */
+
+/*
+ * Set up typedefs and related definitions depending on whether or not
+ * ints and pointers are the same size.
+ */
+
+#if IntBits != WordBits
+   typedef long int word;
+   typedef unsigned long int uword;
+#else					/* IntBits != WordBits */
+   typedef int word;
+   typedef unsigned int uword;
+#endif					/* IntBits != WordBits */
+
+typedef void *pointer;
+
+/*
+ * Typedefs to make some things easier.
+ */
+
+typedef int (*fptr)();
+typedef struct descrip *dptr;
+
+typedef word C_integer;
+
+/*
+ * A success continuation is referenced by a pointer to an integer function
+ *  that takes no arguments.
+ */
+typedef int (*continuation) (void);
+
+#if !COMPILER
+
+   /*
+    * Typedefs for the interpreter.
+    */
+
+   /*
+    * Icode consists of operators and arguments.  Operators are small integers,
+    *  while arguments may be pointers.  To conserve space in icode files on
+    *  computers with 16-bit ints, icode is written by the linker as a mixture
+    *  of ints and words (longs).  When an icode file is read in and processed
+    *  by the interpreter, it looks like a C array of mixed ints and words.
+    *  Accessing this "nonstandard" structure is handled by a union of int and
+    *  word pointers and incrementing is done by incrementing the appropriate
+    *  member of the union (see the interpreter).  This is a rather dubious
+    *  method and certainly not portable.  A better way might be to address
+    *  icode with a char *, but the incrementing code might be inefficient
+    *  (at a place that experiences a lot of execution activity).
+    *
+    * For the moment, the dubious coding is isolated under control of the
+    *  size of integers.
+    */
+
+   #if IntBits != WordBits
+
+      typedef union {
+         int *op;
+         word *opnd;
+         } inst;
+
+      #else				/* IntBits != WordBits */
+
+      typedef union {
+         word *op;
+         word *opnd;
+         } inst;
+
+   #endif				/* IntBits != WordBits */
+
+#endif					/* COMPILER */
diff --git a/src/h/version.h b/src/h/version.h
new file mode 100644
index 0000000..c3a8b8d
--- /dev/null
+++ b/src/h/version.h
@@ -0,0 +1,66 @@
+/*
+ * version.h -- version identification
+ */
+
+#undef DVersion
+#undef Version
+#undef UVersion
+#undef IVersion
+
+/*
+ *  Icon version number and date.
+ *  These are the only two entries that change any more.
+ */
+#define VersionNumber "9.4.3"
+#define VersionDate "November 14, 2005"
+
+/*
+ * Version number to insure format of data base matches version of iconc
+ *  and rtt.
+ */
+#define DVersion "9.0.00"
+
+#if COMPILER
+
+   /*
+    * &version
+    */
+   #define Version  "Icon Version " VersionNumber "-C, " VersionDate
+
+#else					/* COMPILER */
+
+   /*
+    *  &version
+    */
+   #define Version  "Icon Version " VersionNumber ", " VersionDate
+
+   /*
+    * Version numbers to be sure that ucode is compatible with the linker
+    * and that icode is compatible with the run-time system.
+    */
+
+   #define UVersion "U9.0.00"
+
+   #ifdef FieldTableCompression
+
+      #if IntBits == 32
+         #define IVersion "I9.2.00FT/32"
+      #endif				/* IntBits == 32 */
+
+      #if IntBits == 64
+         #define IVersion "I9.2.00FT/64"
+      #endif				/* IntBits == 64 */
+
+   #else				/* FieldTableCompression */
+
+      #if IntBits == 32
+         #define IVersion "I9.0.00/32"
+      #endif				/* IntBits == 32 */
+
+      #if IntBits == 64
+         #define IVersion "I9.0.00/64"
+      #endif				/* IntBits == 64 */
+
+   #endif				/* FieldTableCompression */
+
+#endif					/* COMPILER */
diff --git a/src/h/xwin.h b/src/h/xwin.h
new file mode 100644
index 0000000..a8ff24c
--- /dev/null
+++ b/src/h/xwin.h
@@ -0,0 +1,194 @@
+#ifdef XWindows
+
+#define DRAWOP_AND			GXand
+#define DRAWOP_ANDINVERTED		GXandInverted
+#define DRAWOP_ANDREVERSE		GXandReverse
+#define DRAWOP_CLEAR			GXclear
+#define DRAWOP_COPY			GXcopy
+#define DRAWOP_COPYINVERTED		GXcopyInverted
+#define DRAWOP_EQUIV			GXequiv
+#define DRAWOP_INVERT			GXinvert
+#define DRAWOP_NAND			GXnand
+#define DRAWOP_NOOP			GXnoop
+#define DRAWOP_NOR			GXnor
+#define DRAWOP_OR			GXor
+#define DRAWOP_ORINVERTED		GXorInverted
+#define DRAWOP_ORREVERSE		GXorReverse
+#define DRAWOP_REVERSE			0x10
+#define DRAWOP_SET			GXset
+#define DRAWOP_XOR			GXxor
+
+#define XLFD_Foundry	 1
+#define XLFD_Family	 2
+#define XLFD_Weight	 3
+#define XLFD_Slant	 4
+#define XLFD_SetWidth	 5
+#define XLFD_AddStyle	 6
+#define XLFD_Size	 7
+#define XLFD_PointSize	 8
+#define XLFD_Spacing	11
+#define XLFD_CharSet	13
+
+#define TEXTWIDTH(w,s,n) XTextWidth((w)->context->font->fsp, s, n)
+#define SCREENDEPTH(w)\
+        DefaultDepth((w)->window->display->display, w->window->display->screen)
+#define ASCENT(w) ((w)->context->font->fsp->ascent)
+#define DESCENT(w) ((w)->context->font->fsp->descent)
+#define LEADING(w) ((w)->context->leading)
+#define FHEIGHT(w) ((w)->context->font->height)
+#define FWIDTH(w) ((w)->context->font->fsp->max_bounds.width)
+#define LINEWIDTH(w) ((w)->context->linewidth)
+#define DISPLAYHEIGHT(w)\
+        DisplayHeight(w->window->display->display, w->window->display->screen)
+#define DISPLAYWIDTH(w)\
+        DisplayWidth(w->window->display->display, w->window->display->screen)
+#define FS_SOLID FillSolid
+#define FS_STIPPLE FillStippled
+#define hidecrsr(x) /* noop */
+#define UpdateCursorPos(x, y) /* noop */
+#define showcrsr(x) /* noop */
+#define SysColor XColor
+#define ARCWIDTH(arc) ((arc).width)
+#define ARCHEIGHT(arc) ((arc).height)
+#define RECX(rec) ((rec).x)
+#define RECY(rec) ((rec).y)
+#define RECWIDTH(rec) ((rec).width)
+#define RECHEIGHT(rec) ((rec).height)
+#define ANGLE(ang) (-(ang) * 180 / Pi * 64)
+#define EXTENT(ang) (-(ang) * 180 / Pi * 64)
+#define ISICONIC(w) ((w)->window->iconic == IconicState)
+#define ISFULLSCREEN(w) (0)
+#define ISROOTWIN(w) ((w)->window->iconic == RootState)
+#define ISNORMALWINDOW(w) ((w)->window->iconic == NormalState)
+#define ICONFILENAME(w) ((w)->window->iconimage)
+#define ICONLABEL(w) ((w)->window->iconlabel)
+#define WINDOWLABEL(w) ((w)->window->windowlabel)
+#define RootState IconicState+1
+#define MaximizedState IconicState+2
+#define HiddenState IconicState+3
+
+/*
+ * The following constants define limitations in the system, gradually being
+ * removed as this code is rewritten to use dynamic allocation.
+ */
+#define WMAXCOLORS	256
+#define MAXCOLORNAME	40
+#define MAXDISPLAYNAME	64
+#define SHARED          0
+#define MUTABLE         1
+#define NUMCURSORSYMS	78
+
+/*
+ * Macros to ease coding in which every X call must be done twice.
+ */
+#define RENDER2(func,v1,v2) {\
+   if (stdwin) func(stddpy, stdwin, stdgc, v1, v2); \
+   func(stddpy, stdpix, stdgc, v1, v2);}
+#define RENDER3(func,v1,v2,v3) {\
+   if (stdwin) func(stddpy, stdwin, stdgc, v1, v2, v3); \
+   func(stddpy, stdpix, stdgc, v1, v2, v3);}
+#define RENDER4(func,v1,v2,v3,v4) {\
+   if (stdwin) func(stddpy, stdwin, stdgc, v1, v2, v3, v4); \
+   func(stddpy, stdpix, stdgc, v1, v2, v3, v4);}
+#define RENDER6(func,v1,v2,v3,v4,v5,v6) {\
+   if (stdwin) func(stddpy, stdwin, stdgc, v1, v2, v3, v4, v5, v6); \
+   func(stddpy, stdpix, stdgc, v1, v2, v3, v4, v5, v6);}
+#define RENDER7(func,v1,v2,v3,v4,v5,v6,v7) {\
+   if (stdwin) func(stddpy, stdwin, stdgc, v1, v2, v3, v4, v5, v6, v7); \
+   func(stddpy, stdpix, stdgc, v1, v2, v3, v4, v5, v6, v7);}
+
+#define MAXDESCENDER(w) (w->context->font->fsp->max_bounds.descent)
+
+/*
+ * Macros to perform direct window system calls from graphics routines
+ */
+#define STDLOCALS(w) \
+   wcp wc = (w)->context; \
+   wsp ws = (w)->window; \
+   wdp wd = ws->display; \
+   GC      stdgc  = wc->gc; \
+   Display *stddpy = wd->display; \
+   Window  stdwin  = ws->win; \
+   Pixmap  stdpix  = ws->pix;
+
+#define drawarcs(w, arcs, narcs) \
+   { STDLOCALS(w); RENDER2(XDrawArcs,arcs,narcs); }
+#define drawlines(w, points, npoints) \
+   { STDLOCALS(w); RENDER3(XDrawLines,points,npoints,CoordModeOrigin); }
+#define drawpoints(w, points, npoints) \
+   { STDLOCALS(w); RENDER3(XDrawPoints,points,npoints,CoordModeOrigin); }
+#define drawrectangles(w, recs, nrecs) { \
+   STDLOCALS(w); \
+   for(i=0; i<nrecs; i++) { \
+     RENDER4(XDrawRectangle,recs[i].x,recs[i].y,recs[i].width,recs[i].height);\
+     }}
+
+#define drawsegments(w, segs, nsegs) \
+   { STDLOCALS(w); RENDER2(XDrawSegments,segs,nsegs); }
+#define drawstrng(w, x, y, s, slen) \
+   { STDLOCALS(w); RENDER4(XDrawString, x, y, s, slen); }
+#define fillarcs(w, arcs, narcs) \
+   { STDLOCALS(w); RENDER2(XFillArcs, arcs, narcs); }
+#define fillpolygon(w, points, npoints) \
+   { STDLOCALS(w); RENDER4(XFillPolygon, points, npoints, Complex, CoordModeOrigin); }
+
+/*
+ * "get" means remove them from the Icon list and put them on the ghost queue
+ */
+#define EVQUEGET(w,d) { \
+   int i;\
+   wsp ws = (w)->window; \
+   if (!c_get((struct b_list *)BlkLoc(ws->listp),&d)) fatalerr(0,NULL); \
+   if (Qual(d)) {\
+      ws->eventQueue[ws->eQfront++] = *StrLoc(d); \
+      if (ws->eQfront >= EQUEUELEN) ws->eQfront = 0; \
+      ws->eQback = ws->eQfront; \
+      } \
+   }
+#define EVQUEEMPTY(w) (BlkLoc((w)->window->listp)->list.size == 0)
+
+/*
+ * Colors.  These are allocated within displays. Pointers
+ * into the display's color table are also kept on a per-window
+ * basis so that they may be (de)allocated when a window is cleared.
+ * Colors are aliased by r,g,b value.  Allocations by name and r,g,b
+ * share when appropriate.
+ *
+ * Color (de)allocation comprises a simple majority of the space
+ * requirements of the current implementation.  A monochrome-only
+ * version would take a lot less space.
+ *
+ * The name field is the string returned by WAttrib.  For a mutable
+ * color this is of the form "-47" followed by a second C string
+ * containing the current color setting.
+ */
+typedef struct wcolor {
+   unsigned long c;			/* X pixel value */
+   int		refcount;		/* reference count */
+   int		type;			/* SHARED or MUTABLE */
+   int		next;			/* next entry in hash chain */
+   unsigned short r, g, b;		/* rgb for colorsearch */
+   char		name[6+MAXCOLORNAME];	/* name for WAttrib & WColor reads */
+} *wclrp;
+
+/*
+ * macros performing row/column to pixel y,x translations
+ * computation is 1-based and depends on the current font's size.
+ * exception: XTOCOL as defined is 0-based, because that's what its
+ * clients seem to need.
+ */
+#define ROWTOY(w,row) ((row-1) * LEADING(w) + ASCENT(w))
+#define COLTOX(w,col) ((col-1) * FWIDTH(w))
+#define YTOROW(w,y)   ((y>0) ? ((y) / LEADING(w) + 1) : ((y) / LEADING(w)))
+#define XTOCOL(w,x)  (!FWIDTH(w) ? (x) : ((x) / FWIDTH(w)))
+
+#define STDLOCALS(w) \
+   wcp wc = (w)->context; \
+   wsp ws = (w)->window; \
+   wdp wd = ws->display; \
+   GC      stdgc  = wc->gc; \
+   Display *stddpy = wd->display; \
+   Window  stdwin  = ws->win; \
+   Pixmap  stdpix  = ws->pix;
+
+#endif					/* XWindows */
diff --git a/src/iconc/Makefile b/src/iconc/Makefile
new file mode 100644
index 0000000..bce6aa8
--- /dev/null
+++ b/src/iconc/Makefile
@@ -0,0 +1,73 @@
+#  Makefile for the Icon compiler, iconc.
+#
+#  This is no longer supported and may not work.
+
+include ../../Makedefs
+
+
+OBJS =		cmain.o ctrans.o dbase.o clex.o\
+		cparse.o csym.o cmem.o ctree.o ccode.o ccomp.o\
+                ivalues.o codegen.o fixcode.o inline.o chkinv.o\
+		typinfer.o types.o lifetime.o incheck.o
+
+COBJS =		../common/long.o ../common/getopt.o ../common/time.o\
+		  ../common/filepart.o ../common/identify.o ../common/munix.o\
+		  ../common/strtbl.o ../common/rtdb.o ../common/literals.o \
+		  ../common/alloc.o ../common/ipp.o
+
+
+
+iconc:		$(OBJS) $(COBJS)
+		$(CC) -o iconc $(OBJS) $(COBJS)
+		cp iconc ../../bin
+		strip ../../bin/iconc$(EXE)
+
+$(OBJS):	../h/config.h ../h/cpuconf.h ../h/cstructs.h ../h/define.h\
+		../h/mproto.h ../h/typedefs.h ../h/gsupport.h \
+		ccode.h cglobals.h cproto.h csym.h ctrans.h ctree.h
+
+$(COBJS):	../h/mproto.h
+		cd ../common; $(MAKE); $(MAKE) xpm
+
+ccode.o:	../h/lexdef.h ctoken.h
+chkinv.o:	ctoken.h
+clex.o:		../h/lexdef.h ../h/parserr.h ctoken.h \
+		   ../common/lextab.h ../common/yylex.h ../common/error.h
+clocal.o:	../h/config.h
+cparse.o:	../h/lexdef.h
+ctrans.o:	ctoken.h
+ctree.o:	../h/lexdef.h ctoken.h
+csym.o:		ctoken.h
+dbase.o:	../h/lexdef.h
+lifetime.o:	../h/lexdef.h ctoken.h
+typinfer.o:	../h/lexdef.h ctoken.h
+types.o:	../h/lexdef.h ctoken.h
+
+
+
+#  The following sections are commented out because they do not need to
+#  be performed unless changes are made to cgrammar.c, ../h/grammar.h,
+#  ../common/tokens.txt, or ../common/op.txt.  Such changes involve
+#  modifications to the syntax of Icon and are not part of the installation
+#  process. However, if the distribution files are unloaded in a fashion
+#  such that their dates are not set properly, the following sections would
+#  be attempted.
+#
+#  Note that if any changes are made to the files mentioned above, the comment
+#  characters at the beginning of the following lines should be removed.
+#  icont must be on your search path for these actions to work.
+#
+#../common/lextab.h ../common/yacctok.h ../common/fixgram ../common/pscript: \
+#			../common/tokens.txt ../common/op.txt
+#		cd ../common; $(MAKE) gfiles
+#
+#cparse.c ctoken.h:	cgram.g ../common/pscript
+## expect 218 shift/reduce conflicts
+#		yacc -d cgram.g
+#		../common/pscript <y.tab.c >cparse.c
+#		mv y.tab.h ctoken.h
+#		rm -f y.tab.c
+#
+#cgram.g:	cgrammar.c ../h/define.h ../h/grammar.h \
+#			../common/yacctok.h ../common/fixgram
+#		$(CC) -E -C cgrammar.c | ../common/fixgram >cgram.g
diff --git a/src/iconc/ccode.c b/src/iconc/ccode.c
new file mode 100644
index 0000000..108cd15
--- /dev/null
+++ b/src/iconc/ccode.c
@@ -0,0 +1,4954 @@
+/*
+ * ccode.c - routines to produce internal representation of C code.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "csym.h"
+#include "ccode.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cproto.h"
+
+#ifdef OptimizeLit
+
+#define NO_LIMIT       0
+#define LIMITED        1
+#define LIMITED_TO_INT 2
+#define NO_TOUCH       3
+
+struct lit_tbl {
+   int    modified;
+   int    index;
+   int    safe;
+   struct code    *initial;
+   struct code    *end;
+   struct val_loc *vloc;
+   struct centry  *csym; 
+   struct lit_tbl *prev;
+   struct lit_tbl *next;
+};
+#endif					/* OptimizeLit */
+
+/*
+ * Prototypes for static functions.
+ */
+static struct c_fnc *alc_fnc	(void);
+static struct tmplftm *alc_lftm	(int num, union field *args);
+static int alc_tmp 		(int n, struct tmplftm *lifetm_ary);
+
+#ifdef	OptimizePoll
+   static int analyze_poll 	(void);
+   static void remove_poll 	(void);
+#endif					/* OptimizePoll */
+
+#ifdef	OptimizeLit
+   static int instr		(const	char *str, int chr);
+   static void invalidate	(struct val_loc *val,struct code *end,int code);
+   static void analyze_literals	(struct code *start, struct code *top, int lvl);
+   static int eval_code		(struct code *cd, struct lit_tbl *cur);
+   static void propagate_literals (void);
+   static void free_tbl		(void);
+   static struct lit_tbl *alc_tbl (void);
+   static void tbl_add		(truct lit_tbl *add);
+#endif					/* OptimizeLit */
+
+static struct code *asgn_null	(struct val_loc *loc1);
+static struct val_loc *bound	(struct node *n, struct val_loc *rslt,
+				   int catch_fail);
+static struct code *check_var	(struct val_loc *d, struct code *lbl);
+static void deref_cd		(struct val_loc *src, struct val_loc *dest);
+static void deref_ret		(struct val_loc *src, struct val_loc *dest,
+				   int subtypes);
+static void endlife		(int	kind, int indx, int old, nodeptr n);
+static struct val_loc *field_ref(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_act	(nodeptr n, struct val_loc *rslt);
+static struct val_loc *gen_apply(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_args	(struct node *n, int frst_arg, int nargs);
+static struct val_loc *gen_case	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_creat(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_lim	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gen_scan	(struct node *n, struct val_loc *rslt);
+static struct val_loc *gencode	(struct node *n, struct val_loc *rslt);
+static struct val_loc *genretval(struct node *n, struct node *expr,
+				   struct val_loc *dest);
+static struct val_loc *inv_prc	(nodeptr n, struct val_loc *rslt);
+static struct val_loc *inv_op	(nodeptr n, struct val_loc *rslt);
+static nodeptr max_lftm		(nodeptr	n1, nodeptr n2);
+static void mk_callop		(char *oper_nm, int ret_flag,
+				   struct val_loc *arg1rslt, int nargs,
+				   struct val_loc *rslt, int optim);
+static struct code *mk_cpyval	(struct val_loc *loc1, struct val_loc *loc2);
+static struct code *new_call	(void);
+static char *oper_name		(struct implement *impl);
+static void restr_env	(struct val_loc *sub_sav, struct val_loc *pos_sav);
+static void save_env	(struct val_loc *sub_sav, struct val_loc *pos_sav);
+static void setloc		(nodeptr	n);
+static struct val_loc *tmp_loc	(int n);
+static struct val_loc *var_ref	(struct lentry *sym);
+static struct val_loc *vararg_sz(int n);
+
+#define FrstArg 2
+
+/*
+ * Information that must be passed between a loop and its next and break
+ *   expressions.
+ */
+struct loop_info {
+   struct code *next_lbl;       /* where to branch for a next expression */
+   struct code *end_loop;       /* label at end of loop */
+   struct code *on_failure;     /* where to go if the loop fails */
+   struct scan_info *scan_info; /* scanning environment upon entering loop */
+   struct val_loc *rslt;        /* place to put result of loop */
+   struct c_fnc *succ_cont;     /* the success continuation for the loop */
+   struct loop_info *prev;      /* link to info for outer loop */
+   };
+
+/*
+ * The allocation status of a temporary variable can either be "in use",
+ *  "not allocated", or reserved for use at a code position (indicated
+ *  by a specific negative number).
+ */
+#define InUse 1
+#define NotAlc 0
+
+/*
+ * tmplftm is used to precompute lifetime information for use in allocating
+ *  temporary variables.
+ */
+struct tmplftm {
+   int cur_status;
+   nodeptr lifetime;
+   };
+
+/*
+ * Places where &subject and &pos are saved during string scanning. "outer"
+ *  values are saved when the scanning expression is executed. "inner"
+ *  values are saved when the scanning expression suspends.
+ */
+struct scan_info {
+   struct val_loc *outer_sub;
+   struct val_loc *outer_pos;
+   struct val_loc *inner_sub;
+   struct val_loc *inner_pos;
+   struct scan_info *next;
+   };
+
+struct scan_info scan_base = {NULL, 0, NULL, 0, NULL};
+struct scan_info *nxt_scan = &scan_base;
+
+struct val_loc ignore;		 /* no values, just something to point at */
+static struct val_loc proc_rslt; /* result location for procedure */
+
+int *tmp_status = NULL;      /* allocation status of temp descriptor vars */
+int *itmp_status = NULL;     /* allocation status of temp C int vars*/
+int *dtmp_status = NULL;     /* allocation status of temp C double vars */
+int *sbuf_status = NULL;     /* allocation of string buffers */
+int *cbuf_status = NULL;     /* allocation of cset buffers */
+int num_tmp;                 /* number of temp descriptors actually used */
+int num_itmp;                /* number of temp C ints actually used */
+int num_dtmp;                /* number of temp C doubles actually used */
+int num_sbuf;                /* number of string buffers actually used */
+int num_cbuf;                /* number of cset buffers actually used */
+int status_sz = 20;          /* current size of tmp_status array */
+int istatus_sz = 20;         /* current size of itmp_status array */
+int dstatus_sz = 20;         /* current size of dtmp_status array */
+int sstatus_sz = 20;         /* current size of sbuf_status array */
+int cstatus_sz = 20;         /* current size of cbuf_status array */
+struct freetmp *freetmp_pool = NULL;
+
+static char frm_prfx[PrfxSz + 1];/* prefix for procedure frame */
+static char *lastfiln;	     /* last file name set in code */
+static int lastline;         /* last line number set in code */
+
+#ifdef OptimizePoll
+static struct code *lastpoll;
+#endif					/* OptimizePoll */
+
+#ifdef OptimizeLit
+static struct lit_tbl *tbl = NULL;
+static struct lit_tbl *free_lit_tbl = NULL;
+#endif					/* OptimizeLit */
+
+static struct c_fnc *fnc_lst;	/* list of C functions implementing proc */
+static struct c_fnc **flst_end; /* pointer to null pointer at end of fnc_lst */
+struct c_fnc *cur_fnc;   	/* C function currently being built */
+static int create_lvl = 0;      /* co-expression create level */
+
+struct pentry *cur_proc;        /* procedure currently being translated */
+
+struct code *on_failure;	/* place to go on failure */
+
+static struct code *p_ret_lbl;   /* label for procedure return */
+static struct code *p_fail_lbl;  /* label for procedure fail */
+struct code *bound_sig;   	 /* bounding signal for current procedure */
+
+/*
+ * statically declared "signals".
+ */
+struct code resume;
+struct code contin;
+struct code fallthru;
+struct code next_fail;
+
+int lbl_seq_num = 0;  /* next label sequence number */
+
+#ifdef OptimizeLit
+static void print_tbl(struct lit_tbl *start)  {
+   struct lit_tbl *ptr;
+   
+   for (ptr=start; ptr != NULL ;ptr=ptr->next)  {
+      printf("mod (%2d) strchr (%2d) ",ptr->modified,ptr->index);
+      if (ptr->csym != NULL)  {
+         printf("image (%13s) ",ptr->csym->image);
+      }
+      if (ptr->vloc != NULL)  {
+         printf("val (%6d) type (%d)",ptr->vloc->u.tmp,ptr->vloc->loc_type); 
+      }
+      if (ptr->end == NULL)
+         printf(" END IS NULL");
+      printf("\n");
+   }
+}
+
+
+static void free_tbl()  {
+/*
+   struct lit_tbl *ptr, *next;
+*/
+   free_lit_tbl = tbl;
+   tbl = NULL;
+/*
+   ptr = tbl;
+   while (ptr != NULL)  {
+      next = ptr->next;
+      free(ptr);
+      ptr = next;
+   }
+   tbl = NULL;
+*/
+}
+
+
+static struct lit_tbl *alc_tbl()  {
+   struct lit_tbl *new; 
+   static int cnt=0;
+
+
+   if (free_lit_tbl != NULL)  {
+      new = free_lit_tbl;
+      free_lit_tbl = new->next;
+   }
+   else
+      new = (struct lit_tbl *)alloc(sizeof(struct lit_tbl));
+   new->modified = NO_LIMIT;
+   new->index = -1;
+   new->safe = 1;
+   new->initial = NULL;
+   new->end  = NULL;
+   new->vloc = NULL;
+   new->csym = NULL;
+   new->prev = NULL;
+   new->next = NULL;
+   return new;
+}
+#endif					/* OptimizeLit */
+
+/*
+ * proccode - generate code for a procedure.
+ */
+void proccode(proc)
+struct pentry *proc;
+   {
+   struct c_fnc *fnc;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+   nodeptr n;
+   nodeptr failer;
+   int gen;
+   int i;
+#ifdef OptimizeLit
+   struct code *procstart;
+#endif					/* OptimizeLit */
+
+   /*
+    * Initialize arrays used for allocating temporary variables.
+    */
+   if (tmp_status == NULL)
+      tmp_status = (int *)alloc((unsigned int)(status_sz * sizeof(int)));
+   if (itmp_status == NULL)
+      itmp_status = (int *)alloc((unsigned int)(istatus_sz * sizeof(int)));
+   if (dtmp_status == NULL)
+      dtmp_status = (int *)alloc((unsigned int)(dstatus_sz * sizeof(int)));
+   if (sbuf_status == NULL)
+      sbuf_status = (int *)alloc((unsigned int)(sstatus_sz * sizeof(int)));
+   if (cbuf_status == NULL)
+      cbuf_status = (int *)alloc((unsigned int)(cstatus_sz * sizeof(int)));
+   for (i = 0; i < status_sz; ++i)
+      tmp_status[i] = NotAlloc;
+   for (i = 0; i < istatus_sz; ++i)
+      itmp_status[i] = NotAlloc;
+   for (i = 0; i < dstatus_sz; ++i)
+      dtmp_status[i] = NotAlloc;
+   for (i = 0; i < sstatus_sz; ++i)
+      sbuf_status[i] = NotAlloc;
+   for (i = 0; i < cstatus_sz; ++i)
+      cbuf_status[i] = NotAlloc;
+   num_tmp = 0;
+   num_itmp = 0;
+   num_dtmp = 0;
+   num_sbuf = 0;
+   num_cbuf = 0;
+
+   /*
+    * Initialize standard signals.
+    */
+   resume.cd_id = C_Resume;
+   contin.cd_id = C_Continue;
+   fallthru.cd_id = C_FallThru;
+
+   /*
+    * Initialize procedure result and the transcan locations.
+    */
+   proc_rslt.loc_type = V_PRslt;
+   proc_rslt.mod_access = M_None;
+   ignore.loc_type = V_Ignore;
+   ignore.mod_access = M_None;
+
+   cur_proc = proc;  /* current procedure */
+   lastfiln = NULL;  /* file name */
+   lastline = 0;     /* line number */
+
+#ifdef OptimizePoll
+   lastpoll = NULL;
+#endif					/* OptimizePoll */
+
+   /*
+    * Procedure frame prefix is the procedure prefix.
+    */
+   for (i = 0; i < PrfxSz; ++i)
+      frm_prfx[i] = cur_proc->prefix[i];
+   frm_prfx[PrfxSz] = '\0';
+
+   /*
+    * Initialize the continuation list and allocate the outer function for
+    *  this procedure.
+    */
+   fnc_lst = NULL;
+   flst_end = &fnc_lst;
+   cur_fnc = alc_fnc();
+
+#ifdef OptimizeLit
+   procstart = cur_fnc->cursor;
+#endif					/* OptimizeLit */
+
+   /*
+    * If the procedure is not used anywhere don't generate code for it.
+    *  This can happen when using libraries containing several procedures,
+    *  but not all are needed. However, if there is a block for the
+    *  procedure, we need at least a dummy function.
+    */
+   if (!cur_proc->reachable) {
+      if (!(glookup(cur_proc->name)->flag & F_SmplInv))
+         outerfnc(fnc_lst);
+      return;
+      }
+
+   /*
+    * Allocate labels for the code for procedure failure, procedure return,
+    *  and allocate the bounding signal for this procedure (at this point
+    *  signals and labels are not distinguished).
+    */
+   p_fail_lbl = alc_lbl("proc fail", 0);
+   p_ret_lbl = alc_lbl("proc return", 0);
+   bound_sig = alc_lbl("bound", 0);
+
+   n = proc->tree;
+   setloc(n);
+   if (Type(Tree1(n)) != N_Empty) {
+      /*
+       * initial clause.
+       */
+      Tree1(n)->lifetime = NULL;
+      liveness(Tree1(n), NULL, &failer, &gen);
+      if (tfatals > 0)
+         return;
+      lbl = alc_lbl("end initial", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(1);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) = "!first_time";
+      cd->Cond = cd1;
+      cd->ThenStmt = mk_goto(lbl);
+      cd_add(cd);
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) = "first_time = 0;";
+      cd_add(cd);
+      bound(Tree1(n), &ignore, 1);
+      cur_fnc->cursor = lbl;
+      }
+   Tree2(n)->lifetime = NULL;
+   liveness(Tree2(n), NULL, &failer, &gen);
+   if (tfatals > 0)
+      return;
+   bound(Tree2(n), &ignore, 1);
+
+   /*
+    * Place code to perform procedure failure and return and the
+    *  end of the outer function.
+    */
+   setloc(Tree3(n));
+   cd_add(p_fail_lbl);
+   cd = NewCode(0);
+   cd->cd_id = C_PFail;
+   cd_add(cd);
+   cd_add(p_ret_lbl);
+   cd = NewCode(0);
+   cd->cd_id = C_PRet;
+   cd_add(cd);
+
+   /*
+    * Fix up signal handling code and perform peephole optimizations.
+    */
+   fix_fncs(fnc_lst);
+
+#ifdef OptimizeLit
+    analyze_literals(procstart, NULL, 0);
+    propagate_literals();
+#endif					/* OptimizeLit */
+
+   /*
+    * The outer function is the first one on the list. It has the
+    *  procedure interface; the others are just continuations.
+    */
+   outerfnc(fnc_lst);
+   for (fnc = fnc_lst->next; fnc != NULL; fnc = fnc->next)
+      if (fnc->ref_cnt > 0)
+         prt_fnc(fnc);
+#ifdef OptimizeLit
+   free_tbl();
+#endif					/* OptimizeLit */
+}
+
+/*
+ * gencode - generate code for a syntax tree.
+ */
+static struct val_loc *gencode(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct code *cd;
+   struct code *cd1;
+   struct code *fail_sav;
+   struct code *lbl1;
+   struct code *lbl2;
+   struct code *cursor_sav;
+   struct c_fnc *fnc_sav;
+   struct c_fnc *fnc;
+   struct implement *impl;
+   struct implement *impl1;
+   struct val_loc *r1[3];
+   struct val_loc *r2[2];
+   struct val_loc *frst_arg;
+   struct lentry *single;
+   struct freetmp *freetmp;
+   struct freetmp *ft;
+   struct tmplftm *lifetm_ary;
+   char *sbuf;
+   int i;
+   int tmp_indx;
+   int nargs;
+   static struct loop_info *loop_info = NULL;
+   struct loop_info *li_sav;
+
+   switch (n->n_type) {
+      case N_Activat:
+         rslt = gen_act(n, rslt);
+         break;
+
+      case N_Alt:
+         rslt = chk_alc(rslt, n->lifetime); /* insure a result location */
+
+         fail_sav = on_failure;
+         fnc_sav = cur_fnc;
+
+         /*
+          * If the first alternative fails, execution must go to the
+          *  "alt" label.
+          */
+         lbl1 = alc_lbl("alt", 0);
+         on_failure = lbl1;
+
+         cd_add(lbl1);
+         cur_fnc->cursor = lbl1->prev;  /* 1st alternative goes before label */
+         gencode(Tree0(n), rslt);
+
+         /*
+          * Each alternative must call the same success continuation.
+          */
+         fnc = alc_fnc();
+         callc_add(fnc);
+
+         cur_fnc = fnc_sav;             /* return to the context of the label */
+         cur_fnc->cursor = lbl1;        /* 2nd alternative goes after label */
+         on_failure = fail_sav;         /* on failure, alternation fails */
+         gencode(Tree1(n), rslt);
+         callc_add(fnc);                /* call continuation */
+
+         /*
+          * Code following the alternation goes in the continuation. If
+          *  the code fails, the continuation returns the resume signal.
+          */
+         cur_fnc = fnc;
+         on_failure = &resume;
+         break;
+
+      case N_Apply:
+         rslt = gen_apply(n, rslt);
+         break;
+
+      case N_Augop:
+         impl = Impl0(n);       /* assignment */
+         impl1 = Impl1(n);      /* the operation */
+         if (impl == NULL || impl1 == NULL) {
+            rslt = &ignore;    /* make sure code generation can continue */
+            break;
+            }
+
+         /*
+          * allocate an argument list for the operation.
+          */
+         lifetm_ary = alc_lftm(2, &n->n_field[2]);
+         tmp_indx = alc_tmp(2, lifetm_ary);
+         r1[0] = tmp_loc(tmp_indx);
+         r1[1] = tmp_loc(tmp_indx + 1);
+
+         gencode(Tree2(n), r1[0]);  /* first argument */
+
+         /*
+          * allocate an argument list for the assignment and copy the
+          *  value of the first argument into it.
+          */
+         lifetm_ary[0].cur_status = InUse;
+         lifetm_ary[1].cur_status = n->postn;
+         lifetm_ary[1].lifetime = n->intrnl_lftm;
+         tmp_indx = alc_tmp(2, lifetm_ary);
+         r2[0] = tmp_loc(tmp_indx++);
+         cd_add(mk_cpyval(r2[0], r1[0]));
+         r2[1] = tmp_loc(tmp_indx);
+
+         gencode(Tree3(n), r1[1]); /* second argument */
+
+         /*
+          * Produce code for the operation.
+          */
+         setloc(n);
+         implproto(impl1);
+         mk_callop(oper_name(impl1), impl1->ret_flag, r1[0], 2, r2[1], 0);
+
+         /*
+          * Produce code for the assignment.
+          */
+         implproto(impl);
+         if (impl->ret_flag & (DoesRet | DoesSusp))
+            rslt = chk_alc(rslt, n->lifetime);
+         mk_callop(oper_name(impl), impl->ret_flag, r2[0], 2, rslt, 0);
+
+         free((char *)lifetm_ary);
+         break;
+
+      case N_Bar: {
+         struct val_loc *fail_flg;
+
+         /*
+          * Allocate an integer variable to keep track of whether the
+          *  repeated alternation should fail when execution reaches
+          *  the top of its loop, and generate code to initialize the
+          *  variable to 0.
+          */
+         fail_flg = itmp_loc(alc_itmp(n->intrnl_lftm));
+         cd = alc_ary(2);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =                fail_flg;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                   " = 0;";
+         cd_add(cd);
+
+         /*
+          * Code at the top of the repeated alternation loop checks
+          *  the failure flag.
+          */
+         lbl1 = alc_lbl("rep alt", 0);
+         cd_add(lbl1);
+         cd = NewCode(2);
+         cd->cd_id = C_If;
+         cd1 = alc_ary(1);
+         cd1->ElemTyp(0) = A_ValLoc;
+         cd1->ValLoc(0) = fail_flg;
+         cd->Cond = cd1;
+         cd->ThenStmt = sig_cd(on_failure, cur_fnc);
+         cd_add(cd);
+
+         /*
+          * If the expression fails without producing a value, the
+          *  repeated alternation must fail.
+          */
+         cd = alc_ary(2);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =                fail_flg;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                   " = 1;";
+         cd_add(cd);
+
+         /*
+          * Generate code for the repeated expression. If it produces
+          *  a value before before backtracking occurs, the loop is
+          *  repeated as indicated by the value of the failure flag.
+          */
+         on_failure = lbl1;
+         rslt = gencode(Tree0(n), rslt);
+         cd = alc_ary(2);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =                fail_flg;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                   " = 0;";
+         cd_add(cd);
+         }
+        break;
+
+      case N_Break:
+         if (loop_info == NULL) {
+            nfatal(n, "invalid context for a break expression", NULL);
+            rslt = &ignore;
+            break;
+            }
+
+         /*
+          * If the break is in a different string scanning context from the
+          *  loop itself, generate code to restore the scanning environment.
+          */
+         if (nxt_scan != loop_info->scan_info)
+            restr_env(loop_info->scan_info->outer_sub,
+               loop_info->scan_info->outer_pos);
+
+
+         if (Tree0(n)->n_type == N_Empty && loop_info->rslt == &ignore) {
+             /*
+              * The break has no associated expression and the loop needs
+              *  no value, so just branch out of the loop.
+              */
+             cd_add(sig_cd(loop_info->end_loop, cur_fnc));
+             }
+         else {
+            /*
+             * The code for the expression associated with the break is
+             *  actually placed at the end of the loop. Go there and
+             *  add a label to branch to.
+             */
+            cursor_sav = cur_fnc->cursor;
+            fnc_sav = cur_fnc;
+            fail_sav = on_failure;
+            cur_fnc = loop_info->end_loop->Container;
+            cur_fnc->cursor = loop_info->end_loop->prev;
+            on_failure = loop_info->on_failure;
+            lbl1 = alc_lbl("break", 0);
+            cd_add(lbl1);
+
+            /*
+             * Make sure a result location has been allocated for the
+             *  loop, restore the loop information for the next outer
+             *  loop, generate code for the break expression, then
+             *  restore the loop information for this loop.
+             */
+            loop_info->rslt = chk_alc(loop_info->rslt, Tree0(n)->lifetime);
+            li_sav = loop_info;
+            loop_info = loop_info->prev;
+            gencode(Tree0(n), li_sav->rslt);
+            loop_info = li_sav;
+
+            /*
+             * If this or another break expression suspends so we cannot
+             *  just branch to the end of the loop, all breaks must
+             *  call a common continuation.
+             */
+            if (cur_fnc->cursor->next != loop_info->end_loop &&
+                loop_info->succ_cont == NULL)
+               loop_info->succ_cont = alc_fnc();
+            if (loop_info->succ_cont == NULL)
+               cd_add(mk_goto(loop_info->end_loop)); /* go to end of loop */
+            else
+               callc_add(loop_info->succ_cont);      /* call continuation */
+
+            /*
+             * Return to the location of the break and generate a branch to
+             *  the code for its associated expression.
+             */
+            cur_fnc = fnc_sav;
+            cur_fnc->cursor = cursor_sav;
+            on_failure = fail_sav;
+            cd_add(sig_cd(lbl1, cur_fnc));
+            }
+         rslt = &ignore;   /* shouldn't be used but must be something valid */
+         break;
+
+      case N_Case:
+         rslt = gen_case(n, rslt);
+         break;
+
+      case N_Create:
+         rslt = gen_creat(n, rslt);
+         break;
+
+      case N_Cset:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+         cd = NewCode(2);
+         cd->cd_id = C_Lit;
+         rslt = chk_alc(rslt, n->lifetime);
+         cd->Rslt = rslt;
+         cd->Literal = CSym0(n);
+         cd_add(cd);
+         break;
+
+      case N_Empty:
+         /*
+          * Assume null value is needed.
+          */
+         if (rslt == &ignore)
+           break;
+         rslt = chk_alc(rslt, n->lifetime);
+         cd_add(asgn_null(rslt));
+         break;
+
+      case N_Field:
+         rslt = field_ref(n, rslt);
+         break;
+
+      case N_Id:
+         /*
+          * If the variable reference is not going to be used, don't bother
+          *  building it.
+          */
+         if (rslt == &ignore)
+           break;
+         cd = NewCode(2);
+         cd->cd_id = C_NamedVar;
+         rslt = chk_alc(rslt, n->lifetime);
+         cd->Rslt = rslt;
+         cd->NamedVar = LSym0(n);
+         cd_add(cd);
+         break;
+
+      case N_If:
+         if (Type(Tree2(n)) == N_Empty) {
+            /*
+             * if-then. Control clause is bounded, but otherwise trivial.
+             */ 
+            bound(Tree0(n), &ignore, 0);  	/* control clause */
+            rslt = gencode(Tree1(n), rslt);     /* then clause */
+            }
+         else {
+            /*
+             * if-then-else. Establish an "else" label as the failure
+             *   label of the bounded control clause.
+             */
+            fail_sav = on_failure;
+            fnc_sav = cur_fnc;
+            lbl1 = alc_lbl("else", 0);
+            on_failure = lbl1;
+
+            bound(Tree0(n), &ignore, 0);  /* control clause */
+
+            cd_add(lbl1);
+            cur_fnc->cursor = lbl1->prev; /* then clause goes before else lbl */
+            on_failure = fail_sav;
+            rslt = chk_alc(rslt, n->lifetime);
+            gencode(Tree1(n), rslt);      /* then clause */
+
+            /*
+             * If the then clause is not a generator, execution can
+             *  just go to the end of the if-then-else expression. If it
+             *  is a generator, the continuation for the expression must be
+             *  in a separate function.
+             */
+            if (cur_fnc->cursor->next == lbl1) {
+               fnc = NULL;
+               lbl2 = alc_lbl("end if", 0);
+               cd_add(mk_goto(lbl2));
+               cur_fnc->cursor = lbl1;
+               cd_add(lbl2);
+               }
+            else {
+               lbl2 = NULL;
+               fnc = alc_fnc();
+               callc_add(fnc);
+               cur_fnc = fnc_sav;
+               }
+
+            cur_fnc->cursor = lbl1;    /* else clause goes after label */
+            on_failure = fail_sav;
+            gencode(Tree2(n), rslt);   /* else clause */
+
+            /*
+             * If the else clause is not a generator, execution is at
+             *  the end of the if-then-else expression, but the if clause
+             *  may have forced the continuation to be in a separate function.
+             *  If the else clause is a generator, it forces the continuation
+             *  to be in a separate function.
+             */
+            if (fnc == NULL) {
+               if (cur_fnc->cursor->next == lbl2)
+                  cur_fnc->cursor = lbl2;
+               else {
+                  fnc = alc_fnc();
+                  callc_add(fnc);
+                  /*
+                   * The then clause is not a generator, so it has branched
+                   *  to lbl2. We must add a call to the continuation there.
+                   */
+                  cur_fnc = fnc_sav;
+                  cur_fnc->cursor = lbl2;
+                  on_failure = fail_sav;
+                  callc_add(fnc);
+                  }
+               }
+            else
+               callc_add(fnc);
+
+            if (fnc != NULL) {
+               /*
+                * We produced a continuation for the if-then-else, so code
+                *  generation must proceed in it.
+                */
+               cur_fnc = fnc;
+               on_failure = &resume;
+               }
+            }
+         break;
+
+      case N_Invok:
+         /*
+          * General invocation.
+          */
+         nargs = Val0(n);
+         if (Tree1(n)->n_type == N_Empty) {
+            /*
+             * Mutual evaluation.
+             */
+            for (i = 2; i <= nargs; ++i)
+               gencode(n->n_field[i].n_ptr, &ignore);   /* arg i - 1 */
+            rslt = chk_alc(rslt, n->lifetime);
+            gencode(n->n_field[nargs + 1].n_ptr, rslt); /* last argument */
+            }
+         else {
+            ++nargs; /* consider the procedure an argument to invoke() */
+            frst_arg = gen_args(n, 1, nargs);
+            setloc(n);
+            /*
+             * Assume this operation uses its result location as a work
+             *   area. Give it a location that is tended, where the value
+             *   is retained as long as the operation can be resumed.
+             */
+            if (rslt == &ignore)
+               rslt = NULL;      /* force allocation of temporary */
+            rslt = chk_alc(rslt, max_lftm(n->lifetime, n->intrnl_lftm));
+            mk_callop( "invoke", DoesRet | DoesFail | DoesSusp, frst_arg, nargs,
+               rslt, 0);
+            }
+         break;
+
+      case N_InvOp:
+         rslt = inv_op(n, rslt);
+         break;
+
+      case N_InvProc:
+         rslt = inv_prc(n, rslt);
+         break;
+
+      case N_InvRec: {
+         /*
+          * Directly invoke a record constructor.
+          */
+         struct rentry *rec;
+
+         nargs = Val0(n);             /* number of arguments */
+         frst_arg = gen_args(n, 2, nargs);
+         setloc(n);
+         rec = Rec1(n);
+
+         rslt = chk_alc(rslt, n->lifetime);
+
+         /*
+          * If error conversion can occur then the record constructor may
+          *  fail and we must check the signal.
+          */
+         if (err_conv) {
+            sbuf = (char *)alloc((unsigned int)(strlen(rec->name) + 
+                strlen("signal = R_") + PrfxSz + 1));
+            sprintf(sbuf, "signal = R%s_%s(", rec->prefix, rec->name);
+            }
+         else {
+            sbuf = (char *)alloc((unsigned int)(strlen(rec->name) + PrfxSz +4));
+            sprintf(sbuf, "R%s_%s(", rec->prefix, rec->name);
+            }
+         cd = alc_ary(9);
+         cd->ElemTyp(0) = A_Str;        /* constructor name */
+         cd->Str(0) = sbuf;
+         cd->ElemTyp(1) = A_Intgr;      /* number of arguments */
+         cd->Intgr(1) = nargs;
+         cd->ElemTyp(2) = A_Str;        /* , */
+         cd->Str(2) = ", ";
+         if (frst_arg == NULL) {        /* location of first argument */
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) = "NULL";
+            cd->ElemTyp(4) = A_Str;
+            cd->Str(4) = "";
+            }
+         else {
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) = "&";
+            cd->ElemTyp(4) = A_ValLoc;
+            cd->ValLoc(4) = frst_arg;
+            }
+         cd->ElemTyp(5) = A_Str;        /* , */
+         cd->Str(5) = ", ";
+         cd->ElemTyp(6) = A_Str;        /* location of result */
+         cd->Str(6) = "&";
+         cd->ElemTyp(7) = A_ValLoc;
+         cd->ValLoc(7) = rslt;
+         cd->ElemTyp(8) = A_Str;
+         cd->Str(8) =                   ");";
+         cd_add(cd);
+         if (err_conv) {
+            cd = NewCode(2);
+            cd->cd_id = C_If;
+            cd1 = alc_ary(1);
+            cd1->ElemTyp(0) = A_Str;
+            cd1->Str(0) =                  "signal == A_Resume";
+            cd->Cond = cd1;
+            cd->ThenStmt = sig_cd(on_failure, cur_fnc);
+            cd_add(cd);
+            }
+         }
+         break;
+
+      case N_Limit:
+         rslt = gen_lim(n, rslt);
+         break;
+
+      case N_Loop: {
+         struct loop_info li;
+
+         /*
+          * Set up loop information for use by break and next expressions.
+          */
+         li.end_loop = alc_lbl("end loop", 0);
+         cd_add(li.end_loop);
+         cur_fnc->cursor = li.end_loop->prev;      /* loop goes before label */
+         li.rslt = rslt;
+         li.on_failure = on_failure;
+         li.scan_info = nxt_scan;
+         li.succ_cont = NULL;
+         li.prev = loop_info;
+         loop_info = &li;
+
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+               /*
+                * "next" in the control clause just fails.
+                */
+               li.next_lbl = &next_fail;
+               gencode(Tree1(n), &ignore);          /* control clause */
+               /*
+                * "next" in the do clause transfers control to the
+                *   statement at the end of the loop that resumes the
+                *   control clause.
+                */
+               li.next_lbl = alc_lbl("next", 0);
+               bound(Tree2(n), &ignore, 1);         /* do clause */
+               cd_add(li.next_lbl);
+               cd_add(sig_cd(on_failure, cur_fnc)); /* resume control clause */
+               break;
+
+            case REPEAT:
+               li.next_lbl = alc_lbl("repeat", 0);
+               cd_add(li.next_lbl);
+               bound(Tree1(n), &ignore, 1);
+               cd_add(mk_goto(li.next_lbl));
+               break;
+
+            case SUSPEND:			/* suspension expression */
+               if (create_lvl > 0) {
+                  nfatal(n, "invalid context for suspend", NULL);
+                  return &ignore;
+                  }
+               /*
+                * "next" in the control clause just fails. The result
+                *   of the control clause goes in the procedure return
+                *   location.
+                */
+               li.next_lbl = &next_fail;
+               genretval(n, Tree1(n), &proc_rslt);
+
+               /*
+                * If necessary, swap scanning environments before suspending.
+                *   if there is no success continuation, just return.
+                */
+               if (nxt_scan != &scan_base) {
+                  save_env(scan_base.inner_sub, scan_base.inner_pos);
+                  restr_env(scan_base.outer_sub, scan_base.outer_pos);
+                  }
+               cd = NewCode(2);
+               cd->cd_id = C_If;
+               cd1 = alc_ary(2);
+               cd1->ElemTyp(0) = A_ProcCont;
+               cd1->ElemTyp(1) = A_Str;
+               cd1->Str(1) = " == NULL";
+               cd->Cond = cd1;
+               cd->ThenStmt = sig_cd(p_ret_lbl, cur_fnc);
+               cd_add(cd);
+               cd = NewCode(0);
+               cd->cd_id = C_PSusp;
+               cd_add(cd);
+               cur_fnc->flag |= CF_ForeignSig;
+
+               /*
+                * Force updating file name and line number, and if needed,
+                *  switch scanning environments before resuming.
+                */
+               lastfiln = NULL;
+               lastline = 0;
+               if (nxt_scan != &scan_base) {
+                  save_env(scan_base.outer_sub, scan_base.outer_pos);
+                  restr_env(scan_base.inner_sub, scan_base.inner_pos);
+                  }
+
+               /*
+                * "next" in the do clause transfers control to the
+                *   statement at the end of the loop that resumes the
+                *   control clause.
+                */
+               li.next_lbl = alc_lbl("next", 0);
+               bound(Tree2(n), &ignore, 1);       /* do clause */
+               cd_add(li.next_lbl);
+               cd_add(sig_cd(on_failure, cur_fnc));
+               break;
+
+            case WHILE:
+               li.next_lbl = alc_lbl("while", 0);
+               cd_add(li.next_lbl);
+               /*
+                * The control clause and do clause are both bounded expressions,
+                *   but only the do clause establishes a new failure label.
+                */
+               bound(Tree1(n), &ignore, 0);      /* control clause */
+               bound(Tree2(n), &ignore, 1);      /* do clause */
+               cd_add(mk_goto(li.next_lbl));
+               break;
+
+            case UNTIL:
+               fail_sav = on_failure;
+               li.next_lbl = alc_lbl("until", 0);
+               cd_add(li.next_lbl);
+
+               /*
+                * If the control clause fails, execution continues in
+                *  the loop.
+                */
+               if (Type(Tree2(n)) == N_Empty)
+                  on_failure = li.next_lbl;  
+               else {
+                  lbl2 = alc_lbl("do", 0);
+                  on_failure = lbl2;
+                  cd_add(lbl2);
+                  cur_fnc->cursor = lbl2->prev;  /* control before label */
+                  }
+               bound(Tree1(n), &ignore, 0);      /* control clause */
+
+               /*
+                * If the control clause succeeds, the loop fails.
+                */
+               cd_add(sig_cd(fail_sav, cur_fnc));
+
+               if (Type(Tree2(n)) != N_Empty) {
+                  /*
+                   * Do clause goes after the label and the loop repeats.
+                   */
+                  cur_fnc->cursor = lbl2;
+                  bound(Tree2(n), &ignore, 1);      /* do clause */
+                  cd_add(mk_goto(li.next_lbl));
+                  }
+               break;
+            }
+
+         /*
+          * Go to the end of the loop and see if the loop's success continuation
+          *  is in a separate function.
+          */
+         cur_fnc = li.end_loop->Container;
+         cur_fnc->cursor = li.end_loop;
+         if (li.succ_cont != NULL) {
+            callc_add(li.succ_cont);
+            cur_fnc = li.succ_cont;
+            on_failure = &resume;
+            }
+         if (li.rslt == NULL)
+            rslt = &ignore; /* shouldn't be used but must be something valid */
+         else
+            rslt = li.rslt;
+         loop_info = li.prev;
+         break;
+         }
+
+      case N_Next:
+         /*
+          * In some contexts "next" just fails. In other contexts it
+          *   transfers control to a label, in which case it may have
+          *   to restore a scanning environment.
+          */
+         if (loop_info == NULL)
+            nfatal(n, "invalid context for a next expression", NULL);
+         else if (loop_info->next_lbl == &next_fail)
+            cd_add(sig_cd(on_failure, cur_fnc));
+         else {
+            if (nxt_scan != loop_info->scan_info)
+               restr_env(loop_info->scan_info->outer_sub,
+                  loop_info->scan_info->outer_pos);
+            cd_add(sig_cd(loop_info->next_lbl, cur_fnc));
+            }
+         rslt = &ignore; /* shouldn't be used but must be something valid */
+         break;
+
+      case N_Not:
+         lbl1 = alc_lbl("not", 0);
+         fail_sav = on_failure;
+         on_failure = lbl1;
+         cd_add(lbl1);
+         cur_fnc->cursor = lbl1->prev;        /* code goes before label */
+         bound(Tree0(n), &ignore, 0);
+         on_failure = fail_sav;
+         cd_add(sig_cd(on_failure, cur_fnc)); /* convert success to failure */
+         cur_fnc->cursor = lbl1;	      /* convert failure to null */
+         if (rslt != &ignore) {
+            rslt = chk_alc(rslt, n->lifetime);
+            cd_add(asgn_null(rslt));
+            }
+         break;
+
+      case N_Ret:
+         if (create_lvl > 0) {
+            nfatal(n, "invalid context for return or fail", NULL);
+            return &ignore;
+            }
+         if (Val0(Tree0(n)) == RETURN) {
+            /*
+             * Set up the failure action of the return expression to do a
+             *  procedure fail.
+             */
+            if (nxt_scan != &scan_base) {
+               /*
+                * we must switch scanning environments if the expression fails.
+                */
+               lbl1 = alc_lbl("return fail", 0);
+               cd_add(lbl1);
+               restr_env(scan_base.outer_sub, scan_base.outer_pos);
+               cd_add(sig_cd(p_fail_lbl, cur_fnc));
+               cur_fnc->cursor = lbl1->prev;        /* code goes before label */
+               on_failure = lbl1;
+               }
+            else
+               on_failure = p_fail_lbl;
+
+            /*
+             * Produce code to place return value in procedure result location.
+             */
+            genretval(n, Tree1(n), &proc_rslt);
+
+            /*
+             * See if a scanning environment must be restored and
+             *  transfer control to the procedure return code.
+             */
+            if (nxt_scan != &scan_base)
+               restr_env(scan_base.outer_sub, scan_base.outer_pos);
+            cd_add(sig_cd(p_ret_lbl, cur_fnc));
+            }
+         else {
+            /*
+             * fail. See if a scanning environment must be restored and
+             *  transfer control to the procedure failure code.
+             */
+            if (nxt_scan != &scan_base)
+               restr_env(scan_base.outer_sub, scan_base.outer_pos);
+            cd_add(sig_cd(p_fail_lbl, cur_fnc));
+            }
+         rslt = &ignore; /* shouldn't be used but must be something valid */
+         break;
+
+      case N_Scan:
+         rslt = gen_scan(n, rslt);
+         break;
+
+      case N_Sect:
+         /*
+          * x[i+:j] or x[i-:j] (x[i:j] handled as ordinary operator)
+          */
+         impl1 = Impl0(n);     /* sectioning */
+         if (impl1 == NULL) {
+            rslt = &ignore;    /* make sure code generation can continue */
+            break;
+            }
+         implproto(impl1);
+
+         impl = Impl1(n);      /* plus or minus */
+         /*
+          * Allocate work area of temporary variables for sectioning.
+          */
+         lifetm_ary = alc_lftm(3, NULL);
+         lifetm_ary[0].cur_status = Tree2(n)->postn;
+         lifetm_ary[0].lifetime = n->intrnl_lftm;
+         lifetm_ary[1].cur_status = Tree3(n)->postn;
+         lifetm_ary[1].lifetime = n->intrnl_lftm;
+         lifetm_ary[2].cur_status = n->postn;
+         lifetm_ary[2].lifetime = n->intrnl_lftm;
+         tmp_indx = alc_tmp(3, lifetm_ary);
+         for (i = 0; i < 3; ++i)
+            r1[i] = tmp_loc(tmp_indx++);
+         gencode(Tree2(n), r1[0]);   /* generate code to compute x */
+         gencode(Tree3(n), r1[1]);   /* generate code compute i */
+
+         /*
+          * Allocate work area of temporary variables for arithmetic.
+          */
+         lifetm_ary[0].cur_status = InUse;
+         lifetm_ary[0].lifetime = Tree3(n)->lifetime;
+         lifetm_ary[1].cur_status = Tree4(n)->postn;
+         lifetm_ary[1].lifetime = Tree4(n)->lifetime;
+         tmp_indx = alc_tmp(2, lifetm_ary);
+         for (i = 0; i < 2; ++i)
+            r2[i] = tmp_loc(tmp_indx++);
+         cd_add(mk_cpyval(r2[0], r1[1])); /* generate code to copy i */
+         gencode(Tree4(n), r2[1]);        /* generate code to compute j */
+
+         /*
+          * generate code for i op j.
+          */
+         setloc(n);
+         implproto(impl);
+         mk_callop(oper_name(impl), impl->ret_flag, r2[0], 2, r1[2], 0);
+
+         /*
+          * generate code for x[i : (i op j)]
+          */
+         rslt = chk_alc(rslt, n->lifetime);
+         mk_callop(oper_name(impl1),impl1->ret_flag,r1[0],3,rslt,0);
+         free((char *)lifetm_ary);
+         break;
+
+      case N_Slist:
+         bound(Tree0(n), &ignore, 1);
+         rslt = gencode(Tree1(n), rslt);
+         break;
+
+      case N_SmplAsgn: {
+         struct val_loc *var, *val;
+
+         /*
+          * Optimized assignment to a named variable. Use information
+          *  from type inferencing to determine if the right-hand-side
+          *  is a variable.
+          */
+         var = var_ref(LSym0(Tree2(n)));
+         if (HasVar(varsubtyp(Tree3(n)->type, &single)))
+            Val0(n) = AsgnDeref;
+         if (single != NULL) {
+            /*
+             * Right-hand-side results in a named variable. Compute
+             *  the expression but don't bother saving the result, we
+             *  know what it is. Assignment just copies value from
+             *  one variable to the other.
+             */
+            gencode(Tree3(n), &ignore);
+            val = var_ref(single);
+            cd_add(mk_cpyval(var, val));
+            }
+         else switch (Val0(n)) { 
+            case AsgnDirect:
+               /*
+                * It is safe to compute the result directly into the variable.
+                */
+               gencode(Tree3(n), var);
+               break;
+            case AsgnCopy:
+               /*
+                * The result is not a variable reference, but it is not
+                *  safe to compute it into the variable, we must use a
+                *  temporary variable.
+                */
+               val = gencode(Tree3(n), NULL);
+               cd_add(mk_cpyval(var, val));
+               break;
+            case AsgnDeref:
+               /*
+                * We must dereference the result into the variable.
+                */
+               val = gencode(Tree3(n), NULL);
+               deref_cd(val, var);
+               break;
+            }
+
+         /*
+          * If the assignment has to produce a result, construct the
+          *  variable reference.
+          */
+         if (rslt != &ignore)
+            rslt = gencode(Tree2(n), rslt);
+         }
+         break;
+
+      case N_SmplAug: {
+         /*
+          * Optimized augmented assignment to a named variable.
+          */
+         struct val_loc *var, *val;
+
+         impl = Impl1(n);      /* the operation */
+         if (impl == NULL) {
+            rslt = &ignore;    /* make sure code generation can continue */
+            break;
+            }
+
+         implproto(impl); /* insure prototype for operation */
+
+         /*
+          * Generate code to compute the arguments for the operation.
+          */
+         frst_arg = gen_args(n, 2, 2);
+         setloc(n);
+
+         /*
+          * Use information from type inferencing to determine if the
+          *  operation produces a variable.
+          */
+         if (HasVar(varsubtyp(Typ4(n), &single)))
+            Val0(n) = AsgnDeref;
+         var = var_ref(LSym0(Tree2(n)));
+         if (single != NULL) {
+            /*
+             * The operation results in a named variable. Call the operation
+             *  but don't bother saving the result, we know what it is.
+             *  Assignment just copies value from one variable to the other.
+             */
+            mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2,
+                  &ignore, 0);
+            val = var_ref(single);
+            cd_add(mk_cpyval(var, val));
+            }
+         else switch (Val0(n)) { 
+            case AsgnDirect:
+               /*
+                * It is safe to compute the result directly into the variable.
+                */
+               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2,
+                  var, 0);
+               break;
+            case AsgnCopy:
+               /*
+                * The result is not a variable reference, but it is not
+                *  safe to compute it into the variable, we must use a
+                *  temporary variable.
+                */
+               val = chk_alc(NULL, n);
+               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2, val, 0);
+               cd_add(mk_cpyval(var, val));
+               break;
+            case AsgnDeref:
+               /*
+                * We must dereference the result into the variable.
+                */
+               val = chk_alc(NULL, n);
+               mk_callop(oper_name(impl), impl->ret_flag, frst_arg, 2, val, 0);
+               deref_cd(val, var);
+               break;
+            }
+
+         /*
+          * If the assignment has to produce a result, construct the
+          *  variable reference.
+          */
+         if (rslt != &ignore)
+            rslt = gencode(Tree2(n), rslt);
+         }
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+
+   /*
+    * Free any temporaries whose lifetime ends at this node.
+    */
+   freetmp = n->freetmp;
+   while (freetmp != NULL) {
+      switch (freetmp->kind) {
+         case DescTmp:
+            tmp_status[freetmp->indx] = freetmp->old;
+            break;
+         case CIntTmp:
+            itmp_status[freetmp->indx] = freetmp->old;
+            break;
+         case CDblTmp:
+            dtmp_status[freetmp->indx] = freetmp->old;
+            break;
+         case SBuf:
+            sbuf_status[freetmp->indx] = freetmp->old;
+            break;
+         case CBuf:
+            cbuf_status[freetmp->indx] = freetmp->old;
+            break;
+         }
+      ft = freetmp->next;
+      freetmp->next = freetmp_pool;
+      freetmp_pool = freetmp;
+      freetmp = ft;
+      }
+   return rslt;
+   }
+
+/*
+ * chk_alc - make sure a result location has been allocated. If it is
+ *  a temporary variable, indicate that it is now in use.
+ */
+struct val_loc *chk_alc(rslt, lifetime)
+struct val_loc *rslt;
+nodeptr lifetime;
+   {
+   struct tmplftm tmplftm;
+
+   if (rslt == NULL) {
+      if (lifetime == NULL)
+         rslt = &ignore;
+      else {
+         tmplftm.cur_status = InUse;
+         tmplftm.lifetime = lifetime;
+         rslt = tmp_loc(alc_tmp(1, &tmplftm));
+         }
+      }
+   else if (rslt->loc_type == V_Temp)
+      tmp_status[rslt->u.tmp] = InUse;
+   return rslt;
+   }
+
+/*
+ * mk_goto - make a code structure for goto label
+ */
+struct code *mk_goto(label)
+struct code *label;
+   {
+   register struct code *cd;
+
+   cd = NewCode(1);    /* # fields == # fields of C_RetSig & C_Break */
+   cd->cd_id = C_Goto;
+   cd->next = NULL;
+   cd->prev = NULL;
+   cd->Lbl = label;
+   ++label->RefCnt;
+   return cd;
+   }
+
+/*
+ * mk_cpyval - make code to copy a value from one location to another.
+ */
+static struct code *mk_cpyval(loc1, loc2)
+struct val_loc *loc1;
+struct val_loc *loc2;
+   {
+   struct code *cd;
+
+   cd = alc_ary(4);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) = loc1;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) = " = ";
+   cd->ElemTyp(2) = A_ValLoc;
+   cd->ValLoc(2) = loc2;
+   cd->ElemTyp(3) = A_Str;
+   cd->Str(3) = ";";
+   return cd;
+   }
+
+/*
+ * asgn_null - make code to assign the null value to a location.
+ */
+static struct code *asgn_null(loc1)
+struct val_loc *loc1;
+   {
+   struct code *cd;
+
+   cd = alc_ary(2);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) = loc1;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) = " = nulldesc;";
+   return cd;
+   }
+
+/*
+ * oper_name - create the name for the most general implementation of an Icon
+ *   operation.
+ */
+static char *oper_name(impl)
+struct implement *impl;
+   {
+   char *sbuf;
+
+   sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
+   sprintf(sbuf, "%c%c%c_%s", impl->oper_typ, impl->prefix[0], impl->prefix[1],
+      impl->name);
+   return sbuf;
+   }
+
+/*
+ * gen_args - generate code to evaluate an argument list.
+ */
+static struct val_loc *gen_args(n, frst_arg, nargs)
+struct node *n;
+int frst_arg;
+int nargs;
+   {
+   struct tmplftm *lifetm_ary;
+   int i;
+   int tmp_indx;
+
+   if (nargs == 0)
+      return NULL;
+
+   lifetm_ary = alc_lftm(nargs, &n->n_field[frst_arg]);
+   tmp_indx = alc_tmp(nargs, lifetm_ary);
+   for (i = 0; i < nargs; ++i)
+      gencode(n->n_field[frst_arg + i].n_ptr, tmp_loc(tmp_indx + i));
+   free((char *)lifetm_ary);
+   return tmp_loc(tmp_indx);
+   }
+
+/*
+ * gen_case - generate code for a case expression.
+ */
+static struct val_loc *gen_case(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct node *control;
+   struct node *cases;
+   struct node *deflt;
+   struct node *clause;
+   struct val_loc *r1;
+   struct val_loc *r2;
+   struct val_loc *r3;
+   struct code *cd;
+   struct code *cd1;
+   struct code *fail_sav;
+   struct code *skp_lbl;
+   struct code *cd_lbl;
+   struct code *end_lbl;
+   struct c_fnc *fnc_sav;
+   struct c_fnc *succ_cont = NULL;
+
+   control = Tree0(n);
+   cases = Tree1(n);
+   deflt = Tree2(n);
+
+   /*
+    * The control clause is bounded.
+    */
+   r1 = chk_alc(NULL, n); 
+   bound(control, r1, 0);
+
+   /*
+    * Remember the context in which the case expression occurs and
+    *  establish a label at the end of the expression.
+    */
+   fail_sav = on_failure;
+   fnc_sav = cur_fnc;
+   end_lbl = alc_lbl("end case", 0);
+   cd_add(end_lbl);
+   cur_fnc->cursor = end_lbl->prev; /* generate code before the end label */
+
+   /*
+    * All cases share the result location of the case expression.
+    */
+   rslt = chk_alc(rslt, n->lifetime);
+   r2 = chk_alc(NULL, n);      /* for result of selection clause */
+   r3 = chk_alc(NULL, n);      /* for dereferenced result of control clause */
+
+   while (cases != NULL) {
+      /*
+       * See if we are at the end of the case clause list.
+       */
+      if (cases->n_type == N_Ccls) {
+         clause = cases;
+         cases = NULL;
+         }
+      else {
+         clause = Tree1(cases);
+         cases = Tree0(cases);
+         }
+
+      /*
+       * If the evaluation of the selection code or the comparison of
+       *  its value to the control clause fail, execution will proceed
+       *  to the "skip clause" label and on to the next case.
+       */
+      skp_lbl = alc_lbl("skip clause", 0);
+      on_failure = skp_lbl;
+      cd_add(skp_lbl);
+      cur_fnc->cursor = skp_lbl->prev;  /* generate code before end label */
+
+      /*
+       * Bound the selection code for this clause.
+       */
+      cd_lbl = alc_lbl("selected code", Bounding);
+      cd_add(cd_lbl);
+      cur_fnc->cursor = cd_lbl->prev; 
+      gencode(Tree0(clause), r2);
+
+      /*
+       * Dereference the results of the control clause and the selection
+       *  clause and compare them.
+       */
+      setloc(clause);
+      deref_cd(r1, r3);
+      deref_cd(r2, r2);
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(5);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) =                 "!equiv(&";
+      cd1->ElemTyp(1) = A_ValLoc;
+      cd1->ValLoc(1) =              r3;
+      cd->Cond = cd1;
+      cd1->ElemTyp(2) = A_Str;
+      cd1->Str(2) =                 ", &";
+      cd1->ElemTyp(3) = A_ValLoc;
+      cd1->ValLoc(3) =              r2;
+      cd1->ElemTyp(4) = A_Str;
+      cd1->Str(4) =                 ")";
+      cd->ThenStmt = sig_cd(on_failure, cur_fnc); 
+      cd_add(cd);
+      cd_add(sig_cd(cd_lbl, cur_fnc));  /* transfer control to bounding label */
+
+      /*
+       * Generate code for the body of this clause after the bounding label.
+       */
+      cur_fnc = fnc_sav;
+      cur_fnc->cursor = cd_lbl;
+      on_failure = fail_sav;
+      gencode(Tree1(clause), rslt);
+
+      /*
+       * If this clause is a generator, call the success continuation
+       *  for the case expression, otherwise branch to the end of the
+       *  expression.
+       */
+      if (cur_fnc->cursor->next != skp_lbl) {
+         if (succ_cont == NULL)
+            succ_cont = alc_fnc(); /* allocate a continuation function */
+         callc_add(succ_cont);
+         cur_fnc = fnc_sav;
+         }
+      else
+         cd_add(mk_goto(end_lbl));
+
+      /*
+       * The code for the next clause goes after the  "skip" label of
+       *   this clause.
+       */
+      cur_fnc->cursor = skp_lbl;
+      }
+
+   if (deflt == NULL)
+      cd_add(sig_cd(fail_sav, cur_fnc));     /* default action is failure */
+   else {
+      /*
+       * There is an explicit default action.
+       */
+      on_failure = fail_sav;
+      gencode(deflt, rslt);
+      if (cur_fnc->cursor->next != end_lbl) {
+         if (succ_cont == NULL)
+            succ_cont = alc_fnc();
+         callc_add(succ_cont);
+         cur_fnc = fnc_sav;
+         }
+      }
+   cur_fnc->cursor = end_lbl;
+
+   /*
+    * If some clauses are generators but others have transferred control
+    *  to here, we must call the success continuation of the case
+    *  expression and generate subsequent code there.
+    */
+   if (succ_cont != NULL) {
+      on_failure = fail_sav;
+      callc_add(succ_cont);
+      cur_fnc = succ_cont;
+      on_failure = &resume;
+      }
+   return rslt;
+   }
+
+/*
+ * gen_creat - generate code to create a co-expression.
+ */
+static struct val_loc *gen_creat(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct code *cd;
+   struct code *fail_sav;
+   struct code *fail_lbl;
+   struct c_fnc *fnc_sav;
+   struct c_fnc *fnc;
+   struct val_loc *co_rslt;
+   struct freetmp *ft;
+   char sav_prfx[PrfxSz];
+   int *tmp_sv;
+   int *itmp_sv;
+   int *dtmp_sv;
+   int *sbuf_sv;
+   int *cbuf_sv;
+   int ntmp_sv;
+   int nitmp_sv;
+   int ndtmp_sv;
+   int nsbuf_sv;
+   int ncbuf_sv;
+   int stat_sz_sv;
+   int istat_sz_sv;
+   int dstat_sz_sv;
+   int sstat_sz_sv;
+   int cstat_sz_sv;
+   int i;
+
+
+   rslt = chk_alc(rslt, n->lifetime);
+
+   fail_sav = on_failure;
+   fnc_sav = cur_fnc;
+   for (i = 0; i < PrfxSz; ++i)
+      sav_prfx[i] = frm_prfx[i];
+
+   /*
+    * Temporary variables are allocated independently for the co-expression.
+    */
+   tmp_sv = tmp_status;
+   itmp_sv = itmp_status;
+   dtmp_sv = dtmp_status;
+   sbuf_sv = sbuf_status;
+   cbuf_sv = cbuf_status;
+   stat_sz_sv = status_sz;
+   istat_sz_sv = istatus_sz;
+   dstat_sz_sv = dstatus_sz;
+   sstat_sz_sv = sstatus_sz;
+   cstat_sz_sv = cstatus_sz;
+   ntmp_sv = num_tmp;
+   nitmp_sv = num_itmp;
+   ndtmp_sv = num_dtmp;
+   nsbuf_sv = num_sbuf;
+   ncbuf_sv = num_cbuf;
+   tmp_status = (int *)alloc((unsigned int)(status_sz * sizeof(int)));
+   itmp_status = (int *)alloc((unsigned int)(istatus_sz * sizeof(int)));
+   dtmp_status = (int *)alloc((unsigned int)(dstatus_sz * sizeof(int)));
+   sbuf_status = (int *)alloc((unsigned int)(sstatus_sz * sizeof(int)));
+   cbuf_status = (int *)alloc((unsigned int)(cstatus_sz * sizeof(int)));
+   for (i = 0; i < status_sz; ++i)
+      tmp_status[i] = NotAlloc;
+   for (i = 0; i < istatus_sz; ++i)
+      itmp_status[i] = NotAlloc;
+   for (i = 0; i < dstatus_sz; ++i)
+      dtmp_status[i] = NotAlloc;
+   for (i = 0; i < sstatus_sz; ++i)
+      sbuf_status[i] = NotAlloc;
+   for (i = 0; i < cstatus_sz; ++i)
+      cbuf_status[i] = NotAlloc;
+   num_tmp = 0;
+   num_itmp = 0;
+   num_dtmp = 0;
+   num_sbuf = 0;
+   num_cbuf = 0;
+
+   /*
+    * Put code for co-expression in separate function. We will need a new
+    *  type of procedure frame which contains copies of local variables,
+    *  copies of arguments, and temporaries for use by the co-expression.
+    */
+   fnc = alc_fnc();
+   fnc->ref_cnt = 1;
+   fnc->flag |= CF_Coexpr;
+   ChkPrefix(fnc->prefix);
+   for (i = 0; i < PrfxSz; ++i)
+      frm_prfx[i] = fnc->frm_prfx[i] = fnc->prefix[i];
+   cur_fnc = fnc;
+
+   /*
+    * Set up a co-expression failure label followed by a context switch
+    *  and a branch back to the failure label.
+    */
+   fail_lbl = alc_lbl("co_fail", 0);
+   cd_add(fail_lbl);
+   lastline = 0;  /* force setting line number so tracing matches interp */
+   setloc(n);
+   cd = alc_ary(2);
+   cd->ElemTyp(0) = A_Str;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(0) = "co_chng(popact((struct b_coexpr *)BlkLoc(k_current)),";
+   cd->Str(1) =    "NULL, NULL, A_Cofail, 1);";
+   cd_add(cd);
+   cd_add(mk_goto(fail_lbl));
+   cur_fnc->cursor = fail_lbl->prev;  /* code goes before failure label */
+   on_failure = fail_lbl;
+
+   /*
+    * Generate code for the co-expression body, using the same
+    *  dereferencing rules as for procedure return.
+    */
+   lastfiln = "";  /* force setting of file name and line number */
+   lastline = 0;
+   setloc(n);
+   ++create_lvl;
+   co_rslt = genretval(n, Tree0(n), NULL);
+   --create_lvl;
+
+   /*
+    * If the co-expression might produce a result, generate a co-expression
+    *  context switch.
+    */
+   if (co_rslt != NULL) {
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) = "++BlkLoc(k_current)->coexpr.size;";
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) = "co_chng(popact((struct b_coexpr *)BlkLoc(k_current)), &";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) = co_rslt;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) = ", NULL, A_Coret, 1);";
+      cd_add(cd);
+      cd_add(sig_cd(on_failure, cur_fnc)); /* if reactivated, resume expr */
+      }
+
+   /*
+    * Output the new frame definition.
+    */
+   prt_frame(frm_prfx, cur_proc->tnd_loc + num_tmp + Abs(cur_proc->nargs),
+      num_itmp, num_dtmp, num_sbuf, num_cbuf);
+
+   /*
+    * Now return to original function and produce code to create the
+    *  co-expression.
+    */
+   cur_fnc = fnc_sav;
+   for (i = 0; i < PrfxSz; ++i)
+      frm_prfx[i] = sav_prfx[i];
+   on_failure = fail_sav;
+
+   lastfiln = "";  /* force setting of file name and line number */
+   lastline = 0;
+   setloc(n);
+   cd = NewCode(5);
+   cd->cd_id =  C_Create;
+   cd->Rslt = rslt;
+   cd->Cont = fnc;
+   cd->NTemps = num_tmp;
+   cd->WrkSize = num_itmp;
+   cd->NextCreat = cur_fnc->creatlst;
+   cur_fnc->creatlst = cd;
+   cd_add(cd);
+
+   /*
+    * Restore arrays for temporary variable allocation.
+    */
+   free((char *)tmp_status);
+   free((char *)itmp_status);
+   free((char *)dtmp_status);
+   free((char *)sbuf_status);
+   free((char *)cbuf_status);
+   tmp_status = tmp_sv;
+   itmp_status = itmp_sv;
+   dtmp_status = dtmp_sv;
+   sbuf_status = sbuf_sv;
+   cbuf_status = cbuf_sv;
+   status_sz = stat_sz_sv;
+   istatus_sz = istat_sz_sv;
+   dstatus_sz = dstat_sz_sv;
+   sstatus_sz = sstat_sz_sv;
+   cstatus_sz = cstat_sz_sv;
+   num_tmp = ntmp_sv;
+   num_itmp = nitmp_sv;
+   num_dtmp = ndtmp_sv;
+   num_sbuf = nsbuf_sv;
+   num_cbuf = ncbuf_sv;
+
+   /*
+    * Temporary variables that exist to the end of the co-expression
+    *   have no meaning in the surrounding code and must not be
+    *   deallocated there.
+    */
+   while (n->freetmp != NULL) {
+      ft = n->freetmp->next;
+      n->freetmp->next = freetmp_pool;
+      freetmp_pool = n->freetmp;
+      n->freetmp = ft;
+      }
+
+   return rslt;
+   }
+
+/*
+ * gen_lim - generate code for limitation.
+ */
+static struct val_loc *gen_lim(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct node *expr;
+   struct node *limit;
+   struct val_loc *lim_desc;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+   struct code *fail_sav;
+   struct c_fnc *fnc_sav;
+   struct c_fnc *succ_cont;
+   struct val_loc *lim_int;
+   struct lentry *single;
+   int deref;
+
+   expr = Tree0(n);
+   limit = Tree1(n);
+
+   /*
+    * Generate code to compute the limitation value and dereference it.
+    */
+   deref = HasVar(varsubtyp(limit->type, &single));
+   if (single != NULL) {
+      /*
+       * Limitation is in a named variable. Use value directly from
+       *  the variable rather than saving the result of the expression.
+       */
+      gencode(limit, &ignore);
+      lim_desc = var_ref(single);
+      }
+   else {
+      lim_desc = gencode(limit, NULL);
+      if (deref)
+         deref_cd(lim_desc, lim_desc);
+      }
+
+   setloc(n);
+   fail_sav = on_failure;
+
+   /*
+    * Try to convert the limitation value into an integer.
+    */
+   lim_int = itmp_loc(alc_itmp(n->intrnl_lftm));
+   cur_symtyps = n->symtyps;
+   if (largeints || (eval_is(int_typ, 0) & MaybeFalse)) {
+      /*
+       * Must call the conversion routine.
+       */
+      lbl = alc_lbl("limit is int", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* conversion goes before label */
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(5);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) =                  "cnv_c_int(&";
+      cd1->ElemTyp(1) = A_ValLoc;
+      cd1->ValLoc(1) =               lim_desc;
+      cd1->ElemTyp(2) = A_Str;
+      cd1->Str(2) =                  ", &";
+      cd1->ElemTyp(3) = A_ValLoc;
+      cd1->ValLoc(3) =                lim_int;
+      cd1->ElemTyp(4) = A_Str;
+      cd1->Str(4) =                  ")";
+      cd->Cond = cd1;
+      cd->ThenStmt = mk_goto(lbl);
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                  "err_msg(101, &";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =               lim_desc;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                  ");";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+   else {
+      /*
+       * The C integer is in the vword.
+       */
+      cd = alc_ary(4);
+      cd->ElemTyp(0) = A_ValLoc;
+      cd->ValLoc(0) =                lim_int;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =                   " = IntVal(";
+      cd->ElemTyp(2) = A_ValLoc;
+      cd->ValLoc(2) =                lim_desc;
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) =                   ");";
+      cd_add(cd);
+      }
+
+   /*
+    * Make sure the limitation value is positive.
+    */
+   lbl = alc_lbl("limit positive", 0);
+   cd_add(lbl);
+   cur_fnc->cursor = lbl->prev;        /* code goes before label */
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(2);
+   cd1->ElemTyp(0) = A_ValLoc;
+   cd1->ValLoc(0) =                lim_int;
+   cd1->ElemTyp(1) = A_Str;
+   cd1->Str(1) =                  " >= 0";
+   cd->Cond = cd1;
+   cd->ThenStmt = mk_goto(lbl);
+   cd_add(cd);
+   cd = alc_ary(3);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                  "err_msg(205, &";
+   cd->ElemTyp(1) = A_ValLoc;
+   cd->ValLoc(1) =               lim_desc;
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                  ");";
+   cd_add(cd);
+   if (err_conv)
+      cd_add(sig_cd(on_failure, cur_fnc));
+   cur_fnc->cursor = lbl;
+
+   /*
+    * If the limitation value is 0, fail immediately.
+    */
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(2);
+   cd1->ElemTyp(0) = A_ValLoc;
+   cd1->ValLoc(0) =              lim_int;
+   cd1->ElemTyp(1) = A_Str;
+   cd1->Str(1) =                  " == 0";
+   cd->Cond = cd1;
+   cd->ThenStmt = sig_cd(on_failure, cur_fnc);
+   cd_add(cd);
+
+   /*
+    * Establish where to go when limit has been reached.
+    */
+   fnc_sav = cur_fnc;
+   lbl = alc_lbl("limit", 0);
+   cd_add(lbl);
+   cur_fnc->cursor = lbl->prev;  /* limited expression goes before label */
+
+   /*
+    * Generate code for limited expression and to check the limit value.
+    */
+   rslt = gencode(expr, rslt);
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(3);
+   cd1->ElemTyp(0) = A_Str;
+   cd1->Str(0) =                  "--";
+   cd1->ElemTyp(1) = A_ValLoc;
+   cd1->ValLoc(1) =               lim_int;
+   cd1->ElemTyp(2) = A_Str;
+   cd1->Str(2) =                  " == 0";
+   cd->Cond = cd1;
+   cd->ThenStmt = sig_cd(lbl, cur_fnc);
+   cd_add(cd);
+
+   /*
+    * Call the success continuation both here and after the limitation
+    *  label.
+    */
+   succ_cont = alc_fnc();
+   callc_add(succ_cont);
+   cur_fnc = fnc_sav;
+   cur_fnc->cursor = lbl;
+   on_failure = fail_sav;
+   callc_add(succ_cont);
+   cur_fnc = succ_cont;
+   on_failure = &resume;
+
+   return rslt;
+   }
+
+/*
+ * gen_apply - generate code for the apply operator, !.
+ */
+static struct val_loc *gen_apply(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct val_loc *callee;
+   struct val_loc *lst;
+   struct code *arg_lst;
+   struct code *on_ret;
+   struct c_fnc *fnc;
+
+   /*
+    * Generate code to compute the two operands.
+    */
+   callee = gencode(Tree0(n), NULL);
+   lst = gencode(Tree1(n), NULL);
+   rslt = chk_alc(rslt, n->lifetime);
+   setloc(n);
+
+   /*
+    * Construct argument list for apply().
+    */
+   arg_lst = alc_ary(6);
+   arg_lst->ElemTyp(0) = A_Str;
+   arg_lst->Str(0) =                   "&";
+   arg_lst->ElemTyp(1) = A_ValLoc;
+   arg_lst->ValLoc(1) =                callee;
+   arg_lst->ElemTyp(2) = A_Str;
+   arg_lst->Str(2) =                   ", &";
+   arg_lst->ElemTyp(3) = A_ValLoc;
+   arg_lst->ValLoc(3) =                lst;
+   arg_lst->ElemTyp(4) = A_Str;
+   arg_lst->Str(4) =                   ", &";
+   arg_lst->ElemTyp(5) = A_ValLoc;
+   arg_lst->ValLoc(5) =                rslt;
+
+   /*
+    * Generate code to call apply(). Assume the operation can suspend and
+    *   allocate a continuation. If it returns a "continue" signal,
+    *   just break out of the signal handling code and fall into a call
+    *   to the continuation.
+    */
+   on_ret = NewCode(1);      /* #fields for C_Break == #fields for C_Goto */
+   on_ret->cd_id = C_Break;
+   on_ret->next = NULL;
+   on_ret->prev = NULL;
+   fnc = alc_fnc();          /* success continuation */
+   callo_add("apply", DoesFail | DoesRet | DoesSusp, fnc, 1, arg_lst, on_ret);
+   callc_add(fnc);
+   cur_fnc = fnc;            /* subsequent code goes in the continuation */
+   on_failure = &resume;
+
+   return rslt;
+   }
+
+
+/*
+ * gen_scan - generate code for string scanning.
+ */
+static struct val_loc *gen_scan(n, rslt)
+nodeptr n;
+struct val_loc *rslt;
+   {
+   struct node *op;
+   struct node *subj;
+   struct node *body;
+   struct scan_info *scanp;
+   struct val_loc *asgn_var;
+   struct val_loc *new_subj;
+   struct val_loc *scan_rslt;
+   struct tmplftm *lifetm_ary;
+   struct lentry *subj_single;
+   struct lentry *body_single;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+   struct implement *impl;
+   int subj_deref;
+   int body_deref;
+   int op_tok;
+   int tmp_indx;
+
+   op = Tree0(n);          /* operator node '?' or '?:=' */
+   subj = Tree1(n);        /* subject expression */
+   body = Tree2(n);        /* scanning expression */
+   op_tok = optab[Val0(op)].tok.t_type;
+
+   /*
+    * The location of the save areas for scanning environments is stored
+    *  in list so they can be accessed by expressions that transfer
+    *  control out of string scanning. Get the next list element and
+    *  allocate the save areas in the procedure frame.
+    */
+   scanp = nxt_scan;
+   if (nxt_scan->next == NULL)
+      nxt_scan->next = NewStruct(scan_info);
+   nxt_scan = nxt_scan->next;
+   scanp->outer_sub = chk_alc(NULL, n->intrnl_lftm);
+   scanp->outer_pos = itmp_loc(alc_itmp(n->intrnl_lftm));
+   scanp->inner_sub = chk_alc(NULL, n->intrnl_lftm); 
+   scanp->inner_pos = itmp_loc(alc_itmp(n->intrnl_lftm));
+
+   subj_deref = HasVar(varsubtyp(subj->type, &subj_single));
+   if (subj_single != NULL) {
+      /*
+       * The subject value is in a named variable. Use value directly from
+       *  the variable rather than saving the result of the expression.
+       */
+      gencode(subj, &ignore);
+      new_subj = var_ref(subj_single);
+
+      if (op_tok == AUGQMARK) {
+         body_deref = HasVar(varsubtyp(body->type, &body_single));
+         if (body_single != NULL)
+            scan_rslt = &ignore; /* we know where the value will be */
+         else
+            scan_rslt = chk_alc(NULL, n->intrnl_lftm);
+         }
+      else
+         scan_rslt = rslt; /* result of 2nd operand is result of scanning */
+      }
+   else if (op_tok == AUGQMARK) {
+      /*
+       * Augmented string scanning using general assignment. The operands
+       *  must be in consecutive locations.
+       */
+      lifetm_ary = alc_lftm(2, &n->n_field[1]);
+      tmp_indx = alc_tmp(2, lifetm_ary);
+      asgn_var = tmp_loc(tmp_indx++);
+      scan_rslt = tmp_loc(tmp_indx);
+      free((char *)lifetm_ary);
+
+      gencode(subj, asgn_var);
+      new_subj = chk_alc(NULL, n->intrnl_lftm);
+      deref_cd(asgn_var, new_subj);
+      }
+   else {
+      new_subj = gencode(subj, NULL);
+      if (subj_deref)
+          deref_cd(new_subj, new_subj);
+      scan_rslt = rslt; /* result of 2nd operand is result of scanning */
+      }
+
+   /*
+    * Produce code to save the old scanning environment.
+    */
+   setloc(op);
+   save_env(scanp->outer_sub, scanp->outer_pos);
+
+   /*
+    * Produce code to handle failure of the body of string scanning.
+    */
+   lbl = alc_lbl("scan fail", 0);
+   cd_add(lbl);
+   restr_env(scanp->outer_sub, scanp->outer_pos);
+   cd_add(sig_cd(on_failure, cur_fnc)); /* fail */
+   cur_fnc->cursor = lbl->prev;         /* body goes before label */
+   on_failure = lbl;
+
+   /*
+    * If necessary, try to convert the subject to a string. Note that if
+    *   error conversion occurs, backtracking will restore old subject.
+    */
+   cur_symtyps = n->symtyps;
+   if (eval_is(str_typ, 0) & MaybeFalse) {
+      lbl = alc_lbl("&subject is string", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(3);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) =                 "cnv_str(&";
+      cd1->ElemTyp(1) = A_ValLoc;
+      cd1->ValLoc(1) =              new_subj;
+      cd1->ElemTyp(2) = A_Str;
+      cd1->Str(2) =                 ", &k_subject)";
+      cd->Cond = cd1;
+      cd->ThenStmt = mk_goto(lbl);
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                  "err_msg(103, &";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =               new_subj;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                  ");";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+   else {
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                  "k_subject = ";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =               new_subj;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                  ";";
+      cd_add(cd);
+      }
+   cd = alc_ary(1);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                 "k_pos = 1;";
+   cd_add(cd);
+
+   scan_rslt = gencode(body, scan_rslt);
+
+   setloc(op);
+   if (op_tok == AUGQMARK) {
+      /*
+       * '?:=' - perform assignment.
+       */
+      if (subj_single != NULL) {
+         /*
+          * Assignment to a named variable.
+          */
+         if (body_single != NULL)
+            cd_add(mk_cpyval(new_subj, var_ref(body_single)));
+         else if (body_deref)
+            deref_cd(scan_rslt, new_subj);
+         else
+             cd_add(mk_cpyval(new_subj, scan_rslt));
+         }
+      else {
+         /*
+          * Use general assignment.
+          */
+         impl = optab[asgn_loc].binary;
+         if (impl == NULL) {
+            nfatal(op, "assignment not implemented", NULL);
+            rslt = &ignore; /* make sure code generation can continue */
+            }
+         else {
+            implproto(impl);
+            rslt = chk_alc(rslt, n->lifetime);
+            mk_callop(oper_name(impl), impl->ret_flag, asgn_var, 2, rslt,0);
+            }
+         }
+      }
+   else {
+      /*
+       * '?'
+       */
+      rslt = scan_rslt;
+      }
+
+   /*
+    * Produce code restore subject and pos when the body of the
+    *  scanning expression succeeds. The new subject and pos must
+    *  be saved in case of resumption.
+    */
+   save_env(scanp->inner_sub, scanp->inner_pos);
+   restr_env(scanp->outer_sub, scanp->outer_pos);
+
+   /*
+    * Produce code to handle resumption of string scanning.
+    */
+   lbl = alc_lbl("scan resume", 0);
+   cd_add(lbl);
+   save_env(scanp->outer_sub, scanp->outer_pos);
+   restr_env(scanp->inner_sub, scanp->inner_pos);
+   cd_add(sig_cd(on_failure, cur_fnc)); /* fail */
+   cur_fnc->cursor = lbl->prev;     /* success continuation goes before label */
+   on_failure = lbl;
+
+   nxt_scan = scanp;
+   return rslt;
+   }
+
+/*
+ * gen_act - generate code for co-expression activation.
+ */
+static struct val_loc *gen_act(n, rslt)
+nodeptr n;
+struct val_loc *rslt;
+   {
+   struct node *op;
+   struct node *transmit;
+   struct node *coexpr;
+   struct tmplftm *lifetm_ary;
+   struct val_loc *trans_loc;
+   struct val_loc *coexpr_loc;
+   struct val_loc *asgn1;
+   struct val_loc *asgn2;
+   struct val_loc *act_rslt;
+   struct lentry *c_single;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+   struct implement *impl;
+   int c_deref;
+   int op_tok;
+   int tmp_indx;
+
+   op = Tree0(n);        /* operator node for '@' or '@:=' */
+   transmit = Tree1(n);  /* expression for value to transmit */
+   coexpr = Tree2(n);    /* expression for co-expression */
+   op_tok = optab[Val0(op)].tok.t_type;
+
+   /*
+    * Produce code for the value to be transmitted.
+    */
+   if (op_tok == AUGAT) {
+      /*
+       * Augmented activation. This is seldom used so don't try too
+       *  hard to optimize it. Allocate contiguous temporaries for
+       *  the operands to the assignment.
+       */
+      lifetm_ary = alc_lftm(2, &n->n_field[1]);
+      tmp_indx = alc_tmp(2, lifetm_ary);
+      asgn1 = tmp_loc(tmp_indx++);
+      asgn2 = tmp_loc(tmp_indx);
+      free((char *)lifetm_ary);
+
+      /*
+       * Generate code to produce the left-hand-side of the assignment.
+       *  This is also the transmitted value. Activation may need a
+       *  dereferenced value, so this must be in a different location.
+       */
+      gencode(transmit, asgn1);
+      trans_loc = chk_alc(NULL, n->intrnl_lftm);
+      setloc(op);
+      deref_ret(asgn1, trans_loc, varsubtyp(transmit->type, NULL));
+      }
+   else
+      trans_loc = genretval(op, transmit, NULL); /* ordinary activation */
+
+   /*
+    * Determine if the value to be activated needs dereferencing, and
+    *  see if it can only come from a single named variable.
+    */
+   c_deref = HasVar(varsubtyp(coexpr->type, &c_single));
+   if (c_single == NULL) {
+      /*
+       * The value is something other than a single named variable.
+       */
+      coexpr_loc = gencode(coexpr, NULL);
+      if (c_deref)
+         deref_cd(coexpr_loc, coexpr_loc);
+      }
+   else {
+      /*
+       * The value is in a named variable. Use it directly from the
+       *  variable rather than saving the result of the expression.
+       */
+      gencode(coexpr, &ignore);
+      coexpr_loc = var_ref(c_single);
+      }
+
+   /*
+    * Make sure the value to be activated is a co-expression. Perform
+    *   run-time checking if necessary.
+    */
+   cur_symtyps = n->symtyps;
+   if (eval_is(coexp_typ, 1) & MaybeFalse) {
+      lbl = alc_lbl("is co-expression", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(3);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) =                  "(";
+      cd1->ElemTyp(1) = A_ValLoc;
+      cd1->ValLoc(1) =               coexpr_loc;
+      cd1->ElemTyp(2) = A_Str;
+      cd1->Str(2) =                  ").dword == D_Coexpr";
+      cd->Cond = cd1;
+      cd->ThenStmt = mk_goto(lbl);
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                   "err_msg(118, &(";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =                coexpr_loc;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                   "));";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+
+   /*
+    * Make sure a result location has been allocated. For ordinary
+    *  activation, this is where activate() puts its result. For
+    *  augmented activation, this is where assignment puts its result.
+    */
+   rslt = chk_alc(rslt, n->lifetime);
+   if (op_tok == AUGAT)
+      act_rslt = asgn2;
+   else
+      act_rslt = rslt;
+
+   /*
+    * Generate code to call activate().
+    */
+   setloc(n);
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(7);
+   cd1->ElemTyp(0) = A_Str;
+   cd1->Str(0) =                  "activate(&";
+   cd1->ElemTyp(1) = A_ValLoc;
+   cd1->ValLoc(1) =                trans_loc;
+   cd1->ElemTyp(2) = A_Str;
+   cd1->Str(2) =                  ", (struct b_coexpr *)BlkLoc(";
+   cd1->ElemTyp(3) = A_ValLoc;
+   cd1->ValLoc(3) =                coexpr_loc;
+   cd1->ElemTyp(4) = A_Str;
+   cd1->Str(4) =                  "), &";
+   cd1->ElemTyp(5) = A_ValLoc;
+   cd1->ValLoc(5) =                act_rslt;
+   cd1->ElemTyp(6) = A_Str;
+   cd1->Str(6) =                  ") == A_Resume";
+   cd->Cond = cd1;
+   cd->ThenStmt = sig_cd(on_failure, cur_fnc);
+   cd_add(cd);
+
+   /*
+    * For augmented activation, generate code to call assignment.
+    */
+   if (op_tok == AUGAT) {
+      impl = optab[asgn_loc].binary;
+      if (impl == NULL) {
+         nfatal(op, "assignment not implemented", NULL);
+         rslt = &ignore; /* make sure code generation can continue */
+         }
+      else {
+         implproto(impl);
+         mk_callop(oper_name(impl), impl->ret_flag, asgn1, 2, rslt, 0);
+         }
+      }
+
+   return rslt;
+   }
+
+/*
+ * save_env - generate code to save scanning environment.
+ */
+static void save_env(sub_sav, pos_sav)
+struct val_loc *sub_sav;
+struct val_loc *pos_sav;
+   {
+   struct code *cd;
+
+   cd = alc_ary(2);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =              sub_sav;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                 " = k_subject;";
+   cd_add(cd);
+   cd = alc_ary(2);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =              pos_sav;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                 " = k_pos;";
+   cd_add(cd);
+   }
+
+/*
+ * restr_env - generate code to restore scanning environment.
+ */
+static void restr_env(sub_sav, pos_sav)
+struct val_loc *sub_sav;
+struct val_loc *pos_sav;
+   {
+   struct code *cd;
+
+   cd = alc_ary(3);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                 "k_subject = ";
+   cd->ElemTyp(1) = A_ValLoc;
+   cd->ValLoc(1) =              sub_sav;
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                 ";";
+   cd_add(cd);
+   cd = alc_ary(3);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                 "k_pos = ";
+   cd->ElemTyp(1) = A_ValLoc;
+   cd->ValLoc(1) =              pos_sav;
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                 ";";
+   cd_add(cd);
+   }
+
+/*
+ * mk_callop - produce the code to directly call an operation.
+ */
+static void mk_callop(oper_nm, ret_flag, arg1rslt, nargs, rslt, optim)
+char *oper_nm;
+int ret_flag;
+struct val_loc *arg1rslt;
+int nargs;
+struct val_loc *rslt;
+int optim;
+   {
+   struct code *arg_lst;
+   struct code *on_ret;
+   struct c_fnc *fnc;
+   int n;
+   int need_cont;
+
+   /*
+    * If this operation can return an "continue" signal, we will need
+    *   a break statement in the signal switch to handle it.
+    */
+   if (ret_flag & DoesRet) {
+      on_ret = NewCode(1);      /* #fields == #fields C_Goto */
+      on_ret->cd_id = C_Break;
+      on_ret->next = NULL;
+      on_ret->prev = NULL;
+      }
+   else
+      on_ret = NULL;
+
+   /*
+    * Construct argument list for the C function implementing the
+    *  operation. First compute the size of the code array for the
+    *  argument list; this varies if we are using an optimized calling
+    *  interface.
+    */
+   if (optim) {
+      n = 0;
+      if (arg1rslt != NULL)
+         n += 2;
+      if (ret_flag & (DoesRet | DoesSusp)) {
+         if (n > 0)
+            ++n;
+         n += 2;
+         }
+      }
+   else
+      n = 7;
+   if (n == 0)
+      arg_lst = NULL;
+   else {
+      arg_lst = alc_ary(n);
+      n = 0;
+      if (!optim) {
+         arg_lst->ElemTyp(n) = A_Intgr;       /* number of arguments */
+         arg_lst->Intgr(n) = nargs;
+         ++n;
+         arg_lst->ElemTyp(n) = A_Str;        /* , */
+         arg_lst->Str(n) = ", ";
+         ++n;
+         }
+      if (arg1rslt == NULL) {             /* location of first argument */
+         if (!optim) {
+            arg_lst->ElemTyp(n) = A_Str;
+            arg_lst->Str(n) = "NULL";
+            ++n;
+            arg_lst->ElemTyp(n) = A_Str;
+            arg_lst->Str(n) = "";         /* nothing, but must fill slot */
+            ++n;
+            }
+         }
+      else {
+         arg_lst->ElemTyp(n) = A_Str;
+         arg_lst->Str(n) = "&";
+         ++n;
+         arg_lst->ElemTyp(n) = A_ValLoc;
+         arg_lst->ValLoc(n) = arg1rslt;
+         ++n;
+         }
+      if (!optim || ret_flag & (DoesRet | DoesSusp)) {
+         if (n > 0) {
+            arg_lst->ElemTyp(n) = A_Str;        /* , */
+            arg_lst->Str(n) = ", ";
+            ++n;
+            }
+         arg_lst->ElemTyp(n) = A_Str;        /* location of result */
+         arg_lst->Str(n) = "&";
+         ++n;
+         arg_lst->ElemTyp(n) = A_ValLoc;
+         arg_lst->ValLoc(n) = rslt;
+         }
+      }
+
+   /*
+    * Generate code to call the operation and handle returned signals.
+    */
+   if (ret_flag & DoesSusp) {
+      /*
+       * The operation suspends, so call it with a continuation, then
+       *  proceed to generate code in the continuation.
+       */
+      fnc = alc_fnc();
+      callo_add(oper_nm, ret_flag, fnc, 1, arg_lst, on_ret);
+      if (ret_flag & DoesRet)
+         callc_add(fnc);
+      cur_fnc = fnc;
+      on_failure = &resume;
+      }
+   else {
+      /*
+       * No continuation is needed, but if standard calling conventions
+       *  are used, a NULL continuation argument is required.
+       */
+      if (optim)
+         need_cont = 0;
+      else
+         need_cont = 1;
+      callo_add(oper_nm, ret_flag, NULL, need_cont, arg_lst, on_ret);
+      }
+}
+
+/*
+ * genretval - generate code for the expression in a return/suspend or
+ *  for the expression for the value to be transmitted in a co-expression
+ *  context switch.
+ */
+static struct val_loc *genretval(n, expr, dest)
+struct node *n;
+struct node *expr;
+struct val_loc *dest;
+   {
+   int subtypes;
+   struct lentry *single;
+   struct val_loc *val;
+
+   subtypes = varsubtyp(expr->type, &single);
+
+   /*
+    * If we have a single local or argument, we don't need to construct
+    *  a variable reference; we need the value and we know where it is.
+    */
+   if (single != NULL && (subtypes & (HasLcl | HasPrm))) {
+      gencode(expr, &ignore);
+      val = var_ref(single);
+      if (dest == NULL)
+         dest = val;
+      else
+         cd_add(mk_cpyval(dest, val));
+      }
+   else {
+      dest = gencode(expr, dest);
+      setloc(n);
+      deref_ret(dest, dest, subtypes);
+      }
+
+   return dest;
+   }
+
+/*
+ * deref_ret - produced dereferencing code for values returned from
+ *  procedures or transmitted to co-expressions.
+ */
+static void deref_ret(src, dest, subtypes)
+struct val_loc *src;
+struct val_loc *dest;
+int subtypes;
+   {
+   struct code *cd;
+   struct code *lbl;
+
+   if (src == NULL)
+      return;  /* no value to dereference */
+
+   /*
+    * If there may be values that do not need dereferencing, insure that the
+    *  values are in the destination and make it the source of dereferencing.
+    */
+   if ((subtypes & (HasVal | HasGlb)) && (src != dest)) {
+      cd_add(mk_cpyval(dest, src));
+      src = dest;
+      }
+
+   if (subtypes & (HasLcl | HasPrm)) {
+      /*
+       * Some values may need to be dereferenced.
+       */
+      lbl = NULL;
+      if (subtypes & HasVal) {
+         /*
+          * We may have a non-variable and must check at run time.
+          */
+         lbl = check_var(dest, NULL);
+         }
+
+      if (subtypes & HasGlb) {
+         /*
+          * Make sure we don't dereference any globals, use retderef().
+          */
+         if (subtypes & HasLcl) {
+            /*
+             * We must dereference any locals.
+             */
+            cd = alc_ary(3);
+            cd->ElemTyp(0) = A_Str;
+            cd->Str(0) =                "retderef(&";
+            cd->ElemTyp(1) = A_ValLoc;
+            cd->ValLoc(1) =             dest;
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =
+               ", (word *)pfp->tend.d, (word *)(pfp->tend.d + pfp->tend.num));";
+            cd_add(cd);
+            /*
+             * We may now have a value. We must check at run-time and skip
+             *  any attempt to dereference an argument.
+             */
+            lbl = check_var(dest, lbl);
+            }
+   
+         if (subtypes & HasPrm) {
+            /*
+             * We must dereference any arguments.
+             */
+            cd = alc_ary(5);
+            cd->ElemTyp(0) = A_Str;
+            cd->Str(0) =                "retderef(&";
+            cd->ElemTyp(1) = A_ValLoc;
+            cd->ValLoc(1) =             dest;
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                ", (word *)glbl_argp, (word *)(glbl_argp + ";
+            cd->ElemTyp(3) = A_Intgr;
+            cd->Intgr(3) =              Abs(cur_proc->nargs);
+            cd->ElemTyp(4) = A_Str;
+            cd->Str(4) =                 "));";
+            cd_add(cd);
+            }
+         }
+      else /* No globals */
+         deref_cd(src, dest);
+
+      if (lbl != NULL)
+         cur_fnc->cursor = lbl;   /* continue after label */
+      }
+   }
+
+/*
+ * check_var - generate code to make sure a descriptor contains a variable
+ *  reference. If no label is given to jump to for a non-variable, allocate
+ *  one and generate code before it.
+ */
+static struct code *check_var(d, lbl)
+struct val_loc *d;
+struct code *lbl;
+   {
+   struct code *cd, *cd1;
+
+   if (lbl == NULL) {
+      lbl = alc_lbl("not variable", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      }
+
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(3);
+   cd1->ElemTyp(0) = A_Str;
+   cd1->Str(0) =                  "!Var(";
+   cd1->ElemTyp(1) = A_ValLoc;
+   cd1->ValLoc(1) =               d;
+   cd1->ElemTyp(2) = A_Str;
+   cd1->Str(2) =                  ")";
+   cd->Cond = cd1;
+   cd->ThenStmt = mk_goto(lbl);
+   cd_add(cd);
+
+   return lbl;
+   }
+
+/*
+ * field_ref - generate code for a field reference.
+ */
+static struct val_loc *field_ref(n, rslt)
+struct node *n;
+struct val_loc *rslt;
+   {
+   struct node *rec;
+   struct node *fld;
+   struct fentry *fp;
+   struct par_rec *rp;
+   struct val_loc *rec_loc;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+   struct lentry *single;
+   int deref;
+   int num_offsets;
+   int offset;
+   int bad_recs;
+
+   rec = Tree0(n);
+   fld = Tree1(n);
+
+   /*
+    * Generate code to compute the record value and dereference it.
+    */
+   deref = HasVar(varsubtyp(rec->type, &single));
+   if (single != NULL) {
+      /*
+       * The record is in a named variable. Use value directly from
+       *  the variable rather than saving the result of the expression.
+       */
+      gencode(rec, &ignore);
+      rec_loc = var_ref(single);
+      }
+   else {
+      rec_loc = gencode(rec, NULL);
+      if (deref)
+         deref_cd(rec_loc, rec_loc);
+      }
+
+   setloc(fld);
+
+   /*
+    * Make sure the operand is a record.
+    */
+   cur_symtyps = n->symtyps;
+   if (eval_is(rec_typ, 0) & MaybeFalse) {
+      lbl = alc_lbl("is record", 0);
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      cd = NewCode(2);
+      cd->cd_id = C_If;
+      cd1 = alc_ary(3);
+      cd1->ElemTyp(0) = A_Str;
+      cd1->Str(0) =                  "(";
+      cd1->ElemTyp(1) = A_ValLoc;
+      cd1->ValLoc(1) =               rec_loc;
+      cd1->ElemTyp(2) = A_Str;
+      cd1->Str(2) =                  ").dword == D_Record";
+      cd->Cond = cd1;
+      cd->ThenStmt = mk_goto(lbl);
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                   "err_msg(107, &";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =                rec_loc;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                   ");";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+
+   rslt = chk_alc(rslt, n->lifetime);
+
+   /*
+    * Find the list of records containing this field.
+    */
+   if ((fp = flookup(Str0(fld))) == NULL) {
+      nfatal(n, "invalid field", Str0(fld));
+      return rslt;
+      }
+
+   /*
+    * Generate code for declarations and to get the record block pointer.
+    */
+   cd = alc_ary(1);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =             "{";
+   cd_add(cd);
+   cd = alc_ary(3);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =           "struct b_record *r_rp = (struct b_record *) BlkLoc(";
+   cd->ElemTyp(1) = A_ValLoc;
+   cd->ValLoc(1) =          rec_loc;
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =             ");";
+   cd_add(cd);
+   if (err_conv) {
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =             "int r_must_fail = 0;";
+      cd_add(cd);
+      }
+
+   /*
+    * Determine which records are in the record type.
+    */
+   mark_recs(fp, cur_symtyps->types[0], &num_offsets, &offset, &bad_recs);
+
+   /*
+    * Generate code to insure that the field belongs to the record
+    *  and to index into the record block.
+    */
+   if (num_offsets == 1 && !bad_recs) {
+      /*
+       * We already know the offset of the field.
+       */
+      cd = alc_ary(4);
+      cd->ElemTyp(0) = A_ValLoc;
+      cd->ValLoc(0) =           rslt;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =              ".dword = D_Var + ((word *)&r_rp->fields[";
+      cd->ElemTyp(2) = A_Intgr;
+      cd->Intgr(2) =            offset;
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) =              "] - (word *)r_rp);";
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "VarLoc(";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =           rslt;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =              ") = (dptr)r_rp;";
+      cd_add(cd);
+      for (rp = fp->rlist; rp != NULL; rp = rp->next)
+         rp->mark = 0;
+      }
+   else {
+      /*
+       * The field appears in several records. generate code to determine
+       *  which one it is.
+       */
+
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "dptr r_dp;";
+      cd_add(cd);
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "switch (r_rp->recdesc->proc.recnum) {";
+      cd_add(cd);
+
+      rp = fp->rlist;
+      while (rp != NULL) {
+         offset = rp->offset;
+         while (rp != NULL && rp->offset == offset) {
+            if (rp->mark) {
+               rp->mark = 0;
+               cd = alc_ary(3);
+               cd->ElemTyp(0) = A_Str;
+               cd->Str(0) =              "   case ";
+               cd->ElemTyp(1) = A_Intgr;
+               cd->Intgr(1) =            rp->rec->rec_num;
+               cd->ElemTyp(2) = A_Str;
+               cd->Str(2) =              ":";
+               cd_add(cd);
+               }
+            rp = rp->next;
+            }
+
+         cd = alc_ary(3);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "      r_dp = &r_rp->fields[";
+         cd->ElemTyp(1) = A_Intgr;
+         cd->Intgr(1) =                   offset;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                     "];";
+         cd_add(cd);
+         cd = alc_ary(1);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "      break;";
+         cd_add(cd);
+         }
+
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "   default:";
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "      err_msg(207, &";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =                   rec_loc;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                     ");";
+      cd_add(cd);
+      if (err_conv) {
+         /*
+          * The peephole analyzer doesn't know how to handle a goto or return
+          *  in a switch statement, so just set a flag here.
+          */
+         cd = alc_ary(1);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =       "      r_must_fail = 1;";
+         cd_add(cd);
+         }
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "   }";
+      cd_add(cd);
+      if (err_conv) {
+         /*
+          * Now that we are out of the switch statement, see if the flag
+          *   was set to indicate error conversion.
+          */
+         cd = NewCode(2);
+         cd->cd_id = C_If;
+         cd1 = alc_ary(1);
+         cd1->ElemTyp(0) = A_Str;
+         cd1->Str(0) =                  "r_must_fail";
+         cd->Cond = cd1;
+         cd->ThenStmt = sig_cd(on_failure, cur_fnc);
+         cd_add(cd);
+         }
+      cd = alc_ary(2);
+      cd->ElemTyp(0) = A_ValLoc;
+      cd->ValLoc(0) =           rslt;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =            ".dword = D_Var + ((word *)r_dp - (word *)r_rp);";
+      cd_add(cd);
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "VarLoc(";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =           rslt;
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =              ") = (dptr)r_rp;";
+      cd_add(cd);
+      }
+
+   cd = alc_ary(1);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =              "}";
+   cd_add(cd);
+   return rslt;
+   }
+
+/*
+ * bound - bound the code for the given sub-tree. If catch_fail is true,
+ *   direct failure to the bounding label.
+ */
+static struct val_loc *bound(n, rslt, catch_fail)
+struct node *n;
+struct val_loc *rslt;
+int catch_fail;
+   {
+   struct code *lbl1;
+   struct code *fail_sav;
+   struct c_fnc *fnc_sav;
+
+   fnc_sav = cur_fnc;
+   fail_sav = on_failure;
+
+   lbl1 = alc_lbl("bound", Bounding);
+   cd_add(lbl1);
+   cur_fnc->cursor = lbl1->prev;     /* code goes before label */
+   if (catch_fail)
+      on_failure = lbl1;
+
+   rslt = gencode(n, rslt);
+
+   cd_add(sig_cd(lbl1, cur_fnc));   /* transfer control to bounding label */
+   cur_fnc = fnc_sav;
+   cur_fnc->cursor = lbl1;
+
+   on_failure = fail_sav;
+   return rslt;
+   }
+
+/*
+ * cd_add - add a code struct at the cursor in the current function.
+ */
+void cd_add(cd)
+struct code *cd;
+   {
+   register struct code *cursor;
+
+   cursor = cur_fnc->cursor;
+
+   cd->next = cursor->next;
+   cd->prev = cursor;
+   if (cursor->next != NULL)
+      cursor->next->prev = cd;
+   cursor->next = cd;
+   cur_fnc->cursor = cd;
+   }
+
+/*
+ * sig_cd - convert a signal/label into a goto or return signal in
+ *   the context of the given function.
+ */
+struct code *sig_cd(sig, fnc)
+struct code *sig;
+struct c_fnc *fnc;
+   {
+   struct code *cd;
+
+   if (sig->cd_id == C_Label && sig->Container == fnc)
+      return mk_goto(sig);
+   else {
+      cd = NewCode(1);      /* # fields <= # fields of C_Goto */
+      cd->cd_id = C_RetSig;
+      cd->next = NULL;
+      cd->prev = NULL;
+      cd->SigRef = add_sig(sig, fnc);
+      return cd;
+      }
+   }
+
+/*
+ * add_sig - add signal to list of signals returned by function.
+ */
+struct sig_lst *add_sig(sig, fnc)
+struct code *sig;
+struct c_fnc *fnc;
+   {
+   struct sig_lst *sl;
+
+   for (sl = fnc->sig_lst; sl != NULL && sl->sig != sig; sl = sl->next)
+      ;
+   if (sl == NULL) {
+      sl = NewStruct(sig_lst);
+      sl->sig = sig;
+      sl->ref_cnt = 1;
+      sl->next = fnc->sig_lst;
+      fnc->sig_lst = sl;
+      }
+   else
+      ++sl->ref_cnt;
+   return sl;
+   }
+
+/*
+ * callc_add - add code to call a continuation. Note the action to be
+ *  taken if the continuation returns resumption. The actual list
+ *  signals returned and actions to take will be figured out after
+ *  the continuation has been optimized.
+ */
+void callc_add(cont)
+struct c_fnc *cont;
+   {
+   struct code *cd;
+
+   cd = new_call();
+   cd->OperName = NULL;
+   cd->Cont = cont;
+   cd->ArgLst = NULL;
+   cd->ContFail = on_failure;
+   cd->SigActs = NULL;
+   ++cont->ref_cnt;
+   }
+
+/*
+ * callo_add - add code to call an operation.
+ */
+void callo_add(oper_nm, ret_flag, cont, need_cont, arglist, on_ret)
+char *oper_nm;
+int ret_flag;
+struct c_fnc *cont;
+int need_cont;
+struct code *arglist;
+struct code *on_ret;
+   {
+   struct code *cd;
+   struct code *cd1;
+
+   cd = new_call();
+   cd->OperName = oper_nm;
+   cd->Cont = cont;
+   if (need_cont)
+      cd->Flags = NeedCont;
+   cd->ArgLst = arglist;
+   cd->ContFail = NULL;   /* operation handles failure from the continuation */
+   /*
+    * Decide how to handle the signals produced by the operation. (Those
+    *  produced by the continuation will be examined after the continuation
+    *  is optimized.)
+    */
+   cd->SigActs = NULL;
+   if (MightFail(ret_flag))
+      cd->SigActs = new_sgact(&resume, sig_cd(on_failure,cur_fnc), cd->SigActs);
+   if (ret_flag & DoesRet)
+      cd->SigActs = new_sgact(&contin, on_ret, cd->SigActs);
+   if (ret_flag & DoesFThru) {
+      cd1 = NewCode(1);      /* #fields == #fields C_Goto */
+      cd1->cd_id = C_Break;
+      cd1->next = NULL;
+      cd1->prev = NULL;
+      cd->SigActs = new_sgact(&fallthru, cd1, cd->SigActs);
+   }
+   if (cont != NULL)
+      ++cont->ref_cnt;  /* increment reference count */
+}
+
+/* 
+ * Create a call, add it to the code for the current function, and 
+ *  add it to the list of calls from the current function.
+ */
+static struct code *new_call()
+   {
+   struct code *cd;
+
+   cd = NewCode(7);
+   cd->cd_id = C_CallSig;
+   cd_add(cd);
+   cd->Flags = 0;
+   cd->NextCall = cur_fnc->call_lst;
+   cur_fnc->call_lst = cd;
+   return cd;
+   }
+
+/*
+ * sig_act - create a new binding of an action to a signal.
+ */
+struct sig_act *new_sgact(sig, cd, next)
+struct code *sig;
+struct code *cd;
+struct sig_act *next;
+   {
+   struct sig_act *sa;
+
+   sa = NewStruct(sig_act);
+   sa->sig = sig;
+   sa->cd = cd;
+   sa->shar_act = NULL;
+   sa->next = next;
+   return sa;
+   }
+
+
+#ifdef OptimizeLit
+static int instr(const char *str, int chr)  {
+   int i, found, go;
+
+   found = 0; go = 1;
+   for(i=0; ((str[i] != '\0') && go) ;i++) {
+      if (str[i] == chr) {
+         go = 0;
+         found = 1;
+         if ((str[i+1] != '\0') && (chr == '='))
+            if (str[i+1] == '=')
+               found = 0;
+         if ((chr == '=') && (i > 0))  {
+            if (str[i-1] == '>')
+               found = 0;
+            else if (str[i-1] == '<')
+               found = 0;
+            else if (str[i-1] == '!')
+               found = 0;
+         }
+      }
+   }
+   return found;
+}
+
+static void tbl_add(struct lit_tbl *add)  {
+   struct lit_tbl *ins;
+   static struct lit_tbl *ptr = NULL;
+   int    go = 1;
+
+   if (tbl == NULL) {
+      tbl = add;
+      ptr = add;
+   }
+   else  {
+      ins = ptr;
+      while ((ins != NULL) && go)  {
+         if (add->index != ins->index)
+            ins = ins->prev;
+         else
+            go = 0;
+      }
+      if (ins != NULL) {
+         if (ins->end == NULL)
+            ins->end = add->initial;
+      }
+      ptr->next = add;
+      add->prev = ptr;
+      ptr = add;
+   }
+}
+
+
+static void invalidate(struct val_loc *val, struct code *end, int code)  {
+   struct lit_tbl  *ptr, *back;
+   int    index, go = 1;
+
+   if (val == NULL)
+      return;
+   if (val->loc_type == V_NamedVar) {
+      index = val->u.nvar->val.index;
+      return;
+   }
+   else if (val->loc_type == V_Temp)
+      index = val->u.tmp + cur_proc->tnd_loc;
+   else
+      return;
+   if (tbl == NULL)
+      return;
+   back = tbl;
+   while (back->next != NULL)
+      back = back->next;
+   go = 1;
+   for(ptr=back; ((ptr != NULL) && go) ; ptr=ptr->prev) {
+      if ((ptr->index == index) && (ptr->modified != NO_TOUCH)) {
+         ptr->modified = code; 
+         if ((code != LIMITED_TO_INT) && (ptr->safe)) {
+            ptr->end = end;
+            ptr->safe = 0;
+         }
+         go = 0;
+      }
+      else if ((ptr->index == index) && (ptr->modified == NO_TOUCH)) {
+         if ((code != LIMITED_TO_INT) && (ptr->safe)) {
+            ptr->end = end;
+            ptr->safe = 0;
+         }
+         go = 0;
+      }
+      else if (ptr->index == index)
+         go = 0;
+   }
+}
+
+
+static int eval_code(struct code *cd, struct lit_tbl *cur)  {
+   struct code *tmp;
+   struct lit_tbl *tmp_tbl;
+   int    i, j;
+   char  *str;
+
+   for (i=0; cd->ElemTyp(i) != A_End ;i++)  {
+      switch(cd->ElemTyp(i))  {
+         case A_ValLoc:
+            if (cd->ValLoc(i)->mod_access != M_CInt)
+               break;
+            if ((cd->ValLoc(i)->u.tmp + cur_proc->tnd_loc) == cur->index) {
+               switch (cd->ValLoc(i)->loc_type)  {
+                  case V_Temp:
+                     if (cur->csym->flag == F_StrLit)  {
+#if 0
+                        cd->ElemTyp(i) = A_Str;
+                        str = (char *)alloc(strlen(cur->csym->image)+8);
+			sprintf(str, "\"%s\"/*Z*/", cur->csym->image);
+                        cd->Str(i) = str;
+#endif
+                     }
+                     else if (cur->csym->flag == F_IntLit) {
+                        cd->ElemTyp(i) = A_Str;
+                        cd->Str(i) = cur->csym->image;
+                     }
+                     break;
+                  default:
+                     break;
+               }
+            }
+            break;
+         case A_Ary:
+            for(tmp=cd->Array(i); tmp != NULL ;tmp=tmp->next)
+               eval_code(tmp, cur);
+            break;
+         default:
+            break;
+      }
+   }
+}
+
+static void propagate_literals()  {
+   struct lit_tbl *ptr;
+   struct code    *cd, *arg;
+   int    ret;
+
+   for(ptr=tbl; ptr != NULL ;ptr=ptr->next)  {
+      if (ptr->modified != NO_TOUCH) {
+         for(cd=ptr->initial; cd != ptr->end ;cd=cd->next)  {
+            switch (cd->cd_id)  {
+               case C_If:
+                  for(arg=cd->Cond; arg != NULL ;arg=arg->next)
+                     ret = eval_code(arg, ptr);
+		  /*
+		   * Again, don't take the 'then' portion.
+		   * It might lead to infinite loops.
+		   *  for(arg=cd->ThenStmt; arg != NULL ;arg=arg->next)
+                   *      ret = eval_code(arg, ptr);
+		   */
+                  break; 
+               case C_CdAry:
+                  ret = eval_code(cd, ptr);
+                  break; 
+               case C_CallSig:
+                  for(arg=cd->ArgLst; arg != NULL ;arg=arg->next)
+                     ret = eval_code(arg, ptr);
+                  break; 
+               default:
+                  break; 
+            }
+         } 
+      }
+   }
+}
+
+/*
+ * analyze_literals - analyzes the generated code to replace
+ *                      complex record dereferences with  C
+ *                      literals.
+ */
+static void analyze_literals(struct code *start, struct code *top, int lvl)  {
+   struct code *ptr, *tmp, *not_null;
+   struct lit_tbl *new_tbl;
+   struct lbl_tbl *new_lbl;
+   struct val_loc *prev = NULL;
+   int i, inc=0, addr=0, assgn=0, equal = 0;
+
+   for (ptr = start; ptr != NULL ; ptr = ptr->next)  {
+      if (!lvl)
+         not_null = ptr;
+      else
+         not_null = top;
+      switch (ptr->cd_id)  {
+         case C_NamedVar:
+            break;
+         case C_CallSig:
+            analyze_literals(ptr->ArgLst, not_null, lvl+1);
+            break;
+         case C_Goto:
+            break;
+         case C_Label:
+            break;
+         case C_Lit:
+            new_tbl = alc_tbl();
+            new_tbl->initial = ptr;
+            new_tbl->vloc = ptr->Rslt;
+            new_tbl->csym = ptr->Literal;
+            switch (ptr->Rslt->loc_type) {
+               case V_NamedVar:
+                  new_tbl->index = ptr->Rslt->u.nvar->val.index;
+                  tbl_add(new_tbl);
+                  break;
+               case V_Temp:
+                  new_tbl->index = ptr->Rslt->u.tmp + cur_proc->tnd_loc;
+                  tbl_add(new_tbl);
+                  break;
+               default:
+                  new_tbl->index = -1;
+                  free(new_tbl);
+                  break;
+            }
+            break;
+         case C_If:
+            analyze_literals(ptr->Cond, not_null, lvl+1);
+	    /*
+	     *  Don't analyze the 'then' portion such as in:
+             *   analyze_literals(ptr->ThenStmt, not_null, lvl+1);
+	     *  Apparently, all the intermediate code does is maintain
+	     *   a pointer to where the flow of execution jumps to in
+	     *   case the 'then' is taken.  These are all goto statments
+	     *   and can result in infinite loops of analyzation.
+             */
+            break;
+         case C_CdAry:
+            for(i=0; ptr->ElemTyp(i) != A_End ;i++)  {
+               switch(ptr->ElemTyp(i))  {
+                  case A_Str:
+                     if (ptr->Str(i) != NULL) {
+			if ( (strstr(ptr->Str(i), "-=")) ||
+			     (strstr(ptr->Str(i), "+=")) ||
+			     (strstr(ptr->Str(i), "*=")) ||
+			     (strstr(ptr->Str(i), "/=")) )
+                           invalidate(prev, not_null, NO_TOUCH);
+                        else if (instr(ptr->Str(i), '=')) {
+                           invalidate(prev, not_null, LIMITED);
+                           assgn = 1;
+                        }
+                        else if ( (strstr(ptr->Str(i), "++")) ||
+				  (strstr(ptr->Str(i), "--")) )
+                           inc = 1;
+                        else if (instr(ptr->Str(i), '&'))
+                           addr = 1;
+                        else if (strstr(ptr->Str(i), "=="))
+                           equal = 1;
+                     }
+                     break;
+                  case A_ValLoc:
+                     if (inc) {
+                        invalidate(ptr->ValLoc(i), not_null, NO_TOUCH);
+                        inc = 0;
+                     }
+                     if (addr)  {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED);
+                        addr = 0;
+                     }
+                     if ((assgn) && (ptr->ValLoc(i)->mod_access == M_None)) {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED);
+                        assgn = 0;
+                     }
+                     else if (assgn)
+                        assgn = 0;
+                     if (equal) {
+                        invalidate(ptr->ValLoc(i), not_null, LIMITED_TO_INT);
+                        equal = 0;
+                     }
+                     prev = ptr->ValLoc(i);
+                     break;
+                  case A_Intgr:
+                     break;
+                  case A_SBuf:
+                     break;
+                  case A_Ary:
+                     for(tmp=ptr->Array(i); tmp != NULL ;tmp=tmp->next)
+                        analyze_literals(tmp, not_null, lvl+1);
+                     break;
+                  default:
+                     break;
+               }
+            }
+            break;
+         default:
+            break;
+      }
+   }
+}
+#endif					/* OptimizeLit */
+
+/*
+ * analyze_poll - analyzes the internal C code representation from
+ *                the position of the last Poll() function call to 
+ *                the current position in the code.
+ *                Returns a 0 if the last Poll() function should not
+ *                be removed.
+ */
+#ifdef OptimizePoll
+static int analyze_poll(void)  {
+   struct code *cursor, *ptr;
+   int          cont = 1;
+
+   ptr = lastpoll;
+   if (ptr == NULL)
+      return 0;
+   cursor = cur_fnc->cursor; 
+   while ((cursor != ptr) && (ptr != NULL) && (cont))  {
+      switch (ptr->cd_id)  {
+         case C_Null :
+         case C_NamedVar :
+         case C_Label    :
+         case C_Lit      :
+         case C_Resume   :
+         case C_Continue :
+         case C_FallThru :
+         case C_PFail    :
+         case C_Goto     :
+         case C_Create   :
+         case C_If       :
+         case C_SrcLoc   :
+         case C_CdAry    :
+                 break;
+         case C_CallSig  :
+         case C_RetSig   :
+         case C_LBrack   :
+         case C_RBrack   :
+         case C_PRet     :
+         case C_PSusp    :
+         case C_Break    :
+                 cont = 0;
+                 break;
+      }
+      ptr = ptr->next;
+   }
+   return cont;
+}
+
+/*
+ * remove_poll - removes the ccode structure that represents the last
+ *  call to the "Poll()" function by simply changing the code ID to
+ *  C_Null code.
+ */
+static void remove_poll(void)  {
+   
+   if (lastpoll == NULL)
+      return;
+   lastpoll->cd_id = C_Null;
+}
+#endif					/* OptimizePoll */
+
+/*
+ * setloc produces code to set the file name and line number to the
+ *  source location of node n.  Code is only produced if the corresponding
+ *  value has changed since the last time setloc was called.
+ */
+static void setloc(n)
+nodeptr n;
+   {
+   struct code *cd;
+   static int   count=0;
+
+   if (n == NULL || File(n) == NULL || Line(n) == 0)
+      return;
+
+   if (File(n) != lastfiln || Line(n) != lastline) {
+#ifdef OptimizePoll
+      if (analyze_poll())
+         remove_poll();
+      cd = alc_ary(1);
+      lastpoll = cd;
+#else					/* OptimizePoll */
+      cd = alc_ary(1);
+#endif					/* OptimizePoll */
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) = "Poll();";
+      cd_add(cd);
+      
+      if (line_info) {
+         cd = NewCode(2);
+         cd->cd_id = C_SrcLoc;
+   
+         if (File(n) == lastfiln)
+            cd->FileName = NULL;
+         else {
+            lastfiln = File(n);
+            cd->FileName = lastfiln;
+            }
+   
+         if (Line(n) == lastline)
+            cd->LineNum = 0;
+         else {
+            lastline = Line(n);
+            cd->LineNum = lastline;
+            }
+   
+         cd_add(cd);
+         }
+      }
+   }
+
+/*
+ * alc_ary - create an array for a sequence of code fragments.
+ */
+struct code *alc_ary(n)
+int n;
+   {
+   struct code *cd;
+   static cnt=1;
+
+   cd = NewCode(2 * n + 1);
+   cd->cd_id = C_CdAry;
+   cd->next = NULL;
+   cd->prev = NULL;
+   cd->ElemTyp(n) = A_End;
+   return cd;
+   }
+
+
+/*
+ * alc_lbl - create a label.
+ */
+struct code *alc_lbl(desc, flag)
+char *desc;
+int flag;
+   {
+   register struct code *cd;
+
+   cd = NewCode(5);
+   cd->cd_id = C_Label;
+   cd->next = NULL;
+   cd->prev = NULL;
+   cd->Container = cur_fnc; /* function containing label */
+   cd->SeqNum = 0;          /* sequence number is allocated later */
+   cd->Desc = desc;         /* identifying comment */
+   cd->RefCnt = 0;          /* reference count */
+   cd->LabFlg = flag;
+   return cd;
+   }
+
+/*
+ * alc_fnc - allocate a function structure;
+ */
+static struct c_fnc *alc_fnc()
+   {
+   register struct c_fnc *cf;
+   int i;
+
+   cf = NewStruct(c_fnc);
+   cf->prefix[0] = '\0';             /* prefix is allocated later */
+   cf->prefix[PrfxSz] = '\0';        /* terminate prefix for printing */
+   cf->flag = 0;
+   for (i = 0; i < PrfxSz; ++i)
+      cf->frm_prfx[i] = frm_prfx[i]; /* note procedure frame prefix */
+   cf->frm_prfx[PrfxSz] = '\0';      /* terminate prefix for printing */
+   cf->cd.cd_id = C_Null;            /* base of code sequence in function */
+   cf->cd.next = NULL;
+   cf->cursor = &cf->cd;             /* current place to insert code */
+   cf->call_lst = NULL;              /* functions called by this function */
+   cf->creatlst = NULL;              /* creates within this function */
+   cf->sig_lst = NULL;               /* signals returned by this function */
+   cf->ref_cnt = 0;
+   cf->next = NULL;
+   *flst_end = cf;                   /* link entry onto global list */
+   flst_end = &(cf->next);
+   return cf;
+   }
+
+/*
+ * tmp_loc - allocate a value location structure for nth temporary descriptor
+ *  variable in procedure frame.
+ */
+static struct val_loc *tmp_loc(n)
+int n;
+   {
+   register struct val_loc *r;
+
+   r = NewStruct(val_loc);
+   r->loc_type = V_Temp;
+   r->mod_access = M_None;
+   r->u.tmp = n;
+   return r;
+   }
+
+/*
+ * itmp_loc - allocate a value location structure for nth temporary integer
+ *  variable in procedure frame.
+ */
+struct val_loc *itmp_loc(n)
+int n;
+   {
+   register struct val_loc *r;
+
+   r = NewStruct(val_loc);
+   r->loc_type = V_ITemp;
+   r->mod_access = M_None;
+   r->u.tmp = n;
+   return r;
+   }
+
+/*
+ * dtmp_loc - allocate a value location structure for nth temporary double
+ *  variable in procedure frame.
+ */
+struct val_loc *dtmp_loc(n)
+int n;
+   {
+   register struct val_loc *r;
+
+   r = NewStruct(val_loc);
+   r->loc_type = V_DTemp;
+   r->mod_access = M_None;
+   r->u.tmp = n;
+   return r;
+   }
+
+/*
+ * vararg_sz - allocate a value location structure that refers to the size
+ *  of the variable part of an argument list.
+ */
+static struct val_loc *vararg_sz(n)
+int n;
+   {
+   register struct val_loc *r;
+
+   r = NewStruct(val_loc);
+   r->loc_type = V_Const;
+   r->mod_access = M_None;
+   r->u.int_const = n;
+   return r;
+   }
+
+/*
+ * cvar_loc - allocate a value location structure for a C variable.
+ */
+struct val_loc *cvar_loc(name)
+char *name;
+   {
+   register struct val_loc *r;
+
+   r = NewStruct(val_loc);
+   r->loc_type = V_CVar;
+   r->mod_access = M_None;
+   r->u.name = name;
+   return r;
+   }
+
+/*
+ * var_ref - allocate a value location structure for an Icon named variable.
+ */
+static struct val_loc *var_ref(sym)
+struct lentry *sym;
+   {
+   struct val_loc *loc;
+
+   loc = NewStruct(val_loc);
+   loc->loc_type = V_NamedVar;
+   loc->mod_access = M_None;
+   loc->u.nvar = sym;
+   return loc;
+   }
+
+/*
+ * deref_cd - generate code to dereference a descriptor.
+ */
+static void deref_cd(src, dest)
+struct val_loc *src;
+struct val_loc *dest;
+   {
+   struct code *cd;
+
+   cd = alc_ary(5);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                  "deref(&";
+   cd->ElemTyp(1) = A_ValLoc;
+   cd->ValLoc(1) =               src;
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                  ", &";
+   cd->ElemTyp(3) = A_ValLoc;
+   cd->ValLoc(3) =               dest;
+   cd->ElemTyp(4) = A_Str;
+   cd->Str(4) =                  ");";
+   cd_add(cd);
+   }
+
+/*
+ * inv_op - directly invoke a run-time operation, in-lining it if possible.
+ */
+static struct val_loc *inv_op(n, rslt)
+nodeptr n;
+struct val_loc *rslt;
+   {
+   struct implement *impl;
+   struct code *scont_strt;
+   struct code *scont_fail;
+   struct c_fnc *fnc;
+   struct val_loc *frst_arg;
+   struct val_loc *arg_rslt;
+   struct val_loc *r;
+   struct val_loc **varg_rslt;
+   struct op_symentry *symtab;
+   struct lentry **single;
+   struct tmplftm *lifetm_ary;
+   nodeptr rslt_lftm;
+   char *sbuf;
+   int *maybe_var;
+   int may_mod;
+   int nsyms;
+   int nargs;
+   int nparms;
+   int cont_loc;
+   int flag;
+   int refs;
+   int var_args;
+   int n_varargs;
+   int arg_loc;
+   int dcl_var;
+   int i;
+   int j;
+   int v;
+
+   nargs = Val0(n);
+   impl = Impl1(n);
+   if (impl == NULL) {
+      /*
+       * We have already printed an error, just make sure we can
+       *  continue.
+       */
+      return &ignore;
+      }
+
+   /*
+    * If this operation uses its result location as a work area, it must
+    *   be given a tended result location and the value must be retained
+    *   as long as the operation can be resumed.
+    */
+   rslt_lftm = n->lifetime;
+   if (impl->use_rslt) {
+       rslt_lftm = max_lftm(rslt_lftm, n->intrnl_lftm);
+       if (rslt == &ignore)
+          rslt = NULL;      /* force allocation of temporary */
+       }
+
+   /*
+    * Determine if this operation takes a variable number of arguments
+    *  and determine the size of the variable part of the arg list.
+    */
+   nparms = impl->nargs;
+   if (nparms > 0 && impl->arg_flgs[nparms - 1] & VarPrm) {
+      var_args = 1;
+      n_varargs = nargs - nparms + 1;
+      if (n_varargs < 0)
+         n_varargs = 0;
+      }
+   else {
+      var_args = 0;
+      n_varargs = 0;
+      }
+
+   /*
+    * Construct a symbol table (implemented as an array) for the operation.
+    *  The symbol table includes parameters, and both the tended and
+    *  ordinary variables from the RTL declare statement.
+    */
+   nsyms = (n->symtyps == NULL ? 0 : n->symtyps->nsyms);
+   if (var_args)
+      ++nsyms;
+   nsyms += impl->ntnds + impl->nvars;
+   if (nsyms > 0)
+      symtab = (struct op_symentry *)alloc((unsigned int)(nsyms *
+         sizeof(struct op_symentry)));
+   else
+      symtab = NULL;
+   for (i = 0; i < nsyms; ++i) {
+      symtab[i].n_refs = 0;     /* number of non-modifying references */
+      symtab[i].n_mods = 0;     /* number of modifying references */
+      symtab[i].n_rets = 0;     /* number of times returned directly */
+      symtab[i].var_safe = 0;   /* Icon variable arg can be passed directly */
+      symtab[i].adjust = 0;     /* adjustments needed to "dereference" */
+      symtab[i].itmp_indx = -1; /* loc after "in-place" convert to C integer */
+      symtab[i].dtmp_indx = -1; /* loc after "in-place" convert to C double */
+      symtab[i].loc = NULL;     /* location as a descriptor */
+      }
+
+   /*
+    * If in-lining has not been disabled or the operation is a keyword,
+    *  check to see if it can reasonably be in-lined and gather information
+    *  needed to in-line it.
+    */
+   if ((allow_inline || impl->oper_typ == 'K') &&
+      do_inlin(impl, n, &cont_loc, symtab, n_varargs)) {
+      /*
+       * In-line the operation.
+       */
+
+      if (impl->ret_flag & DoesRet || impl->ret_flag & DoesSusp)
+         rslt = chk_alc(rslt, rslt_lftm);  /* operation produces a result */
+
+      /*
+       * Allocate arrays to hold information from type inferencing about
+       *  whether arguments are variables. This is used to optimize
+       *  dereferencing.
+       */
+      if (nargs > 0) {
+         maybe_var = (int *)alloc((unsigned int)(nargs * sizeof(int)));
+         single = (struct lentry **)alloc((unsigned int)(nargs *
+            sizeof(struct lentry *)));
+         }
+
+      if (var_args)
+         --nparms; /* don't deal with varargs parameter yet. */
+
+      /*
+       * Match arguments with parameters and generate code for the
+       *  arguments. The type of code generated depends on the kinds
+       *  of dereferencing optimizations that are possible, though
+       *  in general, dereferencing must wait until all arguments are
+       *  computed. Because there may be both dereferenced and undereferenced
+       *  parameters for an argument, the symbol table index does not always
+       *  match the argument index.
+       */
+      i = 0;  /* symbol table index */
+      for (j = 0; j < nparms && j < nargs; ++j) {
+         /*
+          * Use information from type inferencing to determine if the
+          *  argument might me a variable and whether it is a single
+          *  known named variable.
+          */
+         maybe_var[j] = HasVar(varsubtyp(n->n_field[FrstArg + j].n_ptr->type,
+             &(single[j])));
+
+         /*
+          * Determine how many times the argument is referenced. If we
+          *  optimize away return statements because we don't need the
+          *  result, those references don't count. Take into account
+          *  that there may be both dereferenced and undereferenced
+          *  parameters for this argument.
+          */
+         if (rslt == &ignore)
+            symtab[i].n_refs -= symtab[i].n_rets;
+         refs = symtab[i].n_refs + symtab[i].n_mods;
+         flag = impl->arg_flgs[j] & (RtParm | DrfPrm);
+         if (flag == (RtParm | DrfPrm))
+            refs += symtab[i + 1].n_refs + symtab[i + 1].n_mods;
+         if (refs == 0) {
+            /*
+             * Indicate that we don't need the argument value (we must
+             *  still perform the computation in case it has side effects).
+             */
+            arg_rslt = &ignore;
+            symtab[i].adjust = AdjNone;
+            }
+         else {
+            /*
+             * Decide whether the result location for the argument can be
+             *  used directly as the parameter.
+             */
+            if (flag == (RtParm | DrfPrm) && symtab[i].n_refs +
+               symtab[i].n_mods == 0) {
+                  /*
+                   * We have both dereferenced and undereferenced parameters,
+                   *  but don't use the undereferenced one so ignore it.
+                   */
+                  symtab[i].adjust = AdjNone;
+                  ++i;
+                  flag = DrfPrm;
+                  }    
+            if (flag == DrfPrm && single[j] != NULL) {
+               /*
+                * We need only a dereferenced value, but know what variable
+                *  it is in. We don't need the computed argument value, we will
+                *  get it directly from the variable. If it is safe to do
+                *  so, we will pass a pointer to the variable as the argument
+                *  to the operation.
+                */
+               arg_rslt = &ignore;
+               symtab[i].loc = var_ref(single[j]);
+               if (symtab[i].var_safe)
+                  symtab[i].adjust = AdjNone;
+               else
+                  symtab[i].adjust = AdjCpy;
+               }
+            else {
+               /*
+                * Determine if the argument descriptor is modified by the
+                *  operation; dereferencing a variable is a modification.
+                */
+               may_mod = (symtab[i].n_mods != 0);
+               if (flag == DrfPrm)
+                  may_mod |= maybe_var[j];
+               if (n->n_field[FrstArg + j].n_ptr->reuse && may_mod) {
+                  /*
+                   * The parameter may be reused without recomputing
+                   *  the argument and the value may be modified. The
+                   *  argument result location and the parameter location
+                   *  must be separate so the parameter is reloaded upon
+                   *  each invocation.
+                   */
+                  arg_rslt = chk_alc(NULL,
+                     n->n_field[FrstArg + j].n_ptr->lifetime);
+                  if (flag == DrfPrm && maybe_var[j])
+                     symtab[i].adjust = AdjNDrf;  /* var: must dereference */
+                  else
+                     symtab[i].adjust = AdjCpy;   /* value only: just copy */
+                  }
+               else {
+                  /*
+                   * Argument result location will act as parameter location.
+                   *  Its lifetime must be as long as both that of the
+                   *  the argument and the parameter (operation internal
+                   *  lifetime).
+                   */
+                  arg_rslt = chk_alc(NULL, max_lftm(n->intrnl_lftm,
+                     n->n_field[FrstArg + j].n_ptr->lifetime));
+                  if (flag == DrfPrm && maybe_var[j])
+                     symtab[i].adjust = AdjDrf;   /* var: must dereference */
+                  else
+                     symtab[i].adjust = AdjNone;
+                  }
+               symtab[i].loc = arg_rslt;
+               }
+            }
+
+         /*
+          * Generate the code for the argument.
+          */
+         gencode(n->n_field[FrstArg + j].n_ptr, arg_rslt);
+
+         if (flag == (RtParm | DrfPrm)) {
+            /*
+             * We have computed the value for the undereferenced parameter,
+             *  decide how to get the dereferenced value.
+             */
+            ++i;
+            if (symtab[i].n_refs + symtab[i].n_mods == 0)
+               symtab[i].adjust = AdjNone;  /* not needed, ignore */
+            else {
+               if (single[j] != NULL) {
+                  /*
+                   * The value is in a specific Icon variable, get it from
+                   *  there. If is is safe to pass the variable directly
+                   *  to the operation, do so.
+                   */
+                  symtab[i].loc = var_ref(single[j]);
+                  if (symtab[i].var_safe)
+                     symtab[i].adjust = AdjNone;
+                  else
+                     symtab[i].adjust = AdjCpy;
+                  }
+               else {
+                  /*
+                   * If there might be a variable reference, note that it
+                   *  must be dereferenced. Otherwise decide whether the
+                   *  argument location can be used for both the dereferenced
+                   *  and undereferenced parameter.
+                   */
+                  symtab[i].loc = arg_rslt;
+                  if (maybe_var[j])
+                     symtab[i].adjust = AdjNDrf;
+                  else if (symtab[i - 1].n_mods + symtab[i].n_mods == 0)
+                     symtab[i].adjust = AdjNone;
+                  else
+                     symtab[i].adjust = AdjCpy;
+                  }
+               }
+            }
+         ++i;
+         }
+
+      /*
+       * Fill out parameter list with null values.
+       */
+      while (j < nparms) {
+         int k, kn;
+         kn = 0;
+         if (impl->arg_flgs[j] & RtParm)
+            ++kn;
+         if (impl->arg_flgs[j] & DrfPrm)
+            ++kn;
+         for (k = 0; k < kn; ++k) {
+            if (symtab[i].n_refs + symtab[i].n_mods > 0) {
+               arg_rslt = chk_alc(NULL, n->intrnl_lftm);
+               cd_add(asgn_null(arg_rslt));
+               symtab[i].loc = arg_rslt;
+               }
+            symtab[i].adjust = AdjNone;
+            ++i;
+            }
+         ++j;
+         }
+
+      if (var_args) {
+         /*
+          * Compute variable part of argument list.
+          */
+         ++nparms;   /* add varargs parameter back into parameter list  */
+
+         /*
+          * The variable part of the parameter list must be in contiguous
+          *  descriptors. Create location and lifetime arrays for use in
+          *  allocating the descriptors.
+          */
+         if (n_varargs > 0) {
+            varg_rslt = (struct val_loc **)alloc((unsigned int)(n_varargs *
+               sizeof(struct val_loc *)));
+            lifetm_ary = alc_lftm(n_varargs, NULL);
+            }
+
+         flag = impl->arg_flgs[j] & (RtParm | DrfPrm);
+
+         /*
+          * Compute the lifetime of the elements of the varargs parameter array.
+          */
+         for (v = 0; v < n_varargs; ++v) {
+            /*
+             * Use information from type inferencing to determine if the
+             *  argument might me a variable and whether it is a single
+             *  known named variable.
+             */
+            maybe_var[j + v] = HasVar(varsubtyp(
+               n->n_field[FrstArg+j+v].n_ptr->type, &(single[j + v])));
+
+            /*
+             * Determine if the elements of the vararg parameter array
+             *  might be modified. If it is a variable, dereferencing
+             *  modifies it.
+             */
+            may_mod = (symtab[j].n_mods != 0);
+            if (flag == DrfPrm)
+               may_mod |= maybe_var[j + v];
+
+            if ((flag == DrfPrm && single[j + v] != NULL) ||
+               (n->n_field[FrstArg + j + v].n_ptr->reuse && may_mod)) {
+               /*
+                * The argument value is only placed in the vararg parameter
+                *  array during "dereferencing". So the lifetime of the array
+                *  element is the lifetime of the parameter and the element
+                *  is not used until dereferencing.
+                */
+               lifetm_ary[v].lifetime = n->intrnl_lftm;
+               lifetm_ary[v].cur_status = n->postn;
+               }
+            else {
+               /*
+                * The argument is computed into the vararg parameter array.
+                *  The lifetime of the array element encompasses both
+                *  the lifetime of the argument and the parameter. The
+                *  element is used as soon as the argument is computed.
+                */
+               lifetm_ary[v].lifetime = max_lftm(n->intrnl_lftm,
+                   n->n_field[FrstArg+j+v].n_ptr->lifetime);
+               lifetm_ary[v].cur_status = n->n_field[FrstArg+j+v].n_ptr->postn;
+               }
+            }
+
+         /*
+          * Allocate (reserve) the array of temporary variables for the
+          *  vararg list.
+          */
+         if (n_varargs > 0) {
+            arg_loc = alc_tmp(n_varargs, lifetm_ary);
+            free((char *)lifetm_ary);
+            }
+
+         /*
+          * Generate code to compute arguments.
+          */
+         for (v = 0; v < n_varargs; ++v) {
+            may_mod = (symtab[j].n_mods != 0);
+            if (flag == DrfPrm)
+               may_mod |= maybe_var[j + v];
+            if (flag == DrfPrm && single[j + v] != NULL) {
+              /*
+               * We need a dereferenced value and it is in a known place: a
+               *  named variable; don't bother saving the result of the
+               *  argument computation.
+               */
+               r = &ignore;
+               }
+            else if (n->n_field[FrstArg + j + v].n_ptr->reuse && may_mod) {
+               /* 
+                * The argument can be reused without being recomputed and
+                *  the parameter may be modified, so we cannot safely
+                *  compute the argument into the vararg parameter array; we
+                *  must compute it elsewhere and copy (dereference) it at the
+                *  beginning of the operation. Let gencode allocate an argument
+                *  result location.
+                */
+               r = NULL; 
+               }
+            else {
+               /*
+                * We can compute the argument directly into the vararg
+                *  parameter array.
+                */
+               r = tmp_loc(arg_loc + v);
+               }
+            varg_rslt[v] = gencode(n->n_field[FrstArg + j + v].n_ptr, r);
+            }
+
+         setloc(n);
+         /*
+          * Dereference or copy argument values that are not already in vararg
+          *  parameter list. Preceding arguments are dereferenced later, but
+          *  it is okay if dereferencing is out-of-order.
+          */
+         for (v = 0; v < n_varargs; ++v) {
+            if (flag == DrfPrm && single[j + v] != NULL) {
+               /*
+                * Copy the value from the known named variable into the
+                *  parameter list.
+                */
+               varg_rslt[v] = var_ref(single[j + v]);
+               cd_add(mk_cpyval(tmp_loc(arg_loc + v), varg_rslt[v]));
+               }
+            else if (flag == DrfPrm && maybe_var[j + v]) {
+               /*
+                * Dereference the argument into the parameter list.
+                */
+               deref_cd(varg_rslt[v], tmp_loc(arg_loc + v));
+               }
+            else if (arg_loc + v != varg_rslt[v]->u.tmp) {
+               /*
+                * The argument is a dereferenced value, but is not yet
+                *  in the parameter list; copy it there.
+                */
+               cd_add(mk_cpyval(tmp_loc(arg_loc + v), varg_rslt[v]));
+               }
+            tmp_status[arg_loc + v] = InUse; /* parameter location in use */
+            }
+
+         /*
+          * The vararg parameter gets the address of the first element
+          *  in the variable part of the argument list and the size
+          *  parameter gets the number of elements in the list.
+          */
+         if (n_varargs > 0) {
+            free((char *)varg_rslt);
+            symtab[i].loc = tmp_loc(arg_loc);
+            }
+         else
+            symtab[i].loc = chk_alc(NULL, n); /* dummy arg location */
+         symtab[i].loc->mod_access = M_Addr;
+         ++i;
+         symtab[i].loc = vararg_sz(n_varargs);
+         ++i;
+         }
+      else {
+         /*
+          * Compute extra arguments, but discard the results.
+          */
+         while (j < nargs) {
+            gencode(n->n_field[FrstArg + j].n_ptr, &ignore);
+            ++j;
+            }
+         }
+
+      if (nargs > 0) {
+         free((char *)maybe_var);
+         free((char *)single);
+         }
+
+      /*
+       * If execution does not continue through the parameter evaluation,
+       *  don't try to generate in-line code. A lack of parameter types
+       *  will cause problems with some in-line type conversions.
+       */
+      if (!past_prms(n))
+         return rslt;
+
+      setloc(n);
+
+      dcl_var = i;
+
+      /*
+       * Perform any needed copying or dereferencing.
+       */
+      for (i = 0; i < nsyms; ++i) {
+         switch (symtab[i].adjust) {
+            case AdjNDrf:
+               /*
+                * Dereference into a new temporary which is used as the
+                *  parameter.
+                */
+               arg_rslt = chk_alc(NULL, n->intrnl_lftm);
+               deref_cd(symtab[i].loc, arg_rslt);
+               symtab[i].loc = arg_rslt;
+               break;
+            case AdjDrf:
+               /*
+                * Dereference in place.
+                */
+               deref_cd(symtab[i].loc, symtab[i].loc);
+               break;
+           case AdjCpy:
+               /*
+                * Copy into a new temporary which is used as the
+                *  parameter.
+                */
+              arg_rslt = chk_alc(NULL, n->intrnl_lftm);
+              cd_add(mk_cpyval(arg_rslt, symtab[i].loc));
+              symtab[i].loc = arg_rslt;
+              break;
+           case AdjNone:
+              break;     /* nothing need be done */
+            }
+         }
+
+      switch (cont_loc) {
+         case SepFnc:
+            /*
+             * success continuation must be in a separate function.
+             */
+            fnc = alc_fnc();
+            sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
+            sprintf(sbuf, "end %s", impl->name);
+            scont_strt = alc_lbl(sbuf, 0);
+            cd_add(scont_strt);
+            cur_fnc->cursor = scont_strt->prev; /* put oper before label */
+            gen_inlin(impl->in_line, rslt, &scont_strt, NULL, fnc, impl,
+               nsyms, symtab, n, dcl_var, n_varargs);
+            cur_fnc->cursor = scont_strt;
+            callc_add(fnc);
+            cur_fnc = fnc;
+            on_failure = &resume;
+            break;
+         case SContIL:
+            /*
+             * one suspend an no return: success continuation is put in-line.
+             */
+            gen_inlin(impl->in_line, rslt, &scont_strt, &scont_fail, NULL, impl,
+                nsyms, symtab, n, dcl_var, n_varargs);
+            cur_fnc->cursor = scont_strt;
+            on_failure = scont_fail;
+            break;
+         case EndOper:
+            /*
+             * no suspends: success continuation goes at end of operation.
+             */
+
+            sbuf = (char *)alloc((unsigned int)(strlen(impl->name) + 5));
+            sprintf(sbuf, "end %s", impl->name);
+            scont_strt = alc_lbl(sbuf, 0);
+            cd_add(scont_strt);
+            cur_fnc->cursor = scont_strt->prev; /* put operation before lbl */
+            gen_inlin(impl->in_line, rslt, &scont_strt, NULL, NULL, impl,
+               nsyms, symtab, n, dcl_var, n_varargs);
+            cur_fnc->cursor = scont_strt;
+            break;
+         }
+      }
+   else {
+      /*
+       * Do not in-line operation.
+       */
+      implproto(impl);
+      frst_arg = gen_args(n, 2, nargs);
+      setloc(n);
+      if (impl->ret_flag & (DoesRet | DoesSusp))
+         rslt = chk_alc(rslt, rslt_lftm);
+      mk_callop(oper_name(impl), impl->ret_flag, frst_arg, nargs, rslt,
+         0);
+      }
+   if (symtab != NULL)
+      free((char *)symtab);
+   return rslt;
+   }
+
+/*
+ * max_lftm - given two lifetimes (in the form of nodes) return the
+ *   maximum one.
+ */
+static nodeptr max_lftm(n1, n2)
+nodeptr n1;
+nodeptr n2;
+   {
+   if (n1 == NULL)
+      return n2;
+   else if (n2 == NULL)
+      return n1;
+   else if (n1->postn > n2->postn)
+      return n1;
+   else
+      return n2;
+   }
+
+/*
+ * inv_prc - directly invoke a procedure.
+ */
+static struct val_loc *inv_prc(n, rslt)
+nodeptr n;
+struct val_loc *rslt;
+   {
+   struct pentry *proc;
+   struct val_loc *r;
+   struct val_loc *arg1rslt;
+   struct val_loc *var_part;
+   int *must_deref;
+   struct lentry **single;
+   struct val_loc **arg_rslt;
+   struct code *cd;
+   struct tmplftm *lifetm_ary;
+   char *sbuf;
+   int nargs;
+   int nparms;
+   int i, j;
+   int arg_loc;
+   int var_sz;
+   int var_loc;
+
+   /*
+    * This procedure is implemented without argument list adjustment or 
+    *  dereferencing, so they must be done before the call.
+    */
+   nargs = Val0(n);              /* number of arguments */
+   proc = Proc1(n);
+   nparms = Abs(proc->nargs);
+
+   if (nparms > 0) {
+      must_deref = (int *)alloc((unsigned int)(nparms * sizeof(int)));
+      single = (struct lentry **)alloc((unsigned int)(nparms *
+         sizeof(struct lentry *)));
+      arg_rslt = (struct val_loc **)alloc((unsigned int)(nparms *
+         sizeof(struct val_loc *)));
+      }
+
+   /*
+    * Allocate a work area of temporaries to use as argument list. If
+    *  an argument can be reused without being recomputed, it must not
+    *  be computed directly into the work area. It will be copied or
+    *  dereferenced into the work area when execution reaches the
+    *  operation. If an argument is a single named variable, it can
+    *  be dereferenced directly into the argument location. These
+    *  conditions affect when the temporary will receive a value.
+    */
+   if (nparms > 0)
+      lifetm_ary = alc_lftm(nparms, NULL);
+   for (i = 0; i < nparms; ++i)
+      lifetm_ary[i].lifetime = n->intrnl_lftm;
+   for (i = 0; i < nparms && i < nargs; ++i) {
+      must_deref[i] = HasVar(varsubtyp(n->n_field[FrstArg + i].n_ptr->type,
+         &(single[i])));
+      if (single[i] != NULL || n->n_field[FrstArg + i].n_ptr->reuse)
+         lifetm_ary[i].cur_status = n->postn;
+      else
+         lifetm_ary[i].cur_status = n->n_field[FrstArg + i].n_ptr->postn;
+      }
+   while (i < nparms) {
+      lifetm_ary[i].cur_status = n->postn; /* arg list extension */
+      ++i;
+      }
+   if (proc->nargs < 0)
+      lifetm_ary[nparms - 1].cur_status = n->postn;  /* variable part */
+
+   if (nparms > 0) {
+      arg_loc = alc_tmp(nparms, lifetm_ary);
+      free((char *)lifetm_ary);
+      }
+   if (proc->nargs < 0)
+      --nparms;     /* treat variable part specially */
+   for (i = 0; i < nparms && i < nargs;  ++i) {
+      if (single[i] != NULL)
+         r = &ignore;   /* we know where the dereferenced value is */
+      else if (n->n_field[FrstArg + i].n_ptr->reuse)
+         r = NULL;      /* let gencode allocate a new temporary */
+      else
+         r = tmp_loc(arg_loc + i);
+      arg_rslt[i] = gencode(n->n_field[FrstArg + i].n_ptr, r);
+      }
+
+   /*
+    * If necessary, fill out argument list with nulls.
+    */
+   while (i < nparms) {
+      cd_add(asgn_null(tmp_loc(arg_loc + i)));
+      tmp_status[arg_loc + i] = InUse;
+      ++i;
+      }
+
+   if (proc->nargs < 0) {
+      /*
+       * handle variable part of list.
+       */
+      var_sz = nargs - nparms;
+
+      if (var_sz > 0) {
+         lifetm_ary = alc_lftm(var_sz, &n->n_field[FrstArg + nparms]);
+         var_loc = alc_tmp(var_sz, lifetm_ary);
+         free((char *)lifetm_ary);
+         for (j = 0; j < var_sz; ++j) {
+            gencode(n->n_field[FrstArg + nparms + j].n_ptr,
+               tmp_loc(var_loc + j));
+         }
+      }
+   }
+   else {
+      /*
+       * If there are extra arguments, compute them, but discard the
+       *  results.
+       */
+      while (i < nargs) {
+         gencode(n->n_field[FrstArg + i].n_ptr, &ignore);
+         ++i;
+         }
+      }
+
+   setloc(n);
+   /*
+    * Dereference or copy argument values that are not already in argument
+    *  list as dereferenced values.
+    */
+   for (i = 0; i < nparms && i < nargs;  ++i) {
+      if (must_deref[i]) {
+         if (single[i] == NULL)  {
+            deref_cd(arg_rslt[i], tmp_loc(arg_loc + i));
+         }
+         else {
+            arg_rslt[i] = var_ref(single[i]);
+            cd_add(mk_cpyval(tmp_loc(arg_loc + i), arg_rslt[i]));
+            }
+         }
+      else if (n->n_field[FrstArg + i].n_ptr->reuse)
+         cd_add(mk_cpyval(tmp_loc(arg_loc + i), arg_rslt[i]));
+      tmp_status[arg_loc + i] = InUse;
+      }
+
+   if (proc->nargs < 0) {
+      var_part = tmp_loc(arg_loc + nparms);
+      tmp_status[arg_loc + nparms] = InUse;
+      if (var_sz <= 0) {
+         cd = alc_ary(3);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =                 "varargs(NULL, 0, &";
+         cd->ElemTyp(1) = A_ValLoc;
+         cd->ValLoc(1) =               var_part;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                 ");";
+         }
+      else {
+         cd = alc_ary(7);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =                 "varargs(&";
+         cd->ElemTyp(1) = A_ValLoc;
+         cd->ValLoc(1) =               tmp_loc(var_loc);
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                  ", ";
+         cd->ElemTyp(3) = A_Intgr;
+         cd->Intgr(3) =               var_sz; 
+         cd->ElemTyp(4) = A_Str;
+         cd->Str(4) =                 ", &";
+         cd->ElemTyp(5) = A_ValLoc;
+         cd->ValLoc(5) =               var_part;
+         cd->ElemTyp(6) = A_Str;
+         cd->Str(6) =                 ");";
+         }
+      cd_add(cd);
+      ++nparms;   /* include variable part in call */
+      }
+
+   if (nparms > 0) {
+      free((char *)must_deref);
+      free((char *)single);
+      free((char *)arg_rslt);
+      }
+
+   sbuf = (char *)alloc((unsigned int)(strlen(proc->name) + PrfxSz + 3));
+   sprintf(sbuf, "P%s_%s", proc->prefix, proc->name);
+   if (nparms > 0)
+      arg1rslt = tmp_loc(arg_loc);
+   else
+      arg1rslt = NULL;
+   if (proc->ret_flag & (DoesRet | DoesSusp))
+      rslt = chk_alc(rslt, n->lifetime);
+   mk_callop(sbuf, proc->ret_flag, arg1rslt, nargs, rslt, 1);
+   return rslt;
+   }
+
+/*
+ * endlife - link a temporary variable onto the list to be freed when
+ *  execution reaches a node.
+ */
+static void endlife(kind, indx, old, n)
+int kind;
+int indx;
+int old;
+nodeptr n;
+   {
+   struct freetmp *freetmp;
+
+   if ((freetmp = freetmp_pool) == NULL)
+     freetmp = NewStruct(freetmp);
+   else
+      freetmp_pool = freetmp_pool->next;
+   freetmp->kind = kind;
+   freetmp->indx = indx;
+   freetmp->old = old;
+   freetmp->next = n->freetmp;
+   n->freetmp = freetmp;
+   }
+
+/*
+ * alc_tmp - allocate a block of temporary variables with the given lifetimes.
+ */
+static int alc_tmp(num, lifetm_ary)
+int num;
+struct tmplftm *lifetm_ary;
+   {
+   int i, j, k;
+   register int status;
+   int *new_status;
+   int new_size;
+
+   i = 0;
+   for (;;) {
+      if (i + num > status_sz) {
+         /*
+          * The status array is too small, expand it.
+          */
+         new_size = status_sz + Max(num, status_sz);
+         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
+         k = 0;
+         while (k < status_sz) {
+            new_status[k] = tmp_status[k];
+            ++k;
+            }
+         while (k < new_size) {
+            new_status[k] = NotAlloc;
+            ++k;
+            }
+         free((char *)tmp_status);
+         tmp_status = new_status;
+         status_sz = new_size;
+         }
+      for (j = 0; j < num; ++j) {
+         status = tmp_status[i + j];
+         if (status != NotAlloc &&
+            (status == InUse || status <= lifetm_ary[j].lifetime->postn))
+               break;
+         }
+      /*
+       * Did we find a block of temporaries that we can use?
+       */
+      if (j == num) {
+         while (--j >= 0) {
+            endlife(DescTmp, i + j, tmp_status[i + j], lifetm_ary[j].lifetime);
+            tmp_status[i + j] = lifetm_ary[j].cur_status;
+            }
+         if (i + num > num_tmp)
+            num_tmp = i + num;
+         return i;
+         }
+      ++i;
+      }
+   }
+
+/*
+ * alc_lftm - allocate an array of lifetime information for an argument
+ *  list.
+ */
+static struct tmplftm *alc_lftm(num, args)
+int num;
+union field *args;
+   {
+   struct tmplftm *lifetm_ary;
+   int i;
+
+   lifetm_ary = (struct tmplftm *)alloc((unsigned int)(num *
+      sizeof(struct tmplftm)));
+   if (args != NULL)
+     for (i = 0; i < num; ++i) {
+        lifetm_ary[i].cur_status = args[i].n_ptr->postn; /* reserved for arg */
+        lifetm_ary[i].lifetime = args[i].n_ptr->lifetime;
+        }
+   return lifetm_ary;
+   }
+
+/*
+ * alc_itmp - allocate a temporary C integer variable.
+ */
+int alc_itmp(lifetime)
+nodeptr lifetime;
+   {
+   int i, j;
+   int new_size;
+
+   i = 0;
+   while (i < istatus_sz && itmp_status[i] == InUse)
+      ++i;
+   if (i >= istatus_sz) {
+      /*
+       * The status array is too small, expand it.
+       */
+      free((char *)itmp_status);
+      new_size = istatus_sz * 2;
+      itmp_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
+      j = 0;
+      while (j < istatus_sz)
+         itmp_status[j++] = InUse;
+      while (j < new_size)
+         itmp_status[j++] = NotAlloc;
+      istatus_sz = new_size;
+      }
+   endlife(CIntTmp, i, NotAlloc, lifetime);
+   itmp_status[i] = InUse;
+   if (num_itmp < i + 1)
+     num_itmp = i + 1;
+   return i;
+   }
+
+/*
+ * alc_dtmp - allocate a temporary C integer variable.
+ */
+int alc_dtmp(lifetime)
+nodeptr lifetime;
+   {
+   int i, j;
+   int new_size;
+
+   i = 0;
+   while (i < dstatus_sz && dtmp_status[i] == InUse)
+      ++i;
+   if (i >= dstatus_sz) {
+      /*
+       * The status array is too small, expand it.
+       */
+      free((char *)dtmp_status);
+      new_size = dstatus_sz * 2;
+      dtmp_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
+      j = 0;
+      while (j < dstatus_sz)
+         dtmp_status[j++] = InUse;
+      while (j < new_size)
+         dtmp_status[j++] = NotAlloc;
+      dstatus_sz = new_size;
+      }
+   endlife(CDblTmp, i, NotAlloc, lifetime);
+   dtmp_status[i] = InUse;
+   if (num_dtmp < i + 1)
+     num_dtmp = i + 1;
+   return i;
+   }
+
+/*
+ * alc_sbufs - allocate a block of string buffers with the given lifetime.
+ */
+int alc_sbufs(num, lifetime)
+int num;
+nodeptr lifetime;
+   {
+   int i, j, k;
+   int *new_status;
+   int new_size;
+
+   i = 0;
+   for (;;) {
+      if (i + num > sstatus_sz) {
+         /*
+          * The status array is too small, expand it.
+          */
+         new_size = sstatus_sz + Max(num, sstatus_sz);
+         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
+         k = 0;
+         while (k < sstatus_sz) {
+            new_status[k] = sbuf_status[k];
+            ++k;
+            }
+         while (k < new_size) {
+            new_status[k] = NotAlloc;
+            ++k;
+            }
+         free((char *)sbuf_status);
+         sbuf_status = new_status;
+         sstatus_sz = new_size;
+         }
+      for (j = 0; j < num && sbuf_status[i + j] == NotAlloc; ++j)
+         ;
+      /*
+       * Did we find a block of buffers that we can use?
+       */
+      if (j == num) {
+         while (--j >= 0) {
+            endlife(SBuf, i + j, sbuf_status[i + j], lifetime);
+            sbuf_status[i + j] = InUse;
+            }
+         if (i + num > num_sbuf)
+            num_sbuf = i + num;
+         return i;
+         }
+      ++i;
+      }
+   }
+
+/*
+ * alc_cbufs - allocate a block of cset buffers with the given lifetime.
+ */
+int alc_cbufs(num, lifetime)
+int num;
+nodeptr lifetime;
+   {
+   int i, j, k;
+   int *new_status;
+   int new_size;
+
+   i = 0;
+   for (;;) {
+      if (i + num > cstatus_sz) {
+         /*
+          * The status array is too small, expand it.
+          */
+         new_size = cstatus_sz + Max(num, cstatus_sz);
+         new_status = (int *)alloc((unsigned int)(new_size * sizeof(int)));
+         k = 0;
+         while (k < cstatus_sz) {
+            new_status[k] = cbuf_status[k];
+            ++k;
+            }
+         while (k < new_size) {
+            new_status[k] = NotAlloc;
+            ++k;
+            }
+         free((char *)cbuf_status);
+         cbuf_status = new_status;
+         cstatus_sz = new_size;
+         }
+      for (j = 0; j < num && cbuf_status[i + j] == NotAlloc; ++j)
+         ;
+      /*
+       * Did we find a block of buffers that we can use?
+       */
+      if (j == num) {
+         while (--j >= 0) {
+            endlife(CBuf, i + j, cbuf_status[i + j], lifetime);
+            cbuf_status[i + j] = InUse;
+            }
+         if (i + num > num_cbuf)
+            num_cbuf = i + num;
+         return i;
+         }
+      ++i;
+      }
+   }
diff --git a/src/iconc/ccode.h b/src/iconc/ccode.h
new file mode 100644
index 0000000..2d0cb6f
--- /dev/null
+++ b/src/iconc/ccode.h
@@ -0,0 +1,252 @@
+/*
+ * ccode.h - definitions used in code generation.
+ */
+
+/*
+ * ChkPrefix - allocate a prefix to x if it has not already been done.
+ */
+#define ChkPrefix(x) if ((x)[0] == '\0') nxt_pre(x, pre, PrfxSz);
+
+/*
+ * sig_act - list of possible signals returned by a call and the action to be
+ *  to be taken when the signal is returned: in effect a switch statement.
+ */
+struct sig_act {
+   struct code *sig;         /* signal */
+   struct code *cd;          /* action to be taken: goto, return, break */
+   struct sig_act *shar_act; /* signals that share this action */
+   struct sig_act *next;
+   };
+
+/*
+ * val_loc - location of a value. Used for intermediate and final results
+ *   of expressions.
+ */
+#define V_NamedVar 1  /* Icon named variable indicated by nvar */
+#define V_Temp     2  /* temporary variable indicated by tmp */
+#define V_ITemp    3  /* C integer temporary variable indicated by tmp */
+#define V_DTemp    4  /* C double temporary variable indicated by tmp */
+#define V_PRslt    5  /* procedure result location */
+#define V_Const    6  /* integer constant - used for size of varargs */
+#define V_CVar     7  /* C named variable */
+#define V_Ignore   8  /* "trashcan" - a write-only location */
+
+#define M_None     0  /* access simply as descriptor */
+#define M_CharPtr  1  /* access v-word as "char *" */
+#define M_BlkPtr   2  /* access v-word as block pointer using blk_name */
+#define M_CInt     3  /* access v-word as C integer */
+#define M_Addr     4  /* address of descriptor for varargs */
+
+struct val_loc {
+   int loc_type;      /* manifest constants V_* */
+   int mod_access;    /* manifest constants M_* */
+   char *blk_name;    /* used with M_BlkPtr */
+   union {
+     struct lentry *nvar; /* Icon named variable */
+     int tmp;             /* index of temporary variable */
+     int int_const;       /* integer constant value */
+     char *name;          /* C named variable */
+     } u;
+   };
+
+/*
+ * "code" contains the information needed to print a piece of C code.
+ *  C_... manifest constants are cd_id's. These are followed by
+ *  corresponding field access expressions.
+ */
+#define Rslt        fld[0].vloc    /* place to put result of expression */
+#define Cont        fld[1].fnc	   /* continuation function or null */
+
+#define C_Null      0              /* no code */
+
+#define C_NamedVar  1		   /* reference to a named variable */
+/* uses Rslt */
+#define NamedVar    fld[1].nvar
+
+#define C_CallSig   2		   /* call and handling of returned signal */
+#define OperName    fld[0].oper_nm /* run-time routine name or null */
+/* uses Cont */
+#define Flags       fld[2].n       /* flag: NeedCont, ForeignSig */
+#define ArgLst      fld[3].cd	   /* argument list */
+#define ContFail    fld[4].cd	   /* label/signal to goto/return on failure */
+#define SigActs     fld[5].sa	   /* actions to take for returned signals */
+#define NextCall    fld[6].cd	   /* for chaining calls within a continuation*/
+#define NeedCont    1              /* pass NULL continuation if Cont == NULL */
+#define ForeignSig  2              /* may get foreign signal from a suspend */
+
+#define C_RetSig    3 		   /* return signal */
+#define SigRef      fld[0].sigref  /* pointer to func's reference to signal */
+
+#define C_Goto      4		   /* goto label */
+#define Lbl         fld[0].cd      /* label */
+
+#define C_Label     5		   /* statment label "Ln:" and signal "n" */
+#define Container   fld[0].fnc	   /* continuation containing label */
+#define SeqNum      fld[1].n	   /* sequence number, n */
+#define Desc        fld[2].s	   /* description of how label/signal is used */
+#define RefCnt      fld[3].n	   /* reference count for label */
+#define LabFlg      fld[4].n       /* flag: FncPtrd, BndSig */
+#define FncPrtd     1		   /*   function sig_n has been printed */
+#define Bounding    2		   /*   this is a bounding label */
+
+#define C_Lit      6 		   /* literal (integer, real, string, cset) */
+/* uses Rslt */
+#define Literal    fld[1].lit
+
+#define C_Resume   7		   /* resume signal */
+#define C_Continue 8 		   /* continue signal */
+#define C_FallThru 9		   /* fall through signal */
+#define C_PFail    10		   /* procedure failure */
+#define C_PRet     11		   /* procedure return (result already set) */
+#define C_PSusp    12		   /* procedure suspend */
+#define C_Break    13		   /* break out of signal handling switch */
+#define C_LBrack   14              /* '{' */
+#define C_RBrack   15              /* '}' */
+
+#define C_Create   16              /* call of create() for create expression */
+/* uses Rslt */
+/* uses Cont */
+#define NTemps      fld[2].n	   /* number of temporary descriptors needed */
+#define WrkSize     fld[3].n	   /* size of non-descriptor work area */
+#define NextCreat   fld[4].cd	   /* for chaining creates in a continuation */
+
+
+#define C_If       17		   /* conditional (goto or return) */
+#define Cond       fld[0].cd       /* condition */
+#define ThenStmt   fld[1].cd       /* what to do if condition is true */
+
+#define C_SrcLoc   18
+#define FileName    fld[0].s      /* name of source file */
+#define LineNum     fld[1].n      /* line number within source file */
+
+#define C_CdAry    19             /* array of code pieces, each with type code*/
+#define A_Str      0              /* code represented as a string */
+#define A_ValLoc   1              /* value location */
+#define A_Intgr    2              /* integer */
+#define A_ProcCont 3              /* procedure continuation */
+#define A_SBuf     4              /* string buffer (integer index) */
+#define A_CBuf     5              /* cset buffer (integer index) */
+#define A_Ary      6              /* pointer to subarray of code pieces */
+#define A_End      7              /* marker for end of array */
+#define ElemTyp(i) fld[2*i].n     /* type of element i (A_* codes) */
+#define Str(i)     fld[2*i+1].s   /* string in element i */
+#define ValLoc(i)  fld[2*i+1].vloc /* value location in element i */
+#define Intgr(i)   fld[2*i+1].n   /* integer in element i */
+#define Array(i)   fld[2*i+1].cd  /* pointer to subarray in element i */
+
+/*
+ * union cd_fld - fields within a code struct.
+ */
+union cd_fld {
+   int n;                  /* various integer values */
+   char *s;                /* various string values */
+   struct lentry *nvar;    /* symbol table entry for a named variable */
+   struct code *cd;        /* various pointers to other pieces of code */
+   struct c_fnc *fnc;      /* pointer to function information */
+   struct centry *lit;     /* symbol table entry for a literal */
+   struct sig_act *sa;     /* actions to take for a returned signal */
+   struct sig_lst *sigref; /* pointer to func's reference to signal */
+   struct val_loc *vloc;   /* value location */
+   char *oper_nm;          /* name of run-time operation or NULL */
+   };
+
+/*
+ * code - struct used to hold the internal representation of generated code.
+ */
+struct code {
+   int cd_id;           /* kind of code: C_* */
+   struct code *next;   /* next code fragment in list */
+   struct code *prev;   /* previous code fragment in list */
+   union cd_fld fld[1]; /* fields of code fragment, actual number varies */
+   };
+
+/*
+ * NewCode - allocate a code structure with "size" fields.
+ */
+#define NewCode(size) (struct code *)alloc((unsigned int)\
+    (sizeof(struct code) + (size-1) * sizeof(union cd_fld)))
+
+/*
+ * c_fnc contains information about a C function that implements a continuation.
+ */
+#define CF_SigOnly    1   /* this function only returns a signal */
+#define CF_ForeignSig 2   /* may return foreign signal from a suspend */
+#define CF_Mark       4   /* this function has been visited by fix_fncs() */
+#define CF_Coexpr     8   /* this function implements a co-expression */
+struct c_fnc {
+   char prefix[PrfxSz+1];   /* function prefix */
+   char frm_prfx[PrfxSz+1]; /* procedure frame prefix */
+   int flag;	            /* CF_* flags */
+   struct code cd;          /* start of code sequence */
+   struct code *cursor;     /* place to insert more code into sequence */
+   struct code *call_lst;   /* functions called by this function */
+   struct code *creatlst;   /* list of creates in this function */
+   struct sig_lst *sig_lst; /* signals returned by this function */
+   int ref_cnt;             /* reference count for this function */
+   struct c_fnc *next;
+   };
+
+
+/*
+ * sig_lst - a list of signals returned by a continuation along with a count
+ *  of the number of places each signal is returned.
+ */
+struct sig_lst {
+   struct code *sig;     /* signal */
+   int ref_cnt;          /* number of places returned */
+   struct sig_lst *next;
+   };
+
+/*
+ * op_symentry - entry in symbol table for an operation
+ */
+#define AdjNone  1   /* no adjustment to this argument */
+#define AdjDrf   2   /* deref in place */
+#define AdjNDrf  3   /* deref into a new temporary */
+#define AdjCpy   4   /* copy into a new temporary */
+struct op_symentry {
+    int n_refs;          /* number of non-modifying references */
+    int n_mods;          /* number of modifying referenced */
+    int n_rets;          /* number of times directly returned from operation */
+    int var_safe;        /* if arg is named var, it may be used directly */
+    int adjust;          /* AdjNone, AdjInplc, or AdjToNew */
+    int itmp_indx;       /* index of temporary C integer variable */
+    int dtmp_indx;       /* index of temporary C double variable */
+    struct val_loc *loc;
+    };
+
+extern int num_tmp;		/* number of temporary descriptor variables */
+extern int num_itmp;		/* number of temporary C integer variables */
+extern int num_dtmp;		/* number of temporary C double variables */
+extern int num_sbuf;		/* number of string buffers */
+extern int num_cbuf;		/* number of cset buffers */
+
+extern struct code *bound_sig;  /* bounding signal for current procedure */
+
+/*
+ * statically declared "signals".
+ */
+extern struct code resume;
+extern struct code contin;
+extern struct code fallthru;
+extern struct code next_fail;
+
+extern struct val_loc ignore;    /* no values, just something to point at */
+extern struct c_fnc *cur_fnc;    /* C function currently being built */
+extern struct code *on_failure;  /* place to go on failure */
+
+extern int lbl_seq_num;		/* next label sequence number */
+
+extern char pre[PrfxSz];        /* next unused prefix */
+
+extern struct op_symentry *cur_symtab; /* current operation symbol table */
+
+#define SepFnc  1   /* success continuation goes in separate function */
+#define SContIL 2   /* in line success continuation */
+#define EndOper 3   /* success continuation goes at end of operation */
+
+#define HasVal 1    /* type contains values */
+#define HasLcl 2    /* type contains local variables */
+#define HasPrm 4    /* type contains parameters */
+#define HasGlb 8    /* type contains globals (including statics and elements) */
+#define HasVar(x) ((x) & (HasLcl | HasPrm | HasGlb))
diff --git a/src/iconc/ccomp.c b/src/iconc/ccomp.c
new file mode 100644
index 0000000..5b86189
--- /dev/null
+++ b/src/iconc/ccomp.c
@@ -0,0 +1,130 @@
+/*
+ * ccomp.c - routines for compiling and linking the C program produced
+ *   by the translator.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "csym.h"
+#include "cproto.h"
+
+extern char *refpath;
+
+#define ExeFlag "-o"
+#define LinkLibs " -lm"
+ 
+/*
+ * Structure to hold the list of Icon run-time libraries that must be
+ *  linked in.
+ */
+struct lib {
+   char *libname;
+   int nm_sz;
+   struct lib *next;
+   };
+static struct lib *liblst;
+static int lib_sz = 0;
+
+/*
+ * addlib - add a new library to the list the must be linked.
+ */
+void addlib(libname)
+char *libname;
+   {
+   static struct lib **nxtlib = &liblst;
+   struct lib *l;
+
+   l = NewStruct(lib);
+   l->libname = libname;
+   l->nm_sz = strlen(libname);
+   l->next = NULL;
+   *nxtlib = l;
+   nxtlib = &l->next;
+   lib_sz += l->nm_sz + 1;
+   }
+
+/*
+ * ccomp - perform C compilation and linking.
+ */
+int ccomp(srcname, exename)
+char *srcname;
+char *exename;
+   {
+   struct lib *l;
+   char sbuf[MaxPath];			/* file name construction buffer */
+   char *buf;
+   char *s;
+   char *dlrgint;
+   int cmd_sz, opt_sz, flg_sz, exe_sz, src_sz;
+
+   /*
+    * Compute the sizes of the various parts of the command line
+    *  to do the compilation.
+    */
+   cmd_sz = strlen(c_comp);
+   opt_sz = strlen(c_opts);
+   flg_sz = strlen(ExeFlag);
+   exe_sz = strlen(exename);
+   src_sz = strlen(srcname);
+   lib_sz += strlen(LinkLibs);
+   if (!largeints) {
+      dlrgint = makename(sbuf, refpath, "dlrgint", ObjSuffix);
+      lib_sz += strlen(dlrgint) + 1;
+      }
+
+#ifdef Graphics
+   lib_sz += strlen(" -L") +
+             strlen(refpath) +
+	     strlen(" -lIgpx ");
+   lib_sz += strlen(ICONC_XLIB);
+#endif					/* Graphics */
+
+   buf = alloc((unsigned int)cmd_sz + opt_sz + flg_sz + exe_sz + src_sz +
+			     lib_sz + 5);
+   strcpy(buf, c_comp);
+   s = buf + cmd_sz;
+   *s++ = ' ';
+   strcpy(s, c_opts);
+   s += opt_sz;
+   *s++ = ' ';
+   strcpy(s, ExeFlag);
+   s += flg_sz;
+   *s++ = ' ';
+   strcpy(s, exename);
+   s += exe_sz;
+   *s++ = ' ';
+   strcpy(s, srcname);
+   s += src_sz;
+   if (!largeints) {
+      *s++ = ' ';
+      strcpy(s, dlrgint);
+      s += strlen(dlrgint);
+      }
+   for (l = liblst; l != NULL; l = l->next) {
+      *s++ = ' ';
+      strcpy(s, l->libname);
+      s += l->nm_sz;
+      }
+
+#ifdef Graphics
+   strcpy(s," -L");
+   strcat(s, refpath);
+   strcat(s," -lIgpx ");
+   strcat(s, ICONC_XLIB);
+   s += strlen(s);
+#endif					/* Graphics */
+
+   strcpy(s, LinkLibs);
+
+   if (system(buf) != 0)
+      return EXIT_FAILURE;
+   strcpy(buf, "strip ");
+   s = buf + 6;
+   strcpy(s, exename);
+   system(buf);
+
+
+   return EXIT_SUCCESS;
+   }
diff --git a/src/iconc/cglobals.h b/src/iconc/cglobals.h
new file mode 100644
index 0000000..301a602
--- /dev/null
+++ b/src/iconc/cglobals.h
@@ -0,0 +1,50 @@
+/*
+ *  Global variables.
+ */
+
+extern char *runtime;
+
+#ifndef Global
+#define Global extern
+#define Init(v)
+#endif					/* Global */
+
+/*
+ * Variables related to command processing.
+ */
+Global char *progname	Init("iconc");	/* program name for diagnostics */
+
+Global int debug_info	Init(0);	/* -fd, -t: generate debugging info */
+Global int err_conv     Init(0);	/* -fe: support error conversion */
+
+#ifdef LargeInts
+   Global int largeints	Init(1);	/* -fl: support large integers */
+#else					/* LargeInts */
+   Global int largeints	Init(0);	/* -fl: support large integers */
+#endif					/* LargeInts */
+
+Global int line_info	Init(0);	/* -fn, -fd, -t: generate line info */
+Global int m4pre	Init(0);	/* -m: use m4 preprocessor? */
+Global int str_inv	Init(0);	/* -fs: enable full string invocation */
+Global int trace	Init(0);	/* -t: initial &trace value */
+Global int uwarn	Init(0);	/* -u: warn about undefined ids? */
+Global int just_type_trace Init(0);	/* -T: suppress C code */
+Global int verbose      Init(1);	/* -s, -v: level of verbosity */
+Global int pponly       Init(0);	/* -E: preprocess only */
+
+Global char *c_comp     Init(CComp);    /* -C: C compiler */
+Global char *c_opts     Init(COpts);    /* -p: options for C compiler */
+
+/*
+ * Flags turned off by the -n option.
+ */
+Global int opt_cntrl	Init(1);	/* do control flow optimization */
+Global int opt_sgnl	Init(1);	/* do signal handling optimizations */
+Global int do_typinfer	Init(1);	/* do type inference */
+Global int allow_inline Init(1);	/* allow expanding operations in line */
+
+/*
+ * Files.
+ */
+Global FILE *codefile	Init(0);	/* C code output - primary file */
+Global FILE *inclfile	Init(0);	/* C code output - include file */
diff --git a/src/iconc/cgrammar.c b/src/iconc/cgrammar.c
new file mode 100644
index 0000000..a48e621
--- /dev/null
+++ b/src/iconc/cgrammar.c
@@ -0,0 +1,221 @@
+/*
+ * cgrammar.c - includes and macros for building the parse tree.
+ */
+#include "../h/define.h"
+#include "../common/yacctok.h"
+
+%{
+/*
+ * These commented directives are passed through the first application
+ * of cpp, then turned into real directives in cgram.g by fixgram.icn.
+ */
+/*#include "../h/gsupport.h"*/
+/*#include "../h/lexdef.h"*/
+/*#include "ctrans.h"*/
+/*#include "csym.h"*/
+/*#include "ctree.h"*/
+/*#include "ccode.h" */
+/*#include "cproto.h"*/
+/*#undef YYSTYPE*/
+/*#define YYSTYPE nodeptr*/
+/*#define YYMAXDEPTH 500*/
+
+int idflag;
+
+#define EmptyNode tree1(N_Empty) 
+
+#define Alt(x1,x2,x3)		$$ = tree4(N_Alt,x2,x1,x3) 
+#define Apply(x1,x2,x3)		$$ = tree4(N_Apply,x2,x1,x3) 
+#define Arglist1()		/* empty */
+#define Arglist2(x)		/* empty */
+#define Arglist3(x1,x2,x3)	proc_lst->nargs = -proc_lst->nargs
+#define Bact(x1,x2,x3)		$$ = tree5(N_Activat,x2,x2,x1,x3) 
+#define Bamper(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Bassgn(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Baugact(x1,x2,x3)	$$ = tree5(N_Activat,x2,x2,x1,x3) 
+#define Baugamper(x1,x2,x3)	$$ = aug_nd(x2,x1,x3) 
+#define Baugcat(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugeq(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugeqv(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugge(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauggt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauglcat(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugle(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bauglt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugne(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugneqv(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugques(x1,x2,x3)	$$ = tree5(N_Scan,x2,x2,x1,x3) 
+#define Baugseq(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsge(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsgt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsle(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugslt(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Baugsne(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bcaret(x1,x2,x3)	$$ = binary_nd(x2,x1,x3) 
+#define Bcareta(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bcat(x1,x2,x3)		$$ = binary_nd(x2,x1,x3) 
+#define Bdiff(x1,x2,x3)		$$ = binary_nd(x2,x1,x3) 
+#define Bdiffa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Beq(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Beqv(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bge(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bgt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Binter(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bintera(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Blcat(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Ble(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Blim(x1,x2,x3)		$$ = tree4(N_Limit,x2,x1,x3) 
+#define Blt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bminus(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bminusa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bmod(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bmoda(x1,x2,x3)		$$ = aug_nd(x2,x1,x3)
+#define Bne(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bneqv(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bplus(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bplusa(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bques(x1,x2,x3)		$$ = tree5(N_Scan,x2,x2,x1,x3) 
+#define Brace(x1,x2,x3)		$$ = x2
+#define Brack(x1,x2,x3)		$$ = list_nd(x1,x2) 
+#define Brassgn(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Break(x1,x2)		$$ = tree3(N_Break,x1,x2) 
+#define Brswap(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bseq(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsge(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsgt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bslash(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Bslasha(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bsle(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bslt(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bsne(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bstar(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bstara(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Bswap(x1,x2,x3)		$$ = binary_nd(x2,x1,x3)
+#define Bunion(x1,x2,x3)	$$ = binary_nd(x2,x1,x3)
+#define Buniona(x1,x2,x3)	$$ = aug_nd(x2,x1,x3)
+#define Case(x1,x2,x3,x4,x5,x6) $$ = case_nd(x1,x2,x5) 
+#define Caselist(x1,x2,x3)	$$ = tree4(N_Clist,x2,x1,x3) 
+#define Cclause0(x1,x2,x3)	$$ = tree4(N_Ccls,x2,x1,x3) 
+#define Cclause1(x1,x2,x3)	$$ = tree4(N_Ccls,x2,x1,x3) 
+#define Cliter(x)		CSym0(x) = putlit(Str0(x),F_CsetLit,(int)Val1(x))
+#define Colon(x)		$$ = x
+#define Compound(x1,x2,x3)	$$ = tree4(N_Slist,x2,x1,x3) 
+#define Create(x1,x2)		$$ = tree3(N_Create,x1,x2);\
+				 proc_lst->has_coexpr = 1;
+#define Elst0(x)                $$ = x;
+#define Elst1(x1,x2,x3)	        $$ = tree4(N_Elist,x2,x1,x3);
+#define Every0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Every1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define Fail(x)			$$ = tree4(N_Ret,x,x,EmptyNode) 
+#define Field(x1,x2,x3)		$$ = tree4(N_Field,x2,x1,x3) 
+#define Global0(x)		idflag = F_Global
+#define Global1(x1,x2,x3)	/* empty */
+#define Globdcl(x)		/* empty */
+#define Ident(x)		install(Str0(x),idflag)
+#define Idlist(x1,x2,x3)	install(Str0(x3),idflag)
+#define If0(x1,x2,x3,x4)	$$ = tree5(N_If,x1,x2,x4,EmptyNode) 
+#define If1(x1,x2,x3,x4,x5,x6)	$$ = tree5(N_If,x1,x2,x4,x6) 
+#define Iliter(x)		CSym0(x) = putlit(Str0(x),F_IntLit,0)
+#define Initial1()		$$ = EmptyNode
+#define Initial2(x1,x2,x3)	$$ = x2
+#define Invocdcl(x)             /* empty */
+#define Invocable(x1,x2)        /* empty */
+#define Invoclist(x1,x2, x3)    /* empty */
+#define Invocop1(x)             invoc_grp(Str0(x));
+#define Invocop2(x)             invocbl(x, -1);
+#define Invocop3(x1,x2,x3)      invocbl(x1, atoi(Str0(x3)));
+#define Invoke(x1,x2,x3,x4)	$$ = invk_nd(x2,x1,x3)
+#define Keyword(x1,x2)		$$ = key_leaf(x1,Str0(x2))
+#define Kfail(x1,x2)		$$ = key_leaf(x1,spec_str("fail")) 
+#define Link(x1,x2)		/* empty */
+#define Linkdcl(x)		/* empty */
+#define Lnkfile1(x)		lnkdcl(Str0(x));
+#define Lnkfile2(x)		lnkdcl(Str0(x));
+#define Lnklist(x1,x2,x3)	/* empty */
+#define Local(x)		idflag = F_Dynamic
+#define Locals1()		/* empty */
+#define Locals2(x1,x2,x3,x4)	/* empty */
+#define Mcolon(x)		$$ = x
+#define Nexpr()			$$ = EmptyNode
+#define Next(x)			$$ = tree2(N_Next,x) 
+#define Paren(x1,x2,x3)		if ((x2)->n_type == N_Elist)\
+                                   $$ = invk_nd(x1,EmptyNode,x2);\
+ 				else\
+ 				   $$ = x2
+#define Pcolon(x)		$$ = x
+#define Pdco0(x1,x2,x3)		$$ = invk_nd(x2,x1,list_nd(x2,EmptyNode))
+#define Pdco1(x1,x2,x3,x4)	$$ = invk_nd(x2,x1,list_nd(x2,x3)) 
+#define Pdcolist0(x)		$$ = tree3(N_Create,x,x);\
+				 proc_lst->has_coexpr = 1;
+#define Pdcolist1(x1,x2,x3)	$$ =tree4(N_Elist,x2,x1,tree3(N_Create,x2,x3));\
+				 proc_lst->has_coexpr = 1;
+#define Proc1(x1,x2,x3,x4,x5,x6) $$ = tree6(N_Proc,x1,x1,x4,x5,x6)
+#define Procbody1()		$$ = EmptyNode
+#define Procbody2(x1,x2,x3)	$$ = tree4(N_Slist,x2,x1,x3) 
+#define Procdcl(x)		proc_lst->tree = x
+#define Prochead1(x1,x2)	init_proc(Str0(x2));\
+				idflag = F_Argument
+#define Prochead2(x1,x2,x3,x4,x5,x6) /* empty */
+#define Progend(x1,x2)		/* empty */
+#define Recdcl(x)		/* empty */
+#define Record1(x1, x2)		init_rec(Str0(x2));\
+                                idflag = F_Field
+#define Record2(x1,x2,x3,x4,x5,x6) /* empty */
+#define Repeat(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Return(x1,x2)		$$ = tree4(N_Ret,x1,x1,x2) 
+#define Rliter(x)		CSym0(x) = putlit(Str0(x),F_RealLit,0)
+#define Section(x1,x2,x3,x4,x5,x6) $$ = sect_nd(x4,x1,x3,x5) 
+#define Sliter(x)		CSym0(x) = putlit(Str0(x),F_StrLit,(int)Val1(x))
+#define Static(x)		idflag = F_Static
+#define Subscript(x1,x2,x3,x4)	$$ = buildarray(x1,x2,x3)
+#define Suspend0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Suspend1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define To0(x1,x2,x3)		$$ = to_nd(x2,x1,x3) 
+#define To1(x1,x2,x3,x4,x5)	$$ = toby_nd(x2,x1,x3,x5) 
+#define Uat(x1,x2)		$$ = tree5(N_Activat,x1,x1,EmptyNode,x2) 
+#define Ubackslash(x1,x2)	$$ = unary_nd(x1,x2)
+#define Ubang(x1,x2)		$$ = unary_nd(x1,x2)
+#define Ubar(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Ucaret(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Udiff(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Udot(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uequiv(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uinter(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Ulconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2) 
+#define Ulexeq(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Ulexne(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uminus(x1,x2)		$$ = unary_nd(x1,x2)
+#define Unot(x1,x2)		$$ = tree3(N_Not,x2,x2) 
+#define Unotequiv(x1,x2)	$$ = MultiUnary(x1,x2)
+#define Until0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode) 
+#define Until1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+#define Unumeq(x1,x2)		$$ = unary_nd(x1,x2)
+#define Unumne(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Uplus(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uqmark(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uslash(x1,x2)		$$ = unary_nd(x1,x2)
+#define Ustar(x1,x2)		$$ = unary_nd(x1,x2)
+#define Utilde(x1,x2)		$$ = unary_nd(x1,x2)
+#define Uunion(x1,x2)		$$ = MultiUnary(x1,x2)
+#define Var(x)			LSym0(x) = putloc(Str0(x),0)
+#define While0(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode)
+#define While1(x1,x2,x3,x4)	$$ = tree5(N_Loop,x1,x1,x2,x4) 
+%}
+
+%%
+#include "../h/grammar.h"
+%%
+
+/*
+ * xfree(p) -- used with free(p) macro to avoid compiler errors from
+ *  miscast free calls generated by Yacc.
+ */
+#undef free
+static void xfree(p)
+char *p;
+{
+   free(p);
+}
+
+/*#define free(p) xfree((char*)p)*/
diff --git a/src/iconc/chkinv.c b/src/iconc/chkinv.c
new file mode 100644
index 0000000..af4298f
--- /dev/null
+++ b/src/iconc/chkinv.c
@@ -0,0 +1,545 @@
+/*
+ * chkinv.c - routines to determine which global names are only
+ *   used as immediate operand to invocation and to directly invoke
+ *   the corresponding operations. In addition, simple assignments to
+ *   names variables are recognized and it is determined whether
+ *   procedures return, suspend, or fail.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * prototypes for static functions.
+ */
+static int     chg_ret  (int flag);
+static void chksmpl  (struct node *n, int smpl_invk);
+static int     seq_exec (int exec_flg1, int exec_flg2);
+static int     spcl_inv (struct node *n, struct node *asgn);
+
+static ret_flag;
+
+/*
+ * chkinv - check for invocation and assignment optimizations.
+ */
+void chkinv()
+   {
+   struct gentry *gp;
+   struct pentry *proc;
+   int exec_flg;
+   int i;
+
+   if (debug_info)
+       return;  /* The following analysis is not valid */
+
+   /*
+    * start off assuming that global variables for procedure, etc. are
+    *  only used as immediate operands to invocations then mark any 
+    *  which are not. Any variables retaining the property are never
+    *  changed. Go through the code and change invocations to such
+    *  variables to invocations directly to the operation.
+    */
+   for (i = 0; i < GHSize; i++)
+      for (gp = ghash[i]; gp != NULL; gp = gp->blink) {
+         if (gp->flag & (F_Proc | F_Builtin | F_Record) &&
+            !(gp->flag & F_StrInv))
+               gp->flag |= F_SmplInv;
+         /*
+          * However, only optimize normal cases for main.
+          */
+         if (strcmp(gp->name, "main") == 0 && (gp->flag & F_Proc) &&
+            (gp->val.proc->nargs < 0 || gp->val.proc->nargs > 1))
+               gp->flag &= ~(uword)F_SmplInv;
+         /*
+          * Work-around to problem that a co-expression block needs
+          *  block for enclosing procedure: just keep procedure in
+          *  a variable to force outputting the block. Note, this
+          *  inhibits tailored calling conventions for the procedure.
+          */
+         if ((gp->flag & F_Proc) && gp->val.proc->has_coexpr)
+            gp->flag &= ~(uword)F_SmplInv;
+         }
+
+   /*
+    * Analyze code in each procedure.
+    */
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      chksmpl(Tree1(proc->tree), 0);  /* initial expression */
+      chksmpl(Tree2(proc->tree), 0);  /* procedure body */
+      }
+
+   /*
+    * Go through each procedure performing "naive" optimizations on
+    *  invocations and assignments. Also determine whether the procedure
+    *  returns, suspends, or fails (possibly by falling through to
+    *  the end).
+    */
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      ret_flag = 0;
+      spcl_inv(Tree1(proc->tree), NULL);
+      exec_flg = spcl_inv(Tree2(proc->tree), NULL);
+      if (exec_flg & DoesFThru)
+        ret_flag |= DoesFail;
+      proc->ret_flag = ret_flag;
+      }
+   }
+
+/*
+ * smpl_invk - find any global variable uses that are not a simple
+ *  invocation and mark the variables.
+ */
+static void chksmpl(n, smpl_invk)
+struct node *n;
+int smpl_invk;
+   {
+   struct node *cases;
+   struct node *clause;
+   struct lentry *var;
+   int i;
+   int lst_arg;
+
+   switch (n->n_type) {
+      case N_Alt:
+      case N_Apply:
+      case N_Limit:
+      case N_Slist:
+         chksmpl(Tree0(n), 0);
+         chksmpl(Tree1(n), 0);
+         break;
+
+      case N_Activat:
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Augop:
+         chksmpl(Tree2(n), 0);
+         chksmpl(Tree3(n), 0);
+         break;
+
+      case N_Bar:
+      case N_Break:
+      case N_Create:
+      case N_Field:
+      case N_Not:
+         chksmpl(Tree0(n), 0);
+         break;
+
+      case N_Case:
+         chksmpl(Tree0(n), 0);  /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+      
+            chksmpl(Tree0(clause), 0);   /* value of clause */
+            chksmpl(Tree1(clause), 0);   /* body of clause */
+            }
+         if (Tree2(n) != NULL)
+            chksmpl(Tree2(n), 0);  /* default */
+         break;
+
+      case N_Cset:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+      case N_Empty:
+      case N_Next:
+         break;
+
+      case N_Id:
+         if (!smpl_invk) {
+            /*
+             * The variable is being used somewhere other than in a simple
+             *  invocation.
+             */
+            var = LSym0(n);
+            if (var->flag & F_Global)
+               var->val.global->flag &= ~F_SmplInv;
+            }
+         break;
+
+      case N_If:
+         chksmpl(Tree0(n), 0);
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Invok:
+         lst_arg =  1 + Val0(n);
+         /*
+          * Check the thing being invoked, noting that it is in fact being
+          *  invoked.
+          */
+         chksmpl(Tree1(n), 1);
+         for (i = 2; i <= lst_arg; ++i)
+            chksmpl(n->n_field[i].n_ptr, 0);  /* arg i - 1 */
+         break;
+
+      case N_InvOp:
+         lst_arg = 1 + Val0(n);
+         for (i = 2; i <= lst_arg; ++i)
+            chksmpl(n->n_field[i].n_ptr, 0);       /* arg i */
+         break;
+
+      case N_Loop: {
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+            case WHILE:
+            case UNTIL:
+               chksmpl(Tree1(n), 0);   /* control clause */
+               chksmpl(Tree2(n), 0);   /* do clause */
+               break;
+
+            case REPEAT:
+               chksmpl(Tree1(n), 0);   /* clause */
+               break;
+            }
+         }
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)
+            chksmpl(Tree1(n), 0);
+         break;
+
+      case N_Scan:
+         chksmpl(Tree1(n), 0);
+         chksmpl(Tree2(n), 0);
+         break;
+
+      case N_Sect:
+         chksmpl(Tree2(n), 0);
+         chksmpl(Tree3(n), 0);
+         chksmpl(Tree4(n), 0);
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * spcl_inv - look for general invocations that can be replaced by
+ *   special invocations. Simple assignment to a named variable is
+ *   is a particularly special case. Also, determine whether execution
+ *   might "fall through" this code and whether the code might fail.
+ */
+static int spcl_inv(n, asgn)
+struct node *n;
+struct node *asgn;  /* the result goes into this special-cased assignment */
+   {
+   struct node *cases;
+   struct node *clause;
+   struct node *invokee;
+   struct gentry *gvar;
+   struct loop {
+      int exec_flg;
+      struct node *asgn;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   int exec_flg;
+   int i;
+   int lst_arg;
+   static struct loop *cur_loop = NULL;
+
+   switch (n->n_type) {
+      case N_Activat:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* assume worst case */
+         return seq_exec(spcl_inv(Tree1(n), NULL), spcl_inv(Tree2(n), NULL));
+
+      case N_Alt:
+         exec_flg = spcl_inv(Tree0(n), asgn) & DoesFThru;
+         return exec_flg | spcl_inv(Tree1(n), asgn);
+
+      case N_Apply:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         return seq_exec(spcl_inv(Tree0(n), NULL), spcl_inv(Tree1(n), NULL));
+
+      case N_Augop:
+         exec_flg = chg_ret(Impl1(n)->ret_flag);
+         if (Tree2(n)->n_type == N_Id) {
+            /*
+             * This is an augmented assignment to a named variable.
+             *  An optimized version of assignment can be used.
+             */
+            n->n_type = N_SmplAug;
+            if (Impl1(n)->use_rslt)
+               Val0(n) = AsgnCopy;
+            else
+               Val0(n) = AsgnDirect;
+            }
+         else {
+            if (asgn != NULL)
+               Val0(asgn) = AsgnDeref; /* this operation produces a variable */
+            exec_flg = seq_exec(exec_flg, spcl_inv(Tree2(n), NULL));
+            exec_flg = seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
+            }
+         return seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
+
+      case N_Bar:
+         return spcl_inv(Tree0(n), asgn);
+
+      case N_Break:
+         if (cur_loop == NULL) {
+	    nfatal(n, "invalid context for break", NULL);
+            return 0;
+            }
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         loop_sav->exec_flg |= spcl_inv(Tree0(n), loop_sav->asgn);
+         cur_loop = loop_sav;
+         return 0;
+
+      case N_Create:
+         spcl_inv(Tree0(n), NULL);
+         return DoesFThru;
+
+      case N_Case:
+         exec_flg = spcl_inv(Tree0(n), NULL) & DoesFail; /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+      
+            spcl_inv(Tree0(clause), NULL);
+            exec_flg |= spcl_inv(Tree1(clause), asgn);
+            }
+         if (Tree2(n) != NULL)
+            exec_flg |= spcl_inv(Tree2(n), asgn);  /* default */
+         else
+            exec_flg |= DoesFail;
+         return exec_flg;
+
+      case N_Cset:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+      case N_Empty:
+         return DoesFThru;
+
+      case N_Field:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* operation produces variable */
+         return spcl_inv(Tree0(n), NULL);
+
+      case N_Id:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnDeref;  /* variable */
+         return DoesFThru;
+
+      case N_If:
+         spcl_inv(Tree0(n), NULL);
+         exec_flg = spcl_inv(Tree1(n), asgn);
+         if (Tree2(n)->n_type == N_Empty)
+            exec_flg |= DoesFail;
+         else
+            exec_flg |= spcl_inv(Tree2(n), asgn);
+         return exec_flg;
+
+      case N_Invok:
+         lst_arg = 1 + Val0(n);
+         invokee = Tree1(n);
+         exec_flg = DoesFThru;
+         for (i = 2; i <= lst_arg; ++i)
+            exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, NULL));
+         if (invokee->n_type == N_Id && LSym0(invokee)->flag & F_Global) {
+            /*
+             * This is an invocation of a global variable. If we can
+             *  convert this to a direct invocation, determine whether
+             *  it is an invocation of a procedure, built-in function,
+             *  or record constructor; each has a difference kind of
+             *  direct invocation node.
+             */
+            gvar = LSym0(invokee)->val.global;
+            if (gvar->flag & F_SmplInv) {
+               switch (gvar->flag & (F_Proc | F_Builtin | F_Record)) {
+                  case F_Proc:
+                     n->n_type = N_InvProc;
+                     Proc1(n) = gvar->val.proc;
+                     return DoesFThru | DoesFail; /* assume worst case */
+                  case F_Builtin:
+                     n->n_type = N_InvOp;
+                     Impl1(n) = gvar->val.builtin;
+                     if (asgn != NULL && Impl1(n)->use_rslt)
+                        Val0(asgn) = AsgnCopy;
+                     return seq_exec(exec_flg, chg_ret(
+                        gvar->val.builtin->ret_flag));
+                  case F_Record:
+                     n->n_type = N_InvRec;
+                     Rec1(n) = gvar->val.rec;
+                     return seq_exec(exec_flg, DoesFThru |
+                        (err_conv ? DoesFail : 0));
+                  }
+               }
+            }
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         spcl_inv(invokee, NULL);
+         return DoesFThru | DoesFail; /* assume worst case */
+
+      case N_InvOp:
+         if (Impl1(n)->op != NULL && strcmp(Impl1(n)->op, ":=") == 0 &&
+            Tree2(n)->n_type == N_Id) {
+            /*
+             * This is a simple assignment to a named variable.
+             *  An optimized version of assignment can be used.
+             */
+            n->n_type = N_SmplAsgn;
+
+            /* 
+             * For now, assume rhs of := can compute directly into a 
+             *  variable. This may be changed when the rhs is examined
+             *  in the recursive call to spcl_inv().
+             */
+            Val0(n) = AsgnDirect;
+            return spcl_inv(Tree3(n), n);
+            }
+         else {
+            /*
+             * No special cases.
+             */
+            lst_arg = 1 + Val0(n);
+            exec_flg = chg_ret(Impl1(n)->ret_flag);
+            for (i = 2; i <= lst_arg; ++i)
+               exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, 
+                  NULL)); /* arg i */
+            if (asgn != NULL && Impl1(n)->use_rslt)
+               Val0(asgn) = AsgnCopy;
+            return exec_flg;
+            }
+
+      case N_Limit:
+         return seq_exec(spcl_inv(Tree0(n), asgn),
+            spcl_inv(Tree1(n), NULL)) | DoesFail;
+
+      case N_Loop: {
+         loop_info.prev = cur_loop;
+         loop_info.exec_flg = 0;
+         loop_info.asgn = asgn;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case WHILE:
+            case UNTIL:
+               spcl_inv(Tree1(n), NULL);   /* control clause */
+               spcl_inv(Tree2(n), NULL);   /* do clause */
+               exec_flg = DoesFail;
+               break;
+
+            case SUSPEND:
+               spcl_inv(Tree1(n), NULL);   /* control clause */
+               spcl_inv(Tree2(n), NULL);   /* do clause */
+               ret_flag |= DoesSusp;
+               exec_flg = DoesFail;
+               break;
+
+            case REPEAT:
+               spcl_inv(Tree1(n), NULL);   /* clause */
+               exec_flg = 0;
+               break;
+            }
+         exec_flg |= cur_loop->exec_flg;
+         cur_loop = cur_loop->prev;
+         return exec_flg;
+         }
+
+      case N_Next:
+         return 0;
+
+      case N_Not:
+         exec_flg = spcl_inv(Tree0(n), NULL);
+         return ((exec_flg & DoesFail) ? DoesFThru : 0) |
+            ((exec_flg & DoesFThru) ? DoesFail: 0);
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN) {
+            exec_flg = spcl_inv(Tree1(n), NULL);
+            ret_flag |= DoesRet;
+            if (exec_flg & DoesFail)
+               ret_flag |= DoesFail;
+            }
+         else
+            ret_flag |= DoesFail;
+         return 0;
+
+      case N_Scan:
+         if (asgn != NULL)
+            Val0(asgn) = AsgnCopy; /* assume worst case */
+         return seq_exec(spcl_inv(Tree1(n), NULL),
+            spcl_inv(Tree2(n), NULL));
+
+      case N_Sect:
+         if (asgn != NULL && Impl0(n)->use_rslt)
+            Val0(asgn) = AsgnCopy;
+         exec_flg = spcl_inv(Tree2(n), NULL);
+         exec_flg = seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
+         exec_flg = seq_exec(exec_flg, spcl_inv(Tree4(n), NULL));
+         return seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
+
+      case N_Slist:
+         exec_flg = spcl_inv(Tree0(n), NULL);
+         if (exec_flg & (DoesFThru | DoesFail))
+            exec_flg = DoesFThru;
+         return seq_exec(exec_flg, spcl_inv(Tree1(n), asgn));
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * seq_exec - take the execution flags for sequential pieces of code
+ *  and compute the flags for the combined code.
+ */
+static int seq_exec(exec_flg1, exec_flg2)
+int exec_flg1;
+int exec_flg2;
+   {
+   return (exec_flg1 & exec_flg2 & DoesFThru) |
+      ((exec_flg1 | exec_flg2) & DoesFail);
+   }
+
+/*
+ * chg_ret - take a return flag and change suspend and return to
+ *  "fall through". If error conversion is supported, change error
+ *  failure to failure.
+ *  
+ */
+static int chg_ret(flag)
+int flag;
+   {
+   int flg1;
+
+   flg1 = flag & DoesFail;
+   if (flag & (DoesRet | DoesSusp))
+      flg1 |= DoesFThru;
+   if (err_conv && (flag & DoesEFail))
+      flg1 |= DoesFail;
+   return flg1;
+   }
+
+
diff --git a/src/iconc/clex.c b/src/iconc/clex.c
new file mode 100644
index 0000000..8e7d657
--- /dev/null
+++ b/src/iconc/clex.c
@@ -0,0 +1,18 @@
+/*
+ * clex.c -- the lexical analyzer for iconc.
+ */
+#define Iconc
+
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "ctoken.h"
+#include "ctree.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+#include "../h/parserr.h"
+#include "../common/lextab.h"
+#include "../common/yylex.h"
+#include "../common/error.h"
diff --git a/src/iconc/cmain.c b/src/iconc/cmain.c
new file mode 100644
index 0000000..6daf5c4
--- /dev/null
+++ b/src/iconc/cmain.c
@@ -0,0 +1,424 @@
+/*
+ * cmain.c - main program icon compiler.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "csym.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+static void execute (char *ofile, char **args);
+static FILE  *open_out (char *fname);
+static void rmfile  (char *fname);
+static void report  (char *s);
+static void usage   (void);
+
+char *refpath;
+
+char patchpath[MaxPath+18] = "%PatchStringHere->";
+
+/*
+ *  Define global variables.
+ */
+
+#define Global
+#define Init(v) = v
+#include "cglobals.h"
+
+/*
+ * getopt() variables
+ */
+extern int optind;		/* index into parent argv vector */
+extern int optopt;		/* character checked for validity */
+extern char *optarg;		/* argument associated with option */
+
+/*
+ *  main program
+ */
+int main(argc,argv)
+int argc;
+char **argv;
+   {
+   int no_c_comp = 0;			/* suppress C compile and link? */
+   int errors = 0;			/* compilation errors */
+   char *cfile = NULL;			/* name of C file - primary */
+   char *hfile = NULL;			/* name of C file - include */
+   char *ofile = NULL;			/* name of executable result */
+
+   char *db_name = "rt.db";		/* data base name */
+   char *incl_file = "rt.h";		/* header file name */
+
+   char *db_path;			/* path to data base */
+   char *db_lst;			/* list of private data bases */
+   char *incl_path;			/* path to header file */
+   char *s, c1;
+   char buf[MaxPath];			/* file name construction buffer */
+   int c;
+   int ret_code;
+   struct fileparts *fp;
+
+   if ((int)strlen(patchpath) > 18)
+      refpath = patchpath+18;
+   else
+      refpath = relfile(argv[0], "/../");
+
+   /*
+    * Process options.
+    */
+   while ((c = getopt(argc,argv,"+C:ELS:Tcf:mn:o:p:r:stuv:x")) != EOF)
+      switch (c) {
+         case 'C':			/* -C C-comp: C compiler*/
+            c_comp = optarg;
+            break;
+         case 'E':			/* -E: preprocess only */
+            pponly = 1;
+            no_c_comp = 1;
+            break;
+         case 'L':			/* Ignore: interpreter only */
+            break;
+         case 'S':			/* Ignore: interpreter only */
+            break;
+	 case 'T':
+	    just_type_trace = 1;
+	    break;
+         case 'c':			/* -c: produce C file only */
+            no_c_comp = 1;
+            break;
+         case 'f':			/* -f: enable features */
+            for (s = optarg; *s != '\0'; ++s) {
+               switch (*s) {
+                  case 'a':             /* -fa: enable all features */
+                     line_info = 1;
+                     debug_info = 1;
+                     err_conv = 1;
+                     largeints = 1;
+                     str_inv = 1;
+                     break;
+                  case 'd':             /* -fd: enable debugging features */
+                     line_info = 1;
+                     debug_info = 1;
+                     break;
+                  case 'e':             /* -fe: enable error conversion */
+                     err_conv = 1;
+                     break;
+                  case 'l':             /* -fl: support large integers */
+                     largeints = 1;
+                     break;
+                  case 'n':             /* -fn: enable line numbers */
+                     line_info = 1;
+                     break;
+                  case 's':		/* -fs: enable full string invocation */
+                     str_inv = 1;
+                     break;
+                  default:
+                     quitf("-f option must be a, d, e, l, n, or s. found: %s",
+                        optarg);
+                  }
+               }
+            break;
+         case 'm':			/* -m: preprocess using m4(1) */
+            m4pre = 1;
+            break;
+         case 'n':			/* -n: disable optimizations */
+            for (s = optarg; *s != '\0'; ++s) {
+               switch (*s) {
+                  case 'a':		/* -na: disable all optimizations */
+                     opt_cntrl = 0;
+                     allow_inline = 0;
+                     opt_sgnl = 0;
+                     do_typinfer = 0;
+                     break;
+                  case 'c':		/* -nc: disable control flow opts */
+                     opt_cntrl = 0;
+                     break;
+                  case 'e':		/* -ne: disable expanding in-line */
+                     allow_inline = 0;
+                     break;
+                  case 's':		/* -ns: disable switch optimizations */
+                     opt_sgnl = 0;
+                     break;
+                  case 't':		/* -nt: disable type inference */
+                     do_typinfer = 0;
+                     break;
+                  default:
+                     usage();
+                  }
+               }
+            break;
+         case 'o':			/* -o file: name output file */
+            ofile = optarg;
+            break;
+         case 'p':			/* -p C-opts: options for C comp */
+            if (*optarg == '\0')	/* if empty string, clear options */
+               c_opts = optarg;
+            else {			/* else append to current set */
+               s = (char *)alloc(strlen(c_opts) + 1 + strlen(optarg) + 1);
+               sprintf(s, "%s %s", c_opts, optarg);
+               c_opts = s;
+               }
+            break;
+         case 'r':			/* -r path: primary runtime system */
+            refpath = optarg;
+            break;
+         case 's':			/* -s: suppress informative messages */
+            verbose = 0;
+            break;
+         case 't':                      /* -t: &trace = -1 */
+            line_info = 1;
+            debug_info = 1;
+            trace = 1;
+            break;
+         case 'u':			/* -u: warn about undeclared ids */
+            uwarn = 1;
+            break;
+         case 'v':			/* -v: set level of verbosity */
+            if (sscanf(optarg, "%d%c", &verbose, &c1) != 1)
+               quitf("bad operand to -v option: %s",optarg);
+            break;
+         default:
+         case 'x':                      /* -x illegal until after file list */
+            usage();
+         }
+
+   init();			/* initialize memory for translation */
+
+   /*
+    * Load the data bases of information about run-time routines and
+    *  determine what libraries are needed for linking (these libraries
+    *  go before any specified on the command line).
+    */
+   db_lst = getenv("DBLIST");
+   if (db_lst != NULL)
+      db_lst = salloc(db_lst);
+   s = db_lst;
+   while (s != NULL) {
+      db_lst = s;
+      while (isspace(*db_lst))
+         ++db_lst;
+      if (*db_lst == '\0')
+         break;
+      for (s = db_lst; !isspace(*s) && *s != '\0'; ++s)
+         ;
+      if (*s == '\0')
+         s = NULL;
+      else
+         *s++ = '\0';
+      readdb(db_lst);
+      addlib(salloc(makename(buf,SourceDir, db_lst, LibSuffix)));
+      }
+   db_path = (char *)alloc((unsigned int)strlen(refpath) + strlen(db_name) + 1);
+   strcpy(db_path, refpath);
+   strcat(db_path, db_name);
+   readdb(db_path);
+   addlib(salloc(makename(buf,SourceDir, db_path, LibSuffix)));
+
+   /*
+    * Scan the rest of the command line for file name arguments.
+    */
+   while (optind < argc)  {
+      if (strcmp(argv[optind],"-x") == 0)	/* stop at -x */
+         break;
+      else if (strcmp(argv[optind],"-") == 0)
+         src_file("-");				/* "-" means standard input */
+      else if (argv[optind][0] == '-')
+         addlib(argv[optind]);			/* assume linker option */
+      else {
+         fp = fparse(argv[optind]);		/* parse file name */
+         if (*fp->ext == '\0' || smatch(fp->ext, SourceSuffix)) {
+            makename(buf,SourceDir,argv[optind], SourceSuffix);
+            src_file(buf);
+            }
+         else
+            /*
+             * Assume all files that are not Icon source go to linker.
+             */
+            addlib(argv[optind]);
+         }
+      optind++;
+      }
+ 
+   if (srclst == NULL)
+      usage();				/* error -- no files named */
+
+   if (pponly) {
+      if (trans() == 0)
+	 exit (EXIT_FAILURE);
+      else
+	 exit (EXIT_SUCCESS);
+      }
+
+   if (ofile == NULL)  {		/* if no -o file, synthesize a name */
+      if (strcmp(srclst->name,"-") == 0)
+         ofile = salloc(makename(buf,TargetDir,"stdin",ExecSuffix));
+      else
+         ofile = salloc(makename(buf,TargetDir,srclst->name,ExecSuffix));
+   } else {				/* add extension if necessary */
+      fp = fparse(ofile);
+      if (*fp->ext == '\0' && *ExecSuffix != '\0')
+         ofile = salloc(makename(buf,NULL,ofile,ExecSuffix));
+   }
+
+   /*
+    * Make name of intermediate C files.
+    */
+   cfile = salloc(makename(buf,TargetDir,ofile,CSuffix));
+   hfile = salloc(makename(buf,TargetDir,ofile,HSuffix));
+
+   codefile = open_out(cfile);
+   fprintf(codefile, "#include \"%s\"\n", hfile);
+
+   inclfile = open_out(hfile);
+   fprintf(inclfile, "#define COMPILER 1\n");
+
+   incl_path = (char *)alloc((unsigned int)(strlen(refpath) +
+       strlen(incl_file) + 1));
+   strcpy(incl_path, refpath);
+   strcat(incl_path, incl_file);
+   fprintf(inclfile,"#include \"%s\"\n", incl_path);
+
+   /*
+    * Translate .icn files to make C file.
+    */
+   if ((verbose > 0) && !just_type_trace)
+      report("Translating to C");
+
+   errors = trans();
+   if ((errors > 0) || just_type_trace) {	/* exit if errors seen */
+      rmfile(cfile);
+      rmfile(hfile);
+      if (errors > 0)
+	 exit(EXIT_FAILURE);
+      else exit(EXIT_SUCCESS);
+      }
+
+   fclose(codefile);
+   fclose(inclfile);
+
+   /*
+    * Compile and link C file.
+    */
+   if (no_c_comp)			/* exit if no C compile wanted */
+      exit(EXIT_SUCCESS);
+
+   if (verbose > 0)
+      report("Compiling and linking C code");
+
+   ret_code = ccomp(cfile, ofile);
+   if (ret_code == EXIT_FAILURE) {
+      fprintf(stderr, "*** C compile and link failed ***\n");
+      rmfile(ofile);
+      }
+
+   /*
+    * Finish by removing C files.
+    */
+   rmfile(cfile);
+   rmfile(hfile);
+   rmfile(makename(buf,TargetDir,cfile,ObjSuffix));
+
+   if (ret_code == EXIT_SUCCESS && optind < argc)  {
+      if (verbose > 0)
+         report("Executing");
+      execute (ofile, argv+optind+1);
+      }
+
+   return ret_code;
+   }
+
+/*
+ * execute - execute compiled Icon program
+ */
+static void execute(ofile,args)
+char *ofile, **args;
+   {
+
+   int n;
+   char **argv, **p;
+   char buf[MaxPath];			/* file name construction buffer */
+
+   ofile = salloc(makename(buf,"./",ofile,ExecSuffix));
+
+   for (n = 0; args[n] != NULL; n++)	/* count arguments */
+      ;
+   p = argv = (char **)alloc((unsigned int)((n + 2) * sizeof(char *)));
+
+   *p++ = ofile;			/* set executable file */
+
+   while (*p++ = *args++)		/* copy args into argument vector */
+      ;
+   *p = NULL;
+
+   execvp(ofile,argv);
+   quitf("could not run %s",ofile);
+   }
+
+/*
+ * Report phase.
+ */
+static void report(s)
+char *s;
+   {
+   fprintf(stderr,"%s:\n",s);
+   }
+
+/*
+ * rmfile - remove a file
+ */
+
+static void rmfile(fname)
+char *fname;
+   {
+   remove(fname);
+   }
+
+/*
+ * open_out - open a C output file and write identifying information
+ *  to the front.
+ */
+static FILE *open_out(fname)
+char *fname;
+   {
+   FILE *f;
+   static char *ident = "/*ICONC*/";
+   int c;
+   int i;
+
+   /*
+    * If the file already exists, make sure it is old output from iconc
+    *   before overwriting it. Note, this test doesn't work if the file
+    *   is writable but not readable.
+    */
+   f = fopen(fname, "r");
+   if (f != NULL) {
+      for (i = 0; i < (int)strlen(ident); ++i) {
+         c = getc(f);
+         if (c == EOF)
+             break;
+         if ((char)c != ident[i])
+            quitf("%s not in iconc format; rename or delete, and rerun", fname);
+         }
+      fclose(f);
+      }
+
+   f = fopen(fname, "w");
+   if (f == NULL)
+      quitf("cannot create %s", fname);
+   fprintf(f, "%s\n", ident); /* write "belongs to iconc" comment */
+   id_comment(f);             /* write detailed comment for human readers */
+   fflush(f);
+   return f;
+   }
+
+/*
+ * Print an error message if called incorrectly.  The message depends
+ *  on the legal options for this system.
+ */
+static void usage()
+   {
+   fprintf(stderr,"usage: %s %s file ... [-x args]\n", progname, CUsage);
+   exit(EXIT_FAILURE);
+   }
diff --git a/src/iconc/cmem.c b/src/iconc/cmem.c
new file mode 100644
index 0000000..720a495
--- /dev/null
+++ b/src/iconc/cmem.c
@@ -0,0 +1,114 @@
+/*
+ * cmem.c -- memory initialization and allocation for the translator.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+
+struct centry *chash[CHSize];		/* hash area for constant table */
+struct fentry *fhash[FHSize];		/* hash area for field table */
+struct gentry *ghash[GHSize];		/* hash area for global table */
+
+struct implement *bhash[IHSize];	/* hash area for built-in functions */
+struct implement *khash[IHSize];	/* hash area for keywords */
+struct implement *ohash[IHSize];	/* hash area for operators */
+
+struct implement *spec_op[NumSpecOp];	/* table of ops with special syntax */
+
+char pre[PrfxSz] = {'0', '0', '0'};     /* initial function name prefix */
+
+extern struct str_buf lex_sbuf;
+
+
+/*
+ * init - initialize memory for the translator
+ */
+
+void init()
+{
+   int i;
+
+   init_str();
+   init_sbuf(&lex_sbuf);
+
+   /*
+    * Zero out the hash tables.
+    */
+   for (i = 0; i < CHSize; i++)
+      chash[i] = NULL;
+   for (i = 0; i < FHSize; i++)
+      fhash[i] = NULL;
+   for (i = 0; i < GHSize; i++)
+      ghash[i] = NULL;
+   for (i = 0; i < IHSize; i++) {
+      bhash[i] = NULL;
+      khash[i] = NULL;
+      ohash[i] = NULL;
+      }
+
+   /*
+    * Clear table of operators with non-standard operator syntax.
+    */
+   for (i = 0; i < NumSpecOp; ++i)
+      spec_op[i] = NULL;
+   }
+
+/*
+ * init_proc - add a new entry on front of procedure list.
+ */
+void init_proc(name)
+char *name;
+   {
+   register struct pentry *p;
+   int i;
+   struct gentry *sym_ent;
+
+   p = NewStruct(pentry);
+   p->name = name;
+   nxt_pre(p->prefix, pre, PrfxSz);
+   p->prefix[PrfxSz] = '\0';
+   p->nargs = 0;
+   p->args = NULL;
+   p->ndynam = 0;
+   p->dynams = NULL;
+   p->nstatic = 0;
+   p->has_coexpr = 0;
+   p->statics = NULL;
+   p->ret_flag = DoesRet | DoesFail | DoesSusp; /* start out pessimistic */
+   p->arg_lst = 0;
+   p->lhash = 
+     (struct lentry **)alloc((unsigned int)((LHSize)*sizeof(struct lentry *)));
+   for (i = 0; i < LHSize; i++)
+      p->lhash[i] = NULL;
+   p->next = proc_lst;
+   proc_lst = p;
+   sym_ent = instl_p(name, F_Proc);
+   sym_ent->val.proc = proc_lst;
+   }
+
+/*
+ * init_rec - add a new entry on the front of the record list.
+ */
+void init_rec(name)
+char *name;
+   {
+   register struct rentry *r;
+   struct gentry *sym_ent;
+   static int rec_num = 0;
+
+   r = NewStruct(rentry);
+   r->name = name;
+   nxt_pre(r->prefix, pre, PrfxSz);
+   r->prefix[PrfxSz] = '\0';
+   r->rec_num = rec_num++;
+   r->nfields = 0;
+   r->fields = NULL;
+   r->next = rec_lst;
+   rec_lst = r;
+   sym_ent= instl_p(name, F_Record);
+   sym_ent->val.rec = r;
+   }
diff --git a/src/iconc/codegen.c b/src/iconc/codegen.c
new file mode 100644
index 0000000..8ca5bd1
--- /dev/null
+++ b/src/iconc/codegen.c
@@ -0,0 +1,1918 @@
+/*
+ * codegen.c - routines to write out C code.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "csym.h"
+#include "ccode.h"
+#include "ctree.h"
+#include "cproto.h"
+
+#ifndef LoopThreshold
+#define LoopThreshold 7
+#endif					/* LoopThreshold */
+
+/*
+ * MinOne - arrays sizes must be at least 1.
+ */
+#define MinOne(n) ((n) > 0 ? (n) : 1)
+
+/*
+ * ChkSeqNum - make sure a label has been given a sequence number.
+ */
+#define ChkSeqNum(x) if ((x)->SeqNum == 0) (x)->SeqNum = ++lbl_seq_num
+
+/*
+ * ChkBound - for a given procedure, signals that transfer control to a
+ *  bounding label all use the same signal number.
+ */
+#define ChkBound(x) (((x)->LabFlg & Bounding) ? bound_sig : (x))
+
+/*
+ * When a switch statement for signal handling is optimized, there
+ *  are three possible forms of default clauses.
+ */
+#define DfltNone    0   /* no default clause */
+#define DfltBrk     1   /* default is just a break */
+#define DfltRetSig  2   /* default is to return the signal from the call */
+
+/*
+ * Prototypes for static functions.
+ */
+static int     arg_nms   (struct lentry *lptr, int prt);
+static void bi_proc   (char *name, struct implement *ip);
+static void chkforgn  (int outer);
+static int     dyn_nms   (struct lentry *lptr, int prt);
+static void fldnames  (struct fldname *fields);
+static void fnc_blk   (struct gentry *gptr);
+static void frame     (int outer);
+static void good_clsg (struct code *call, int outer);
+static void initpblk  (FILE *f, int c, char *prefix, char *name,
+                           int nquals, int nparam, int ndynam, int nstatic,
+                           int frststat);
+static char  *is_builtin (struct gentry *gptr);
+static void proc_blk  (struct gentry *gptr, int init_glbl);
+static void prt_ary   (struct code *cd, int outer);
+static void prt_cond  (struct code *cond);
+static void prt_cont  (struct c_fnc *cont);
+static void prt_var   (struct lentry *var, int outer);
+static void prtcall   (struct code *call, int outer);
+static void prtcode   (struct code *cd, int outer);
+static void prtpccall (int outer);
+static void rec_blk   (struct gentry *gptr, int init_glbl);
+static void smpl_clsg (struct code *call, int outer);
+static void stat_nms  (struct lentry *lptr, int prt);
+static void val_loc   (struct val_loc *rslt, int outer);
+
+static int n_stat = -1;		/* number of static variables */
+
+/*
+ * var_dcls - produce declarations necessary to implement variables
+ *  and to initialize globals and statics: procedure blocks, procedure
+ *  frames, record blocks, declarations for globals and statics, the
+ *  C main program.
+ */
+void var_dcls()
+   {
+   register int i;
+   register struct gentry *gptr;
+   struct gentry *gbl_main;
+   struct pentry *prc_main;
+   int n_glob = 0;
+   int flag;
+   int init_glbl;
+   int first;
+   char *pfx;
+
+   /*
+    * Output initialized array of descriptors for globals.
+    */
+   fprintf(codefile, "\nstatic struct {word dword; union block *vword;}");
+   fprintf(codefile, " init_globals[NGlobals] = {\n");
+   prc_main = NULL;
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag & ~(F_Global | F_StrInv);
+         if (strcmp(gptr->name, "main") == 0 && (gptr->flag & F_Proc)) {
+            /*
+             * Remember main procedure.
+             */
+            gbl_main = gptr;
+            prc_main = gbl_main->val.proc;
+            }
+         if (flag == 0) {
+            /*
+             * Ordinary variable.
+             */
+            gptr->index = n_glob++;
+            fprintf(codefile, "   {D_Null},\n");
+            }
+         else {
+            /*
+             * Procedure, function, or record constructor. If the variable
+             *  has not been optimized away, initialize the it to reference
+             *  the procedure block.
+             */
+            if (flag & F_SmplInv) {
+               init_glbl = 0;
+               flag &= ~(uword)F_SmplInv;
+               }
+            else {
+               init_glbl = 1;
+               gptr->index = n_glob++;
+               fprintf(codefile, "   {D_Proc, ");
+               }
+            switch (flag) {
+               case F_Proc:
+                  proc_blk(gptr, init_glbl);
+                  break;
+               case F_Builtin:
+                  if (init_glbl)
+                     fnc_blk(gptr);
+                  break;
+               case F_Record:
+                  rec_blk(gptr, init_glbl);
+               }
+            }
+         }
+   if (n_glob == 0)
+      fprintf(codefile, "   {D_Null} /* place holder */\n");
+   fprintf(codefile, "   };\n");
+
+   if (prc_main == NULL) {
+      nfatal(NULL, "main procedure missing", NULL);
+      return;
+      }
+
+   /*
+    * Output array of descriptors initialized to the names of the
+    *  global variables that have not been optimized away.
+    */
+   if (n_glob == 0)
+      fprintf(codefile, "\nstruct sdescrip init_gnames[1];\n");
+   else {
+      fprintf(codefile, "\nstruct sdescrip init_gnames[NGlobals] = {\n");
+      for (i = 0; i < GHSize; i++)
+         for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink)
+            if (!(gptr->flag & F_SmplInv))
+               fprintf(codefile, "   {%d, \"%s\"},\n", strlen(gptr->name),
+                  gptr->name);
+         fprintf(codefile, "   };\n");
+      }
+
+   /*
+    * Output array of pointers to builtin functions that correspond to
+    *  names of the global variables.
+    */
+   if (n_glob == 0)
+      fprintf(codefile, "\nstruct b_proc *builtins[1];\n");
+   else {
+      fprintf(codefile, "\nstruct b_proc *builtins[NGlobals] = {\n");
+      for (i = 0; i < GHSize; i++)
+         for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink)
+            if (!(gptr->flag & F_SmplInv)) {  
+               /*
+                * Need to output *something* to stay in step with other arrays.
+                */
+               if (pfx = is_builtin(gptr)) {
+                  fprintf(codefile, "   (struct b_proc *)&BF%c%c_%s,\n",
+                     pfx[0], pfx[1], gptr->name);
+                  }
+               else
+                  fprintf(codefile, "   0,\n");
+               }
+         fprintf(codefile, "   };\n");
+      }
+
+   /*
+    * Output C main function that initializes the run-time system and
+    *  calls the main procedure.
+    */
+   fprintf(codefile, "\n");
+   fprintf(codefile, "int main(argc, argv)\n");
+   fprintf(codefile, "int argc;\n");
+   fprintf(codefile, "char **argv;\n");
+   fprintf(codefile, "   {\n");
+
+   /*
+    *  If the main procedure requires a command-line argument list, we
+    *  need a place to construct the Icon argument list.
+    */
+   if (prc_main->nargs != 0 || !(gbl_main->flag & F_SmplInv)) {
+      fprintf(codefile, "   struct {\n");
+      fprintf(codefile, "      struct tend_desc *previous;\n");
+      fprintf(codefile, "      int num;\n");
+      fprintf(codefile, "      struct descrip arg_lst;\n");
+      fprintf(codefile, "      } t;\n");
+      fprintf(codefile, "\n");
+      }
+
+   /*
+    * Produce code to initialize run-time system variables. Some depend
+    *  on compiler options.
+    */
+   fprintf(codefile, "   op_tbl = (struct b_proc *)init_op_tbl;\n");
+   fprintf(codefile, "   globals = (dptr)init_globals;\n");
+   fprintf(codefile, "   eglobals = &globals[%d];\n", n_glob);
+   fprintf(codefile, "   gnames = (dptr)init_gnames;\n");
+   fprintf(codefile, "   egnames = &gnames[%d];\n", n_glob);
+   fprintf(codefile, "   estatics = &statics[%d];\n", n_stat + 1);
+   if (debug_info)
+      fprintf(codefile, "   debug_info = 1;\n");
+   else
+      fprintf(codefile, "   debug_info = 0;\n");
+   if (line_info) {
+      fprintf(codefile, "   line_info = 1;\n");
+      fprintf(codefile, "   file_name = \"\";\n");
+      fprintf(codefile, "   line_num = 0;\n");
+      }
+   else
+      fprintf(codefile, "   line_info = 0;\n");
+   if (err_conv)
+      fprintf(codefile, "   err_conv = 1;\n");
+   else
+      fprintf(codefile, "   err_conv = 0;\n");
+   if (largeints)
+      fprintf(codefile, "   largeints = 1;\n");
+   else
+      fprintf(codefile, "   largeints = 0;\n");
+
+   /*
+    * Produce code to call the routine to initialize the runtime system.
+    */
+   if (trace)
+      fprintf(codefile, "   init(*argv, &argc, argv, -1);\n");
+   else
+      fprintf(codefile, "   init(*argv, &argc, argv, 0);\n");
+   fprintf(codefile, "\n");
+
+   /*
+    * If the main procedure requires an argument list (perhaps because
+    *  it uses standard, rather than tailored calling conventions),
+    *  set up the argument list.
+    */
+   if (prc_main->nargs != 0 || !(gbl_main->flag & F_SmplInv)) {
+      fprintf(codefile, "   t.arg_lst = nulldesc;\n");
+      fprintf(codefile, "   t.num = 1;\n");
+      fprintf(codefile, "   t.previous = NULL;\n");
+      fprintf(codefile, "   tend = (struct tend_desc *)&t;\n");
+      if (prc_main->nargs == 0)
+         fprintf(codefile,
+            "   /* main() takes no arguments: construct no list */\n"); 
+      else
+         fprintf(codefile, "   cmd_line(argc, argv, &t.arg_lst);\n");
+      fprintf(codefile, "\n");
+      }
+   else
+      fprintf(codefile, "   tend = NULL;\n");
+
+   if (gbl_main->flag & F_SmplInv) {
+      /*
+       * procedure main only has a simplified implementation if it
+       *  takes either 0 or 1 argument.
+       */
+      first = 1;
+      if (prc_main->nargs == 0)
+         fprintf(codefile, "   P%s_main(", prc_main->prefix);
+      else {
+         fprintf(codefile, "   P%s_main(&t.arg_lst", prc_main->prefix);
+         first = 0;
+         }
+      if (prc_main->ret_flag & (DoesRet | DoesSusp)) {
+         if (!first)
+            fprintf(codefile, ", ");
+         fprintf(codefile, "&trashcan");
+         first = 0;
+         }
+      if (prc_main->ret_flag & DoesSusp)
+         fprintf(codefile, ", (continuation)NULL");
+      fprintf(codefile, ");\n");
+      }
+   else /* the main procedure uses standard calling conventions */
+      fprintf(codefile,
+         "   P%s_main(1, &t.arg_lst, &trashcan, (continuation)NULL);\n",
+         prc_main->prefix);
+   fprintf(codefile, "   \n");
+   fprintf(codefile, "   c_exit(EXIT_SUCCESS);\n");
+   fprintf(codefile, "   }\n");
+
+   /*
+    * Output to header file definitions related to global and static
+    *  variables.
+    */
+   fprintf(inclfile, "\n");
+   if (n_glob == 0) {
+      fprintf(inclfile, "#define NGlobals 1\n");
+      fprintf(inclfile, "int n_globals = 0;\n");
+      }
+   else {
+      fprintf(inclfile, "#define NGlobals %d\n", n_glob);
+      fprintf(inclfile, "int n_globals = NGlobals;\n");
+      }
+   ++n_stat;
+   fprintf(inclfile, "\n");
+   fprintf(inclfile, "int n_statics = %d;\n", n_stat);
+   fprintf(inclfile, "struct descrip statics[%d]", MinOne(n_stat));
+   if (n_stat > 0)  {
+      fprintf(inclfile, " = {\n");
+      for (i = 0; i < n_stat; ++i)
+         fprintf(inclfile, "   {D_Null},\n");
+      fprintf(inclfile, "   };\n");
+      }
+   else
+      fprintf(inclfile, ";\n");
+   }
+
+/*
+ * proc_blk - create procedure block and initialize global variable, also
+ *   compute offsets for local procedure variables.
+ */
+static void proc_blk(gptr, init_glbl)
+struct gentry *gptr;
+int init_glbl;
+   {
+   struct pentry *p;
+   register char *name;
+   int nquals;
+
+   name = gptr->name;
+   p = gptr->val.proc;
+
+   /*
+    * If we don't initialize a global variable for this procedure, we
+    *  need only compute offsets for variables.
+    */
+   if (init_glbl) {
+      fprintf(codefile, "(union block *)&BP%s_%s},\n", p->prefix, name);
+      nquals = 1 + Abs(p->nargs) + p->ndynam + p->nstatic;
+      fprintf(inclfile, "\n");
+      fprintf(inclfile, "static int P%s_%s (int r_nargs, dptr r_args,",
+         p->prefix, name);
+      fprintf(inclfile, "dptr r_rslt, continuation r_s_cont);\n");
+      initpblk(inclfile, 'P', p->prefix, name, nquals, p->nargs, p->ndynam,
+         p->nstatic, n_stat + 1);
+      fprintf(inclfile, "\n   {%d, \"%s\"},\n", strlen(name), name);
+      }
+   arg_nms(p->args, init_glbl);
+   p->tnd_loc = dyn_nms(p->dynams, init_glbl);
+   stat_nms(p->statics, init_glbl);
+   if (init_glbl)
+      fprintf(inclfile, "   }};\n");
+   }
+
+/*
+ * arg_nms - compute offsets of arguments and, if needed, output the
+ *  initializer for a descriptor for the argument name.
+ */
+static int arg_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   register int n;
+
+   if (lptr == NULL)
+      return 0;
+   n = arg_nms(lptr->next, prt);
+   lptr->val.index = n;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   return n + 1;
+   }
+
+/*
+ * dyn_nms - compute offsets of dynamic locals and, if needed, output the
+ *  initializer for a descriptor for the variable name.
+ */
+static int dyn_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   register int n;
+
+   if (lptr == NULL)
+      return 0;
+   n = dyn_nms(lptr->next, prt);
+   lptr->val.index = n;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   return n + 1;
+   }
+
+/*
+ * stat_nams - compute offsets of static locals and, if needed, output the
+ *  initializer for a descriptor for the variable name.
+ */
+static void stat_nms(lptr, prt)
+struct lentry *lptr;
+int prt;
+   {
+   if (lptr == NULL)
+      return;
+   stat_nms(lptr->next, prt);
+   lptr->val.index = ++n_stat;
+   if (prt)
+      fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(lptr->name), lptr->name);
+   }
+
+/*
+ * is_builtin - check if a global names or hides a builtin, returning prefix.
+ *  If it hides one, we must also generate the prototype and block here.
+ */
+static char *is_builtin(gptr)
+struct gentry *gptr;
+   {
+   struct implement *iptr;
+
+   if (!(gptr->flag & F_StrInv))	/* if not eligible for string invoc */
+      return 0;
+   if (gptr->flag & F_Builtin)		/* if global *is* a builtin */
+      return gptr->val.builtin->prefix;
+   iptr = db_ilkup(gptr->name, bhash);
+   if (iptr == NULL)			/* if no builtin by this name */
+      return NULL;
+   bi_proc(gptr->name, iptr);		/* output prototype and proc block */
+   return iptr->prefix;
+   }
+
+/*
+ * fnc_blk - output vword of descriptor for a built-in function and its
+ *   procedure block.
+ */
+static void fnc_blk(gptr)
+struct gentry *gptr;
+   {
+   struct implement *iptr;
+   char *name, *pfx;
+   
+   name = gptr->name;
+   iptr = gptr->val.builtin;
+   pfx = iptr->prefix;
+   /*
+    * output prototype and procedure block to inclfile.
+    */
+   bi_proc(name, iptr);
+   /*
+    * vword of descriptor references the procedure block.
+    */
+   fprintf(codefile, "(union block *)&BF%c%c_%s}, \n", pfx[0], pfx[1], name);
+   }
+
+/*
+ * bi_proc - output prototype and procedure block for builtin function.
+ */
+static void bi_proc(name, ip)
+char *name;
+   struct implement *ip;
+   {
+   int nargs;
+   char prefix[3];
+
+   prefix[0] = ip->prefix[0];
+   prefix[1] = ip->prefix[1];
+   prefix[2] = '\0';
+   nargs = ip->nargs;
+   if (nargs > 0 && ip->arg_flgs[nargs - 1] & VarPrm)
+      nargs = -nargs;
+   fprintf(inclfile, "\n");
+   implproto(ip);
+   initpblk(inclfile, 'F', prefix, name, 1, nargs, -1, 0, 0);
+   fprintf(inclfile, "{%d, \"%s\"}}};\n", strlen(name), name);
+   }
+
+/*
+ * rec_blk - if needed, output vword of descriptor for a record
+ *   constructor and output its procedure block.
+ */
+static void rec_blk(gptr, init_glbl)
+struct gentry *gptr;
+int init_glbl;
+   {
+   struct rentry *r;
+   register char *name;
+   int nfields;
+
+   name = gptr->name;
+   r = gptr->val.rec;
+   nfields = r->nfields;
+
+   /*
+    * If the variable is not optimized away, output vword of descriptor.
+    */
+   if (init_glbl)
+      fprintf(codefile, "(union block *)&BR%s_%s},\n", r->prefix, name);
+
+   fprintf(inclfile, "\n");
+   /*
+    * Prototype for C function implementing constructor. If no optimizations
+    *   have been performed on the variable, the standard calling conventions
+    *   are used and we need a continuation parameter.
+    */
+   fprintf(inclfile,
+      "static int R%s_%s (int r_nargs, dptr r_args, dptr r_rslt",
+      r->prefix, name);
+   if (init_glbl)
+      fprintf(inclfile, ", continuation r_s_cont");
+   fprintf(inclfile, ");\n");
+
+   /*
+    * Procedure block, including record name and field names.
+    */
+   initpblk(inclfile, 'R', r->prefix, name, nfields + 1, nfields, -2,
+      r->rec_num, 1);
+   fprintf(inclfile, "\n   {%d, \"%s\"},\n", strlen(name), name);
+   fldnames(r->fields);
+   fprintf(inclfile, "   }};\n");
+   }
+
+
+/*
+ * fldnames - output the initializer for a descriptor for the field name.
+ */
+static void fldnames(fields)
+struct fldname *fields;
+   {
+   register char *name;
+
+   if (fields == NULL)
+      return;
+   fldnames(fields->next);
+   name = fields->name;
+   fprintf(inclfile, "   {%d, \"%s\"},\n", strlen(name), name);
+   }
+
+/*
+ * implproto - print prototype for function implementing a run-time operation.
+ */
+void implproto(ip)
+struct implement *ip;
+   {
+   if (ip->iconc_flgs & ProtoPrint)
+      return;    /* only print prototype once */
+   fprintf(inclfile, "int %c%c%c_%s ", ip->oper_typ, ip->prefix[0],
+       ip->prefix[1], ip->name);
+   fprintf(inclfile, "(int r_nargs, dptr r_args, dptr r_rslt, ");
+   fprintf(inclfile,"continuation r_s_cont);\n");
+   ip->iconc_flgs |= ProtoPrint;
+   }
+
+/*
+ * const_blks - output blocks for cset and real constants.
+ */
+void const_blks()
+   {
+   register int i;
+   register struct centry *cptr;
+
+   fprintf(inclfile, "\n");
+   for (i = 0; i < CHSize; i++)
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr->blink) {
+         switch (cptr->flag) {
+            case F_CsetLit:
+               nxt_pre(cptr->prefix, pre, PrfxSz);
+               cptr->prefix[PrfxSz] = '\0';
+               fprintf(inclfile, "struct b_cset BDC%s = ", cptr->prefix);
+               cset_init(inclfile, cptr->u.cset);
+               break;
+            case F_RealLit:
+               nxt_pre(cptr->prefix, pre, PrfxSz);
+               cptr->prefix[PrfxSz] = '\0';
+               fprintf(inclfile, "struct b_real BDR%s = {T_Real, %s};\n",
+                   cptr->prefix, cptr->image);
+               break;
+            }
+         }
+   }
+
+/*
+ * reccnstr - output record constructors.
+ */
+void recconstr(r)
+struct rentry *r;
+   {
+   register char *name;
+   int optim;
+   int nfields;
+
+   if (r == NULL)
+      return;
+   recconstr(r->next);
+
+   name = r->name;
+   nfields = r->nfields;
+
+   /*
+    * Does this record constructor use optimized calling conventions?
+    */
+   optim = glookup(name)->flag & F_SmplInv;
+
+   fprintf(codefile, "\n");
+   fprintf(codefile, "static int R%s_%s(r_nargs, r_args, r_rslt", r->prefix,
+      name);
+   if (!optim)
+      fprintf(codefile, ", r_s_cont");  /* continuation is passed */
+   fprintf(codefile, ")\n");
+   fprintf(codefile, "int r_nargs;\n");
+   fprintf(codefile, "dptr r_args;\n");
+   fprintf(codefile, "dptr r_rslt;\n");
+   if (!optim)
+      fprintf(codefile, "continuation r_s_cont;\n");
+   fprintf(codefile, "   {\n");
+   fprintf(codefile, "   register int i;\n");
+   fprintf(codefile, "   register struct b_record *rp;\n");
+   fprintf(codefile, "\n");
+   fprintf(codefile, "   rp = alcrecd(%d, (union block *)&BR%s_%s);\n",
+      nfields, r->prefix, name);
+   fprintf(codefile, "   if (rp == NULL) {\n");
+   fprintf(codefile, "      err_msg(307, NULL);\n");
+   if (err_conv)
+      fprintf(codefile, "      return A_Resume;\n");
+   fprintf(codefile, "      }\n");
+   fprintf(codefile, "   for (i = %d; i >= 0; i--)\n", nfields - 1);
+   fprintf(codefile, "      if (i < r_nargs)\n");
+   fprintf(codefile, "         deref(&r_args[i], &rp->fields[i]);\n");
+   fprintf(codefile, "      else\n");
+   fprintf(codefile, "         rp->fields[i] = nulldesc;\n");
+   fprintf(codefile, "   r_rslt->vword.bptr = (union block *)rp;\n");
+   fprintf(codefile, "   r_rslt->dword = D_Record;\n");
+   fprintf(codefile, "   return A_Continue;\n");
+   fprintf(codefile, "   }\n");
+   }
+
+/*
+ * outerfnc - output code for the outer function implementing a procedure.
+ */
+void outerfnc(fnc)
+struct c_fnc *fnc;
+   {
+   char *prefix;
+   char *name;
+   char *cnt_var;
+   char *sep;
+   int ntend;
+   int first_arg;
+   int nparms;
+   int optim; /* optimized interface: no arg list adjustment */
+   int ret_flag;
+#ifdef OptimizeLoop
+   int i;
+#endif					/* OptimizeLoop */
+
+   prefix = cur_proc->prefix;
+   name = cur_proc->name;
+   ntend = cur_proc->tnd_loc + num_tmp;
+   ChkPrefix(fnc->prefix);
+   optim = glookup(name)->flag & F_SmplInv;
+   nparms = Abs(cur_proc->nargs);
+   ret_flag = cur_proc->ret_flag;
+
+   fprintf(codefile, "\n");
+   if (optim) {
+      /*
+       * Arg list adjustment and dereferencing are done at call site.
+       *  Use simplified interface. Output both function header and
+       *  prototype.
+       */
+      sep = "";
+      fprintf(inclfile, "static int P%s_%s (", prefix, name);
+      fprintf(codefile, "static int P%s_%s(", prefix, name);
+      if (nparms != 0) {
+         fprintf(inclfile, "dptr r_args");
+         fprintf(codefile, "r_args");
+         sep = ", ";
+         }
+      if (ret_flag & (DoesRet | DoesSusp)) {
+         fprintf(inclfile, "%sdptr r_rslt", sep);
+         fprintf(codefile, "%sr_rslt", sep);
+         sep = ", ";
+         }
+      if (ret_flag & DoesSusp) {
+         fprintf(inclfile, "%scontinuation r_s_cont", sep);
+         fprintf(codefile, "%sr_s_cont", sep);
+         sep = ", ";
+         }
+      if (*sep == '\0')
+         fprintf(inclfile, "void");
+      fprintf(inclfile, ");\n");
+      fprintf(codefile, ")\n");
+      if (nparms != 0)
+         fprintf(codefile, "dptr r_args;\n");
+      if (ret_flag & (DoesRet | DoesSusp))
+         fprintf(codefile, "dptr r_rslt;\n");
+      if (ret_flag & DoesSusp)
+         fprintf(codefile, "continuation r_s_cont;\n");
+      }
+   else {
+      /*
+       * General invocation interface. Output function header; prototype has
+       *  already been produced.
+       */
+      fprintf(codefile,
+         "static int P%s_%s(r_nargs, r_args, r_rslt, r_s_cont)\n", prefix,
+         name);
+      fprintf(codefile, "int r_nargs;\n");
+      fprintf(codefile, "dptr r_args;\n");
+      fprintf(codefile, "dptr r_rslt;\n");
+      fprintf(codefile, "continuation r_s_cont;\n");
+      }
+
+   fprintf(codefile, "{\n");
+   fprintf(codefile, "   struct PF%s_%s r_frame;\n", prefix, name);
+   fprintf(codefile, "   register int r_signal;\n");
+   fprintf(codefile, "   int i;\n");
+   if (Type(Tree1(cur_proc->tree)) != N_Empty)
+      fprintf(codefile, "   static int first_time = 1;");
+   fprintf(codefile, "\n");
+   fprintf(codefile, "   r_frame.old_pfp = pfp;\n");
+   fprintf(codefile, "   pfp = (struct p_frame *)&r_frame;\n");
+   fprintf(codefile, "   r_frame.old_argp = glbl_argp;\n");
+   if (!optim || ret_flag & (DoesRet | DoesSusp))
+      fprintf(codefile, "   r_frame.rslt = r_rslt;\n");
+   else
+      fprintf(codefile, "   r_frame.rslt = NULL;\n");
+   if (!optim || ret_flag & DoesSusp)
+      fprintf(codefile, "   r_frame.succ_cont = r_s_cont;\n");
+   else
+      fprintf(codefile, "   r_frame.succ_cont = NULL;\n");
+   fprintf(codefile, "\n");
+#ifdef OptimizeLoop
+   if (ntend > 0)  {
+      if (ntend < LoopThreshold)
+         for (i=0; i < ntend ;i++)  
+            fprintf(codefile, "   r_frame.tend.d[%d] = nulldesc;\n", i);
+      else {
+         fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", ntend);
+         fprintf(codefile, "      r_frame.tend.d[i] = nulldesc;\n");
+      }
+   }
+#else					/* OptimizeLoop */
+   fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", ntend);
+   fprintf(codefile, "      r_frame.tend.d[i] = nulldesc;\n");
+#endif					/* OptimizeLoop */
+   if (optim) {
+      /*
+       * Dereferencing and argument list adjustment is done at the call
+       *  site. There is not much to do here.
+       */
+      if (nparms == 0)
+         fprintf(codefile, "   glbl_argp = NULL;\n");
+      else
+         fprintf(codefile, "   glbl_argp = r_args;\n");
+      }
+   else {
+      /*
+       * Dereferencing and argument list adjustment must be done by
+       *  the procedure itself.
+       */
+      first_arg = ntend;
+      ntend += nparms;
+      if (cur_proc->nargs < 0) {
+         /*
+          * varargs - construct a list into the last argument.
+          */
+         nparms -= 1;
+         if (nparms == 0)
+            cnt_var = "r_nargs";
+         else {
+            fprintf(codefile, "   i = r_nargs - %d;\n", nparms);
+            cnt_var = "i";
+            }
+         fprintf(codefile,"   if (%s <= 0)\n", cnt_var);
+         fprintf(codefile,"       varargs(NULL, 0, &r_frame.tend.d[%d]);\n",
+            first_arg + nparms);
+         fprintf(codefile,"   else\n");
+         fprintf(codefile,
+            "       varargs(&r_args[%d], %s, &r_frame.tend.d[%d]);\n", nparms,
+            cnt_var, first_arg + nparms);
+         }
+      if (nparms > 0) {
+         /*
+          * Output code to dereference argument or supply default null
+          *  value.
+          */
+#ifdef OptimizeLoop
+         fprintf(codefile, "   for (i = 0; i < r_nargs ; ++i)\n");
+         fprintf(codefile, "      deref(&r_args[i], &r_frame.tend.d[i + %d]);\n",  first_arg);
+         fprintf(codefile, "   for(i = r_nargs; i < %d ; ++i)\n", nparms);
+         fprintf(codefile, "      r_frame.tend.d[i + %d] = nulldesc;\n",
+            first_arg);
+#else					/* OptimizeLoop */
+         fprintf(codefile, "   for (i = 0; i < %d; ++i)\n", nparms);
+         fprintf(codefile, "      if (i < r_nargs)\n");
+         fprintf(codefile,
+            "         deref(&r_args[i], &r_frame.tend.d[i + %d]);\n",
+            first_arg);
+         fprintf(codefile, "      else\n");
+         fprintf(codefile, "         r_frame.tend.d[i + %d] = nulldesc;\n",
+            first_arg);
+#endif					/* OptimizeLoop */
+         }
+      fprintf(codefile, "   glbl_argp = &r_frame.tend.d[%d];\n", first_arg);
+      }
+   fprintf(codefile, "   r_frame.tend.num = %d;\n", ntend);
+   fprintf(codefile, "   r_frame.tend.previous = tend;\n");
+   fprintf(codefile, "   tend = (struct tend_desc *)&r_frame.tend;\n");
+   if (line_info) {
+      fprintf(codefile, "   r_frame.debug.old_line = line_num;\n");
+      fprintf(codefile, "   r_frame.debug.old_fname = file_name;\n");
+      }
+   if (debug_info) {
+      fprintf(codefile, "   r_frame.debug.proc = (struct b_proc *)&BP%s_%s;\n",
+         prefix, name);
+      fprintf(codefile, "   if (k_trace) ctrace();\n");
+      fprintf(codefile, "   ++k_level;\n\n");
+      }
+   fprintf(codefile, "\n");
+
+   /*
+    * Output definition for procedure frame.
+    */
+   prt_frame(prefix, ntend, num_itmp, num_dtmp, num_sbuf, num_cbuf);
+
+   /*
+    * Output code to implement procedure body.
+    */
+   prtcode(&(fnc->cd), 1);
+   fprintf(codefile, "   }\n");
+   }
+
+/*
+ * prt_fnc - output C function that implements a continuation.
+ */
+void prt_fnc(fnc)
+struct c_fnc *fnc;
+   {
+   struct code *sig;
+   char *name;
+   char *prefix;
+
+   if (fnc->flag & CF_SigOnly) {
+      /*
+       * This function only returns a signal. A shared function is used in
+       *  its place. Make sure that function has been printed.
+       */
+      sig = fnc->cd.next->SigRef->sig;
+      if (sig->cd_id != C_Resume) {
+         sig = ChkBound(sig);
+         if (!(sig->LabFlg & FncPrtd)) {
+            ChkSeqNum(sig);
+            fprintf(inclfile, "static int sig_%d (void);\n",
+               sig->SeqNum);
+   
+            fprintf(codefile, "\n");
+            fprintf(codefile, "static int sig_%d()\n", sig->SeqNum);
+            fprintf(codefile, "   {\n");
+            fprintf(codefile, "   return %d; /* %s */\n", sig->SeqNum,
+               sig->Desc);
+            fprintf(codefile, "   }\n");
+            sig->LabFlg |= FncPrtd;
+            }
+         }
+      }
+   else {
+      ChkPrefix(fnc->prefix);
+      prefix = fnc->prefix;
+      name = cur_proc->name;
+   
+      fprintf(inclfile, "static int P%s_%s (void);\n", prefix, name);
+   
+      fprintf(codefile, "\n");
+      fprintf(codefile, "static int P%s_%s()\n", prefix, name);
+      fprintf(codefile, "   {\n");
+      if (fnc->flag & CF_Coexpr)
+         fprintf(codefile, "#ifdef Coexpr\n");
+   
+      prefix = fnc->frm_prfx;
+   
+      fprintf(codefile, "   register int r_signal;\n");
+      fprintf(codefile, "   register struct PF%s_%s *r_pfp;\n", prefix, name);
+      fprintf(codefile, "\n");
+      fprintf(codefile, "   r_pfp  = (struct PF%s_%s *)pfp;\n", prefix, name);
+      prtcode(&(fnc->cd), 0);
+      if (fnc->flag & CF_Coexpr) {
+         fprintf(codefile, "#else\t\t\t\t\t/* Coexpr */\n");
+         fprintf(codefile, "   fatalerr(401, NULL);\n");
+         fprintf(codefile, "#endif\t\t\t\t\t/* Coexpr */\n");
+         }
+      fprintf(codefile, "   }\n");
+      }
+   }
+
+/*
+ * prt_frame - output the definition for a procedure frame.
+ */
+void prt_frame(prefix, ntend, n_itmp, n_dtmp, n_sbuf, n_cbuf)
+char *prefix;
+int ntend;
+int n_itmp;
+int n_dtmp;
+int n_sbuf;
+int n_cbuf;
+   {
+   int i;
+
+   /*
+    * Output standard part of procedure frame including tended
+    *  descriptors.
+     */
+   fprintf(inclfile, "\n");
+   fprintf(inclfile, "struct PF%s_%s {\n", prefix, cur_proc->name);
+   fprintf(inclfile, "   struct p_frame *old_pfp;\n");
+   fprintf(inclfile, "   dptr old_argp;\n");
+   fprintf(inclfile, "   dptr rslt;\n");
+   fprintf(inclfile, "   continuation succ_cont;\n");
+   fprintf(inclfile, "   struct {\n");
+   fprintf(inclfile, "      struct tend_desc *previous;\n");
+   fprintf(inclfile, "      int num;\n");
+   fprintf(inclfile, "      struct descrip d[%d];\n", MinOne(ntend));
+   fprintf(inclfile, "      } tend;\n");
+
+   if (line_info) {       /* must be true if debug_info is true */
+      fprintf(inclfile, "   struct debug debug;\n");
+      }
+
+   /*
+    * Output declarations for the integer, double, string buffer,
+    *  and cset buffer work areas of the frame.
+    */
+   for (i = 0; i < n_itmp; ++i)
+      fprintf(inclfile, "   word i%d;\n", i);
+   for (i = 0; i < n_dtmp; ++i)
+      fprintf(inclfile, "   double d%d;\n", i);
+   if (n_sbuf > 0)
+      fprintf(inclfile, "   char sbuf[%d][MaxCvtLen];", n_sbuf);
+   if (n_cbuf > 0)
+      fprintf(inclfile, "   struct b_cset cbuf[%d];", n_cbuf);
+   fprintf(inclfile, "   };\n");
+   }
+
+/*
+ * prtcode - print a list of C code.
+ */
+static void prtcode(cd, outer)
+struct code *cd;
+int outer;
+   {
+   struct lentry *var;
+   struct centry *lit;
+   struct code *sig;
+   int n;
+
+   for ( ; cd != NULL; cd = cd->next) {
+      switch (cd->cd_id) {
+         case C_Null:
+            break;
+
+         case C_NamedVar:
+            /*
+             * Construct a reference to a named variable in a result
+             *  location.
+             */
+            var = cd->NamedVar;
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".dword = D_Var;\n");
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".vword.descptr = &");
+            prt_var(var, outer);
+            fprintf(codefile, ";\n");
+            break;
+
+         case C_CallSig:
+            /*
+             * Call to C function that returns a signal along with signal
+             *   handling code.
+             */
+            if (opt_sgnl)
+               good_clsg(cd, outer);
+            else
+               smpl_clsg(cd, outer);
+            break;
+
+         case C_RetSig:
+            /*
+             * Return a signal.
+             */
+            sig = cd->SigRef->sig;
+            if (sig->cd_id == C_Resume)
+               fprintf(codefile, "   return A_Resume;\n");
+            else {
+               sig = ChkBound(sig);
+               ChkSeqNum(sig);
+               fprintf(codefile, "   return %d; /* %s */\n", sig->SeqNum,
+                  sig->Desc);
+               }
+            break;
+
+         case C_Goto:
+            /*
+             * goto label.
+             */
+            ChkSeqNum(cd->Lbl);
+            fprintf(codefile, "   goto L%d /* %s */;\n", cd->Lbl->SeqNum, 
+               cd->Lbl->Desc);
+            break;
+
+         case C_Label:
+            /*
+             * numbered label.
+             */
+            if (cd->RefCnt > 0) {
+               ChkSeqNum(cd);
+               fprintf(codefile, "L%d: ; /* %s */\n", cd->SeqNum, cd->Desc);
+               }
+            break;
+
+         case C_Lit:
+            /*
+             * Assign literal value to a result location.
+             */
+            lit = cd->Literal;
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            switch (lit->flag) {
+               case F_CsetLit:
+                  fprintf(codefile, ".dword = D_Cset;\n");
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".vword.bptr = (union block *)&BDC%s;\n",
+                     lit->prefix);
+                  break;
+               case F_IntLit:
+                  if (lit->u.intgr == -1) {
+                     /*
+                      * Large integer literal - output string and convert
+                      *  to integer.
+                      */
+                     fprintf(codefile, ".vword.sptr = \"%s\";\n", lit->image);
+                     fprintf(codefile, "   ");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ".dword = %d;\n", strlen(lit->image));
+                     fprintf(codefile, "   cnv_int(&");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ", &");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ");\n");
+                     }
+                  else {
+                     /*
+                      * Ordinary integer literal.
+                      */
+                     fprintf(codefile, ".dword = D_Integer;\n");
+                     fprintf(codefile, "   ");
+                     val_loc(cd->Rslt, outer);
+                     fprintf(codefile, ".vword.integr = %ld;\n", lit->u.intgr);
+                     }
+                  break;
+               case F_RealLit:
+                  fprintf(codefile, ".dword = D_Real;\n");
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".vword.bptr = (union block *)&BDR%s;\n",
+                     lit->prefix);
+                  break;
+               case F_StrLit:
+                  fprintf(codefile, ".vword.sptr = ");
+                  if (lit->length ==  0) {
+                     /*
+                      * Placing an empty string at the end of the string region
+                      *  allows some concatenation optimizations at run time.
+                      */
+                     fprintf(codefile, "strfree;\n");
+                     n = 0;
+                     }
+                  else {
+                     fprintf(codefile, "\"");
+                     n = prt_i_str(codefile, lit->image, lit->length);
+                     fprintf(codefile, "\";\n");
+                     }
+                  fprintf(codefile, "   ");
+                  val_loc(cd->Rslt, outer);
+                  fprintf(codefile, ".dword = %d;\n", n);
+                  break;
+               }
+            break;
+
+         case C_PFail:
+            /*
+             * Procedure failure - this code occurs once near the end of
+             *  the procedure.
+             */
+            if (debug_info) {
+               fprintf(codefile, "   --k_level;\n");
+               fprintf(codefile, "   if (k_trace) failtrace();\n");
+               }
+            fprintf(codefile, "   tend = r_frame.tend.previous;\n");
+            fprintf(codefile, "   pfp = r_frame.old_pfp;\n");
+            fprintf(codefile, "   glbl_argp = r_frame.old_argp;\n");
+            if (line_info) {
+               fprintf(codefile, "   line_num = r_frame.debug.old_line;\n");
+               fprintf(codefile, "   file_name = r_frame.debug.old_fname;\n");
+               }
+            fprintf(codefile, "   return A_Resume;\n");
+            break;
+
+         case C_PRet:
+            /*
+             * Procedure return - this code occurs once near the end of
+             *  the procedure.
+             */
+            if (debug_info) {
+               fprintf(codefile, "   --k_level;\n");
+               fprintf(codefile, "   if (k_trace) rtrace();\n");
+               }
+            fprintf(codefile, "   tend = r_frame.tend.previous;\n");
+            fprintf(codefile, "   pfp = r_frame.old_pfp;\n");
+            fprintf(codefile, "   glbl_argp = r_frame.old_argp;\n");
+            if (line_info) {
+               fprintf(codefile, "   line_num = r_frame.debug.old_line;\n");
+               fprintf(codefile, "   file_name = r_frame.debug.old_fname;\n");
+               }
+            fprintf(codefile, "   return A_Continue;\n");
+            break;
+
+         case C_PSusp:
+            /*
+             * Procedure suspend - call success continuation.
+             */
+            prtpccall(outer);
+            break;
+
+         case C_Break:
+            fprintf(codefile, "   break;\n");
+            break;
+
+         case C_If:
+            /*
+             * C if statement.
+             */
+            fprintf(codefile, "   if (");
+            prt_ary(cd->Cond, outer);
+            fprintf(codefile, ")\n   ");
+            prtcode(cd->ThenStmt, outer);
+            break;
+
+         case C_CdAry:
+            /*
+             * Array of code fragments.
+             */
+            fprintf(codefile, "   ");
+            prt_ary(cd, outer);
+            fprintf(codefile, "\n");
+            break;
+
+         case C_LBrack:
+            fprintf(codefile, "   {\n");
+            break;
+
+         case C_RBrack:
+            fprintf(codefile, "   }\n");
+            break;
+
+         case C_Create:
+            /*
+             * Code to create a co-expression and assign it to a result
+             *  location.
+             */
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile , ".vword.bptr = (union block *)create(");
+            prt_cont(cd->Cont);
+            fprintf(codefile,
+               ", (struct b_proc *)&BP%s_%s, %d, sizeof(word) * %d);\n",
+               cur_proc->prefix, cur_proc->name, cd->NTemps, cd->WrkSize);
+            fprintf(codefile, "   ");
+            val_loc(cd->Rslt, outer);
+            fprintf(codefile, ".dword = D_Coexpr;\n");
+            break;
+
+         case C_SrcLoc:
+            /*
+             * Update file name and line number information.
+             */
+            if (cd->FileName != NULL) {
+               fprintf(codefile, "   file_name = \"");
+               prt_i_str(codefile, cd->FileName, strlen(cd->FileName));
+               fprintf(codefile, "\";\n");
+               }
+            if (cd->LineNum != 0)
+               fprintf(codefile, "   line_num = %d;\n", cd->LineNum);
+            break;
+         }
+      }
+   }
+
+/*
+ * prt_var - output C code to reference an Icon named variable.
+ */
+static void prt_var(var, outer)
+struct lentry *var;
+int outer;
+   {
+   switch (var->flag) {
+      case F_Global:
+         fprintf(codefile, "globals[%d]", var->val.global->index);
+         break;
+      case F_Static:
+         fprintf(codefile, "statics[%d]", var->val.index);
+         break;
+      case F_Dynamic:
+         frame(outer);
+         fprintf(codefile, ".tend.d[%d]", var->val.index);
+         break;
+      case F_Argument:
+         fprintf(codefile, "glbl_argp[%d]", var->val.index);
+         }
+
+   /*
+    * Include an identifying comment.
+    */
+   fprintf(codefile, " /* %s */", var->name);
+   }
+
+/*
+ * prt_ary - print an array of code fragments.
+ */
+static void prt_ary(cd, outer)
+struct code *cd;
+int outer;
+   {
+   int i;
+
+   for (i = 0; cd->ElemTyp(i) != A_End; ++i)
+      switch (cd->ElemTyp(i)) {
+         case A_Str:
+            /*
+             * Simple C code in a string.
+             */
+            fprintf(codefile, "%s", cd->Str(i));
+            break;
+         case A_ValLoc:
+            /*
+             * Value location (usually variable of some sort).
+             */
+            val_loc(cd->ValLoc(i), outer);
+            break;
+         case A_Intgr:
+            /*
+             * Integer.
+             */
+            fprintf(codefile, "%d", cd->Intgr(i));
+            break;
+         case A_ProcCont:
+            /*
+             * Current procedure call's success continuation.
+             */
+            if (outer)
+               fprintf(codefile, "r_s_cont");
+            else
+               fprintf(codefile, "r_pfp->succ_cont");
+            break;
+         case A_SBuf:
+            /*
+             * One of the string buffers.
+             */
+            frame(outer);
+            fprintf(codefile, ".sbuf[%d]", cd->Intgr(i));
+            break;
+         case A_CBuf:
+            /*
+             * One of the cset buffers.
+             */
+            fprintf(codefile, "&(");
+            frame(outer);
+            fprintf(codefile, ".cbuf[%d])", cd->Intgr(i));
+            break;
+         case A_Ary:
+            /*
+             * A subarray of code fragments.
+             */
+            prt_ary(cd->Array(i), outer);
+            break;
+         }
+   }
+
+/*
+ * frame - access to the procedure frame. Access directly from outer function,
+ *   but access through r_pfp from a continuation.
+ */
+static void frame(outer)
+int outer;
+   {
+   if (outer)
+      fprintf(codefile, "r_frame");
+   else
+      fprintf(codefile, "(*r_pfp)");
+   }
+
+/*
+ * prtpccall - print procedure continuation call.
+ */
+static void prtpccall(outer)
+int outer;
+   {
+   int first_arg;
+   int optim; /* optimized interface: no arg list adjustment */
+
+   first_arg = cur_proc->tnd_loc + num_tmp;
+   optim = glookup(cur_proc->name)->flag & F_SmplInv;
+
+   /*
+    * The only signal to be handled in this procedure is
+    *  resumption, the rest must be passed on.
+    */
+   if (cur_proc->nargs != 0 && optim && !outer) {
+      fprintf(codefile, "   {\n");
+      fprintf(codefile, "   dptr r_argp_sav;\n");
+      fprintf(codefile, "\n");
+      fprintf(codefile, "   r_argp_sav = glbl_argp;\n");
+      }
+   if (debug_info) {
+      fprintf(codefile, "   --k_level;\n");
+      fprintf(codefile, "   if (k_trace) strace();\n");
+      }
+   fprintf(codefile, "   pfp = ");
+   frame(outer);
+   fprintf(codefile, ".old_pfp;\n");
+   fprintf(codefile, "   glbl_argp = ");
+   frame(outer);
+   fprintf(codefile, ".old_argp;\n");
+   if (line_info) {
+      fprintf(codefile, "   line_num = ");
+      frame(outer);
+      fprintf(codefile, ".debug.old_line;\n");
+      fprintf(codefile, "   file_name = ");
+      frame(outer);
+      fprintf(codefile , ".debug.old_fname;\n");
+      }
+   fprintf(codefile, "   r_signal = (*");
+   if (outer)
+      fprintf(codefile, "r_s_cont)();\n");
+   else
+      fprintf(codefile, "r_pfp->succ_cont)();\n");
+   fprintf(codefile, "   if (r_signal != A_Resume) {\n");
+   if (outer)
+      fprintf(codefile, "      tend = r_frame.tend.previous;\n");
+   fprintf(codefile, "      return r_signal;\n");
+   fprintf(codefile, "      }\n");
+   fprintf(codefile, "   pfp = (struct p_frame *)&");
+   frame(outer);
+   fprintf(codefile, ";\n");
+   if (cur_proc->nargs == 0)
+      fprintf(codefile, "   glbl_argp = NULL;\n");
+   else {
+      if (optim) {
+         if (outer)
+            fprintf(codefile, "   glbl_argp = r_args;\n");
+         else
+            fprintf(codefile, "   glbl_argp = r_argp_sav;\n");
+         }
+      else {
+         fprintf(codefile, "   glbl_argp = &");
+         if (outer)
+            fprintf(codefile, "r_frame.");
+         else
+            fprintf(codefile, "r_pfp->");
+         fprintf(codefile, "tend.d[%d];\n", first_arg);
+         }
+      }
+   if (debug_info) {
+      fprintf(codefile, "   if (k_trace) atrace();\n");
+      fprintf(codefile, "   ++k_level;\n");
+      }
+   if (cur_proc->nargs != 0 && optim && !outer)
+      fprintf(codefile, "   }\n");
+   }
+
+/*
+ * smpl_clsg - print call and signal handling code, but nothing fancy.
+ */
+static void smpl_clsg(call, outer)
+struct code *call;
+int outer;
+   {
+   struct sig_act *sa;
+
+   fprintf(codefile, "   r_signal = ");
+   prtcall(call, outer);
+   fprintf(codefile, ";\n");
+   if (call->Flags & ForeignSig)
+       chkforgn(outer);
+   fprintf(codefile, "   switch (r_signal) {\n");
+   for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+      fprintf(codefile, "      case ");
+      prt_cond(sa->sig);
+      fprintf(codefile, ":\n      ");
+      prtcode(sa->cd, outer);
+      }
+   fprintf(codefile, "      }\n");
+   }
+
+/*
+ * chkforgn - produce code to see if the current signal belongs to a
+ *   procedure higher up the call chain and pass it along if it does.
+ */
+static void chkforgn(outer)
+int outer;
+   {
+   fprintf(codefile, "   if (pfp != (struct p_frame *)");
+   if (outer) {
+      fprintf(codefile, "&r_frame) {\n");
+      fprintf(codefile, "      tend = r_frame.tend.previous;\n");
+      }
+   else
+      fprintf(codefile, "r_pfp) {\n");
+   fprintf(codefile, "      return r_signal;\n");
+   fprintf(codefile, "      }\n");
+   }
+
+/*
+ * good_clsg - print call and signal handling code and do a good job.
+ */
+static void good_clsg(call, outer)
+struct code *call;
+int outer;
+   {
+   struct sig_act *sa, *sa1, *nxt_sa;
+   int ncases;   /* the number of cases - each may have multiple case labels */
+   int ncaselbl; /* the number of case labels */
+   int nbreak;   /* the number of cases that just break out of the switch */
+   int nretsig;  /* the number of cases that just pass along signal */
+   int sig_var;
+   int dflt;
+   struct code *cond;
+   struct code *then_cd;
+   
+   /*
+    * Decide whether to use "break;", "return r_signal;", or nothing as
+    *  the default case.
+    */
+   nretsig = 0;
+   nbreak = 0;
+   for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+      if (sa->cd->cd_id == C_RetSig && sa->sig == sa->cd->SigRef->sig) {
+         /*
+          * The action returns the same signal detected by this case.
+          */
+         ++nretsig;
+         }
+      else if (sa->cd->cd_id == C_Break) {
+         cond = sa->sig;   /* if there is only one break, we may want this */
+         ++nbreak;
+         }
+      }
+   dflt = DfltNone;
+   ncases = 0;
+   if (nbreak > 0 && nbreak >= nretsig)  {
+      /*
+       * There are at least as many "break;"s as "return r_signal;"s, so
+       *  use "break;" for default clause.
+       */
+      dflt = DfltBrk;
+      ncases = 1;
+      }
+   else if (nretsig > 1) {
+      /*
+       * There is more than one case that returns the same signal it
+       *  detects and there are more of them than "break;"s, to make
+       *  "return r_signal;" the default clause.
+       */
+      dflt = DfltRetSig;
+      ncases = 1;
+      }
+
+   /*
+    * Gather case labels together for each case, ignoring cases that
+    *  fall under the default. This involves constructing a new
+    *  improved call->SigActs list.
+    */
+   ncaselbl = ncases;
+   sa = call->SigActs;
+   call->SigActs = NULL;
+   for ( ; sa != NULL; sa = nxt_sa) {
+      nxt_sa = sa->next;
+      /*
+       * See if we have already found a case with the same action.
+       */
+      sa1 = call->SigActs;
+      switch (sa->cd->cd_id) {
+         case C_Break:
+            if (dflt == DfltBrk)
+               continue;
+            while (sa1 != NULL && sa1->cd->cd_id != C_Break)
+               sa1 = sa1->next;
+            break;
+         case C_RetSig:
+            if (dflt == DfltRetSig && sa->cd->SigRef->sig == sa->sig)
+               continue;
+            while (sa1 != NULL && (sa1->cd->cd_id != C_RetSig ||
+                sa1->cd->SigRef->sig != sa->cd->SigRef->sig))
+               sa1 = sa1->next;
+            break;
+         default: /* C_Goto */
+            while (sa1 != NULL && (sa1->cd->cd_id != C_Goto ||
+                sa1->cd->Lbl != sa->cd->Lbl))
+               sa1 = sa1->next;
+            break;
+            }
+      ++ncaselbl;
+      if (sa1 == NULL) {
+         /*
+          * First time we have seen this action, create a new case.
+          */
+         ++ncases;
+         sa->next = call->SigActs;
+         call->SigActs = sa;
+         }
+      else {
+         /*
+          * We can share the action of another case label.
+          */
+         sa->shar_act = sa1->shar_act;
+         sa1->shar_act = sa;
+         }
+      }
+
+   /*
+    * If we might receive a "foreign" signal that belongs to a procedure
+    *  further down the call chain, put the signal in "r_signal" then
+    *  check for this condition.
+    */
+   sig_var = 0;
+   if (call->Flags & ForeignSig) {
+      fprintf(codefile, "   r_signal = ");
+      prtcall(call, outer);
+      fprintf(codefile, ";\n");
+      chkforgn(outer);
+      sig_var = 1;
+      }
+
+   /*
+    * Determine the best way to handle the signal returned from the call.
+    */
+   if (ncases == 0) {
+      /*
+       * Any further signal checking has been optimized away. Execution
+       *  just falls through to subsequent code. If the call has not
+       *  been done, do it.
+       */
+      if (!sig_var) {
+         fprintf(codefile, "   ");
+         prtcall(call, outer);
+         fprintf(codefile, ";\n");
+         }
+      }
+   else if (ncases == 1) {
+      if (dflt == DfltRetSig || ncaselbl == nretsig) {
+         /*
+          * All this call does is pass the signal on. See if we have
+          *  done the call yet.
+          */
+         if (sig_var)
+            fprintf(codefile, "   return r_signal;");
+         else {
+            fprintf(codefile, "   return ");
+            prtcall(call, outer);
+            fprintf(codefile, ";\n");
+            }
+         }
+      else {
+         /*
+          * We know what to do without looking at the signal. Make sure
+          *  we have done the call. If the action is not simply  "break"
+          *  out signal checking, execute it. 
+          */
+         if (!sig_var) {
+            fprintf(codefile, "   ");
+            prtcall(call, outer);
+            fprintf(codefile, ";\n");
+            }
+         if (dflt != DfltBrk)
+            prtcode(call->SigActs->cd, outer);
+         }
+      }
+   else {
+      /*
+       * We have at least two cases. If we have a default action of returning
+       *  the signal without looking at it, make sure it is in "r_signal".
+       */
+      if (!sig_var && dflt == DfltRetSig) {
+         fprintf(codefile, "   r_signal = ");
+         prtcall(call, outer);
+         fprintf(codefile, ";\n");
+         sig_var = 1;
+         }
+      
+      if (ncaselbl == 2) {
+         /*
+          * We can use an if statement. If we need the signal in "r_signal",
+          *  it is already there.
+          */
+         fprintf(codefile, "   if (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+   
+         cond = call->SigActs->sig;
+         then_cd = call->SigActs->cd;
+            
+         /*
+          * If the "then" clause is a no-op ("break;" from a switch),
+          *  prepare to eliminate it by reversing the test in the
+          *  condition.
+          */
+         if (then_cd->cd_id == C_Break)
+            fprintf(codefile, " != ");
+         else
+            fprintf(codefile, " == ");
+   
+         prt_cond(cond);
+         fprintf(codefile, ")\n   ");
+   
+         if (then_cd->cd_id == C_Break) {
+            /*
+             * We have reversed the test, so we need to use the default
+             *  code. However, because a "break;" exists and it is not
+             *  default, "return r_signal;" must be the default.
+             */
+            fprintf(codefile, "   return r_signal;\n");
+            }
+         else {
+            /*
+             * Print the "then" clause and determine what the "else" clause
+             *  is.
+             */
+            prtcode(then_cd, outer);
+            if (call->SigActs->next != NULL) {
+               fprintf(codefile, "   else\n   ");
+               prtcode(call->SigActs->next->cd, outer);
+               }
+            else if (dflt == DfltRetSig) {
+               fprintf(codefile, "   else\n");
+               fprintf(codefile, "       return r_signal;\n");
+               }
+            }
+         }
+      else if (ncases == 2 && nbreak == 1) {
+         /*
+          * We can use an if-then statement with a negated test. Note,
+          *  the non-break case is not "return r_signal" or we would have
+          *  ncaselbl = 2, making the last test true. This also means that
+          *  break is the default (the break condition was saved).
+          */
+         fprintf(codefile, "   if (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+         fprintf(codefile, " != ");
+         prt_cond(cond);
+         fprintf(codefile, ") {\n   ");
+         prtcode(call->SigActs->cd, outer);
+         fprintf(codefile, "      }\n");
+         }
+      else {
+         /*
+          * We must use a full case statement. If we need the signal in
+          *  "r_signal", it is already there.
+          */
+         fprintf(codefile, "   switch (");
+         if (sig_var) 
+            fprintf(codefile, "r_signal");
+         else
+            prtcall(call, outer);
+         fprintf(codefile, ") {\n");
+   
+         /*
+          * Print the cases
+          */
+         for (sa = call->SigActs; sa != NULL; sa = sa->next) {
+            for (sa1 = sa; sa1 != NULL; sa1 = sa1->shar_act) {
+               fprintf(codefile, "      case ");
+               prt_cond(sa1->sig);
+               fprintf(codefile, ":\n");
+               }
+            fprintf(codefile, "      ");
+            prtcode(sa->cd, outer);
+            }
+      
+         /*
+          * If we have a default action and it is not break, print it.
+          */
+         if (dflt == DfltRetSig) {
+            fprintf(codefile, "      default:\n");
+            fprintf(codefile, "         return r_signal;\n");
+            }
+      
+         fprintf(codefile, "      }\n");
+         }
+      }
+   }
+
+/*
+ * prtcall - print call.
+ */
+static void prtcall(call, outer)
+struct code *call;
+int outer;
+   {
+   /*
+    * Either the operation or the continuation may be missing, but not
+    *  both.
+    */
+   if (call->OperName == NULL) {
+      prt_cont(call->Cont);
+      fprintf(codefile, "()");
+      }
+   else {
+      fprintf(codefile, "%s(", call->OperName);
+      if (call->ArgLst != NULL)
+         prt_ary(call->ArgLst, outer);
+      if (call->Cont == NULL) {
+         if (call->Flags & NeedCont) {
+            /*
+             * The operation requires a continuation argument even though
+             *  this call does not include one, pass the NULL pointer.
+             */
+            if (call->ArgLst != NULL)
+               fprintf(codefile, ", ");
+            fprintf(codefile, "(continuation)NULL");
+            }
+         }
+      else {
+         /*
+          * Pass the success continuation.
+          */
+         if (call->ArgLst != NULL)
+            fprintf(codefile, ", ");
+         prt_cont(call->Cont);
+         }
+      fprintf(codefile, ")");
+      }
+   }
+
+/*
+ * prt_cont - print the name of a continuation.
+ */
+static void prt_cont(cont)
+struct c_fnc *cont;
+   {
+   struct code *sig;
+
+   if (cont->flag & CF_SigOnly) {
+      /*
+       * This continuation only returns a signal. All continuations
+       *  returning the same signal are implemented by the same C function.
+       */
+      sig = cont->cd.next->SigRef->sig;
+      if (sig->cd_id == C_Resume)
+         fprintf(codefile, "sig_rsm");
+      else {
+         sig = ChkBound(sig);
+         ChkSeqNum(sig);
+         fprintf(codefile, "sig_%d", sig->SeqNum);
+         }
+      }
+   else {
+      /*
+       * Regular continuation.
+       */
+      ChkPrefix(cont->prefix);
+      fprintf(codefile, "P%s_%s", cont->prefix, cur_proc->name);
+      }
+   }
+
+/*
+ * val_loc - output code referencing a value location (usually variable of
+ *  some sort).
+ */
+static void val_loc(loc, outer)
+struct val_loc *loc;
+int outer;
+   {
+   /*
+    * See if we need to cast a block pointer to a specific block type
+    *  or if we need to take the address of a location.
+    */
+   if (loc->mod_access == M_BlkPtr && loc->blk_name != NULL)
+      fprintf(codefile, "(*(struct %s **)&", loc->blk_name);
+   if (loc->mod_access == M_Addr)
+      fprintf(codefile, "(&");
+
+   switch (loc->loc_type) {
+      case V_Ignore:
+         fprintf(codefile, "trashcan");
+         break;
+      case V_Temp:
+         /*
+          * Temporary descriptor variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".tend.d[%d]", cur_proc->tnd_loc + loc->u.tmp);
+         break;
+      case V_ITemp:
+         /*
+          * Temporary C integer variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".i%d", loc->u.tmp);
+         break;
+      case V_DTemp:
+         /*
+          * Temporary C double variable.
+          */
+         frame(outer);
+         fprintf(codefile, ".d%d", loc->u.tmp);
+         break;
+      case V_Const:
+         /*
+          * Integer constant (used for size of variable part of arg list).
+          */
+         fprintf(codefile, "%d", loc->u.int_const);
+         break;
+      case V_NamedVar:
+         /*
+          * Icon named variable.
+          */
+         prt_var(loc->u.nvar, outer);
+         break;
+      case V_CVar:
+         /*
+          * C variable from in-line code.
+          */
+         fprintf(codefile, "%s", loc->u.name);
+         break;
+      case V_PRslt:
+         /*
+          * Procedure result location.
+          */
+         if (!outer)
+            fprintf(codefile, "(*r_pfp->rslt)");
+         else
+            fprintf(codefile, "(*r_rslt)");
+         break;
+       }
+
+   /*
+    * See if we are accessing the vword of a descriptor.
+    */
+   switch (loc->mod_access) {
+      case M_CharPtr:
+         fprintf(codefile, ".vword.sptr");
+         break;
+      case M_BlkPtr:
+         fprintf(codefile, ".vword.bptr");
+         if (loc->blk_name != NULL)
+            fprintf(codefile, ")");
+         break;
+      case M_CInt:
+         fprintf(codefile, ".vword.integr");
+         break;
+      case M_Addr:
+         fprintf(codefile, ")");
+         break;
+      }
+   }
+
+/*
+ * prt_cond - print a condition (signal number).
+ */
+static void prt_cond(cond)
+struct code *cond;
+   {
+   if (cond == &resume)
+      fprintf(codefile, "A_Resume");
+   else if (cond == &contin)
+      fprintf(codefile, "A_Continue");
+   else if (cond == &fallthru)
+      fprintf(codefile, "A_FallThru");
+   else {
+      cond = ChkBound(cond);
+      ChkSeqNum(cond);
+      fprintf(codefile, "%d /* %s */", cond->SeqNum, cond->Desc);
+      }
+   }
+
+/*
+ * initpblk - write a procedure block along with initialization up to the
+ *   the array of qualifiers.
+ */
+static void initpblk(f, c, prefix, name, nquals, nparam, ndynam, nstatic,
+   frststat)
+FILE *f;      /* output file */
+int c;        /* distinguishes procedures, functions, record constructors */
+char* prefix; /* prefix for name */
+char *name;   /* name of routine */
+int nquals;   /* number of qualifiers at end of block */
+int nparam;   /* number of parameters */
+int ndynam;   /* number of dynamic locals or function/record indicator */
+int nstatic;  /* number of static locals or record number */
+int frststat; /* index into static array of first static local */
+   {
+   fprintf(f, "B_IProc(%d) B%c%s_%s = ", nquals, c, prefix, name);
+   fprintf(f, "{T_Proc, %d, %c%s_%s, %d, %d, %d, %d, {", 9 + 2 * nquals, c,
+      prefix, name, nparam, ndynam, nstatic, frststat);
+   }
+
diff --git a/src/iconc/cparse.c b/src/iconc/cparse.c
new file mode 100644
index 0000000..b29986d
--- /dev/null
+++ b/src/iconc/cparse.c
@@ -0,0 +1,1940 @@
+# define IDENT 257
+# define INTLIT 258
+# define REALLIT 259
+# define STRINGLIT 260
+# define CSETLIT 261
+# define EOFX 262
+# define BREAK 263
+# define BY 264
+# define CASE 265
+# define CREATE 266
+# define DEFAULT 267
+# define DO 268
+# define ELSE 269
+# define END 270
+# define EVERY 271
+# define FAIL 272
+# define GLOBAL 273
+# define IF 274
+# define INITIAL 275
+# define INVOCABLE 276
+# define LINK 277
+# define LOCAL 278
+# define NEXT 279
+# define NOT 280
+# define OF 281
+# define PROCEDURE 282
+# define RECORD 283
+# define REPEAT 284
+# define RETURN 285
+# define STATIC 286
+# define SUSPEND 287
+# define THEN 288
+# define TO 289
+# define UNTIL 290
+# define WHILE 291
+# define BANG 292
+# define MOD 293
+# define AUGMOD 294
+# define AND 295
+# define AUGAND 296
+# define STAR 297
+# define AUGSTAR 298
+# define INTER 299
+# define AUGINTER 300
+# define PLUS 301
+# define AUGPLUS 302
+# define UNION 303
+# define AUGUNION 304
+# define MINUS 305
+# define AUGMINUS 306
+# define DIFF 307
+# define AUGDIFF 308
+# define DOT 309
+# define SLASH 310
+# define AUGSLASH 311
+# define ASSIGN 312
+# define SWAP 313
+# define NMLT 314
+# define AUGNMLT 315
+# define REVASSIGN 316
+# define REVSWAP 317
+# define SLT 318
+# define AUGSLT 319
+# define SLE 320
+# define AUGSLE 321
+# define NMLE 322
+# define AUGNMLE 323
+# define NMEQ 324
+# define AUGNMEQ 325
+# define SEQ 326
+# define AUGSEQ 327
+# define EQUIV 328
+# define AUGEQUIV 329
+# define NMGT 330
+# define AUGNMGT 331
+# define NMGE 332
+# define AUGNMGE 333
+# define SGT 334
+# define AUGSGT 335
+# define SGE 336
+# define AUGSGE 337
+# define QMARK 338
+# define AUGQMARK 339
+# define AT 340
+# define AUGAT 341
+# define BACKSLASH 342
+# define CARET 343
+# define AUGCARET 344
+# define BAR 345
+# define CONCAT 346
+# define AUGCONCAT 347
+# define LCONCAT 348
+# define AUGLCONCAT 349
+# define TILDE 350
+# define NMNE 351
+# define AUGNMNE 352
+# define SNE 353
+# define AUGSNE 354
+# define NEQUIV 355
+# define AUGNEQUIV 356
+# define LPAREN 357
+# define RPAREN 358
+# define PCOLON 359
+# define COMMA 360
+# define MCOLON 361
+# define COLON 362
+# define SEMICOL 363
+# define LBRACK 364
+# define RBRACK 365
+# define LBRACE 366
+# define RBRACE 367
+
+# line 145 "cgram.g"
+/*
+ * These commented directives are passed through the first application
+ * of cpp, then turned into real directives in cgram.g by fixgram.icn.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h" 
+#include "cproto.h"
+#undef YYSTYPE
+#define YYSTYPE nodeptr
+#define YYMAXDEPTH 500
+
+int idflag;
+
+
+
+#define yyclearin yychar = -1
+#define yyerrok yyerrflag = 0
+extern int yychar;
+extern int yyerrflag;
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 150
+#endif
+#ifndef YYSTYPE
+#define YYSTYPE int
+#endif
+YYSTYPE yylval, yyval;
+# define YYERRCODE 256
+
+# line 441 "cgram.g"
+
+
+/*
+ * xfree(p) -- used with free(p) macro to avoid compiler errors from
+ *  miscast free calls generated by Yacc.
+ */
+
+static void xfree(p)
+char *p;
+{
+   free(p);
+}
+
+#define free(p) xfree((char*)p)
+int yyexca[] ={
+-1, 0,
+	262, 2,
+	273, 2,
+	276, 2,
+	277, 2,
+	282, 2,
+	283, 2,
+	-2, 0,
+-1, 1,
+	0, -1,
+	-2, 0,
+-1, 20,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 86,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 87,
+	358, 42,
+	360, 42,
+	-2, 0,
+-1, 88,
+	363, 42,
+	367, 42,
+	-2, 0,
+-1, 89,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 96,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 97,
+	264, 42,
+	268, 42,
+	269, 42,
+	281, 42,
+	288, 42,
+	289, 42,
+	293, 42,
+	294, 42,
+	296, 42,
+	298, 42,
+	300, 42,
+	302, 42,
+	304, 42,
+	306, 42,
+	308, 42,
+	311, 42,
+	312, 42,
+	313, 42,
+	314, 42,
+	315, 42,
+	316, 42,
+	317, 42,
+	318, 42,
+	319, 42,
+	320, 42,
+	321, 42,
+	322, 42,
+	323, 42,
+	325, 42,
+	327, 42,
+	329, 42,
+	330, 42,
+	331, 42,
+	332, 42,
+	333, 42,
+	334, 42,
+	335, 42,
+	336, 42,
+	337, 42,
+	339, 42,
+	341, 42,
+	344, 42,
+	347, 42,
+	349, 42,
+	352, 42,
+	354, 42,
+	356, 42,
+	358, 42,
+	359, 42,
+	360, 42,
+	361, 42,
+	362, 42,
+	363, 42,
+	365, 42,
+	367, 42,
+	-2, 0,
+-1, 111,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 117,
+	270, 40,
+	363, 42,
+	-2, 0,
+-1, 182,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 183,
+	360, 42,
+	-2, 0,
+-1, 184,
+	358, 42,
+	360, 42,
+	-2, 0,
+-1, 311,
+	358, 42,
+	360, 42,
+	365, 42,
+	-2, 0,
+-1, 313,
+	363, 42,
+	367, 42,
+	-2, 0,
+-1, 335,
+	360, 42,
+	367, 42,
+	-2, 0,
+	};
+# define YYNPROD 203
+# define YYLAST 728
+int yyact[]={
+
+    38,    84,    91,    92,    93,    94,   312,    86,   185,    99,
+    83,   118,   335,   359,   341,   102,    95,   358,    98,   334,
+   311,   311,   355,    85,    51,   329,   314,    20,   103,    96,
+   118,    97,   313,   228,   101,   100,    56,   346,   118,    90,
+   118,    59,   117,    62,   360,    58,   108,    70,   336,    64,
+   311,    57,   228,    55,    60,   326,   184,   228,   310,   119,
+   311,   107,   106,   182,   345,   183,   324,   232,    65,   110,
+    67,   168,    69,   169,   352,   214,   118,   350,   328,   177,
+    41,   356,    71,   174,    50,   175,    73,    61,   325,    52,
+    53,   320,    54,   316,    63,    66,   176,    68,   327,    72,
+   118,    87,   332,   118,   333,   331,   319,   361,    89,   116,
+    88,   305,    38,    84,    91,    92,    93,    94,   118,    86,
+   181,    99,    83,   353,   317,   231,     3,   102,    95,   218,
+    98,   318,   105,   118,    19,    85,    51,   315,   118,    28,
+   103,    96,    29,    97,   217,   321,   101,   100,    56,   309,
+   170,    90,   172,    59,   173,    62,   171,    58,   118,    70,
+    30,    64,    18,    57,   118,    55,    60,    44,   180,    37,
+   179,   178,   113,    24,   104,   114,    25,   330,   351,   306,
+    65,   212,    67,   115,    69,    82,     2,    81,    80,    27,
+    17,    36,    23,    79,    71,    78,    50,    77,    73,    61,
+    76,    52,    53,    75,    54,    74,    63,    66,    49,    68,
+    47,    72,    42,    87,    38,    84,    91,    92,    93,    94,
+    89,    86,    88,    99,    83,    40,   112,   322,   109,   102,
+    95,    34,    98,   273,   274,   111,    33,    85,    51,    12,
+   233,    32,   103,    96,    21,    97,    22,    26,   101,   100,
+    56,    10,     9,    90,     8,    59,     7,    62,    31,    58,
+     6,    70,     5,    64,     1,    57,     0,    55,    60,    13,
+     0,   216,    15,    14,     0,   210,     0,     0,    16,    11,
+     0,     0,    65,     0,    67,   234,    69,   236,   239,   221,
+   222,   223,   224,   225,   226,   227,    71,   230,    50,   229,
+    73,    61,     0,    52,    53,   237,    54,     0,    63,    66,
+     0,    68,     0,    72,     0,    87,    46,    84,    91,    92,
+    93,    94,    89,    86,    88,    99,    83,    45,     0,     0,
+     0,   102,    95,     0,    98,     0,   289,   290,     0,    85,
+    51,     0,     0,   235,   103,    96,     0,    97,     0,   238,
+   101,   100,    56,     0,     0,    90,     0,    59,     0,    62,
+     0,    58,     4,    70,   303,    64,   308,    57,     0,    55,
+    60,     0,     0,    13,   304,     0,    15,    14,     0,     0,
+     0,     0,    16,    11,    65,     0,    67,     0,    69,   338,
+     0,   213,     0,     0,     0,     0,     0,     0,    71,    43,
+    50,     0,    73,    61,     0,    52,    53,   323,    54,   347,
+    63,    66,    35,    68,   152,    72,     0,    87,     0,   133,
+     0,   150,     0,   130,    89,   131,    88,   128,     0,   127,
+     0,   129,     0,   126,   362,     0,   132,   121,   120,     0,
+   140,   123,   122,     0,   147,   164,   146,     0,   139,   158,
+   135,   157,   143,   163,   136,   160,   138,   154,   137,   166,
+   145,   162,   144,   161,   149,   156,   151,   155,     0,   134,
+     0,     0,   124,     0,   125,     0,   153,   141,   211,   148,
+   215,   142,   165,    39,   159,     0,   167,     0,   219,   220,
+     0,   295,   296,   297,   298,   299,     0,     0,   291,   292,
+   293,   294,     0,    35,     0,     0,     0,   339,   340,    35,
+   342,   343,   344,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,   348,     0,     0,     0,    48,     0,     0,     0,
+     0,     0,     0,   354,     0,     0,     0,     0,     0,     0,
+     0,     0,   357,     0,     0,     0,     0,     0,     0,     0,
+     0,   354,   363,   364,   275,   276,   277,   278,   279,   280,
+   281,   282,   283,   284,   285,   286,   287,   288,     0,     0,
+     0,     0,     0,     0,     0,   307,     0,   186,   187,   188,
+   189,   190,   191,   192,   193,   194,   195,   196,   197,   198,
+   199,   200,   201,   202,   203,   204,   205,   206,   207,   208,
+   209,     0,     0,   240,   241,   242,   243,   244,   245,   246,
+   247,   248,   249,   250,   251,   252,   253,   254,   255,   256,
+   257,   258,   259,   260,   261,   262,   263,   264,   265,   266,
+   267,   268,   269,   270,   271,   272,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,   337,     0,   215,   300,   301,   302,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,   349 };
+int yypact[]={
+
+  -130, -1000,   100, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000,   -95,  -229, -1000,   -84,  -118,   -97,    -4, -1000, -1000,
+   -42,  -125,  -298, -1000, -1000, -1000,  -299, -1000, -1000,  -316,
+ -1000, -1000,  -288,  -103,  -161,  -321,  -219,  -279, -1000, -1000,
+   125, -1000,   131,  -275,  -151,  -214, -1000,  -172, -1000,  -301,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,   -42, -1000, -1000,   -42,   -42,   -42,   -42,
+  -128, -1000, -1000, -1000, -1000, -1000,   -42,   -42,   -42,   -42,
+   -42,   -42,   -42,   -42,  -303, -1000,   -84,  -118,  -133,  -290,
+  -125,   -42,  -125,   -42, -1000, -1000, -1000,   -42,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,    60,    60,    60,    60,    60,    60,    60,    60,
+    60,    60,   -42,  -256,   -42,  -108, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+  -219, -1000,  -300, -1000,  -361,  -331,  -339, -1000, -1000, -1000,
+ -1000,  -131,  -195,  -157,  -137,  -162,  -177,  -219,  -112, -1000,
+ -1000, -1000,  -125,  -292,  -303,  -182,  -308,  -265, -1000,  -279,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,  -186, -1000,  -275,  -275,  -275,  -275,  -275,
+  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -275,  -151,
+  -151,  -214,  -214,  -214,  -214, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,  -340,  -257, -1000,  -348, -1000,  -310, -1000,
+ -1000,   -42, -1000,   -42, -1000,   -42,   -42,  -352,   -42,   -42,
+   -42, -1000,  -294,  -327, -1000, -1000, -1000, -1000,    60, -1000,
+   -42, -1000, -1000, -1000, -1000,   -42, -1000, -1000, -1000,  -219,
+  -192,  -144,  -219,  -219,  -219, -1000,  -343, -1000,  -284, -1000,
+   -42,  -350, -1000,  -318,  -255, -1000, -1000,  -219, -1000,  -144,
+   -42,   -42, -1000,  -219,  -219 };
+int yypgo[]={
+
+     0,   264,   186,   262,   260,   256,   254,   252,   251,   247,
+   189,   246,   192,   244,   174,   241,   240,   239,   236,   235,
+   231,   228,   227,   226,   191,   391,   169,   483,   225,    80,
+   212,   399,   167,   327,   316,   210,   526,   208,   205,   203,
+   200,   197,   195,   193,   188,   187,   185,   181,    75,   179,
+   178,    74,   177 };
+int yyr1[]={
+
+     0,     1,     2,     2,     3,     3,     3,     3,     3,     8,
+     9,     9,    10,    10,    10,     7,    11,    11,    12,    12,
+    13,     6,    15,     4,    16,    16,     5,    21,    17,    22,
+    22,    22,    14,    14,    18,    18,    23,    23,    19,    19,
+    20,    20,    25,    25,    24,    24,    26,    26,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    27,    27,    27,    27,    27,    27,    27,    27,    27,
+    27,    28,    28,    28,    29,    29,    30,    30,    30,    30,
+    30,    30,    30,    30,    30,    30,    30,    30,    30,    30,
+    30,    31,    31,    31,    32,    32,    32,    32,    32,    33,
+    33,    33,    33,    33,    34,    34,    35,    35,    35,    35,
+    36,    36,    36,    36,    36,    36,    36,    36,    36,    36,
+    36,    36,    36,    36,    36,    36,    36,    36,    36,    36,
+    36,    36,    36,    36,    36,    37,    37,    37,    37,    37,
+    37,    37,    37,    37,    37,    37,    37,    37,    37,    37,
+    37,    37,    37,    37,    37,    37,    37,    37,    43,    43,
+    44,    44,    45,    45,    46,    40,    40,    40,    40,    41,
+    41,    42,    50,    50,    51,    51,    47,    47,    49,    49,
+    38,    38,    38,    38,    39,    52,    52,    52,    48,    48,
+     1,     5,    24 };
+int yyr2[]={
+
+     0,     5,     0,     4,     3,     3,     3,     3,     3,     5,
+     2,     7,     3,     3,     7,     5,     2,     7,     3,     3,
+     1,     7,     1,    13,     1,     3,    13,     1,    13,     1,
+     3,     7,     3,     7,     1,     9,     3,     3,     1,     7,
+     1,     7,     1,     2,     2,     7,     2,     7,     2,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     2,     7,    11,     2,     7,     2,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     7,     7,     7,     7,
+     7,     2,     7,     7,     2,     7,     7,     7,     7,     2,
+     7,     7,     7,     7,     2,     7,     2,     7,     7,     7,
+     2,     5,     5,     5,     5,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     5,     3,     3,     5,     7,     7,
+     7,     9,     7,     9,     9,     7,     5,     5,     5,     9,
+     5,     9,     5,     9,     5,     3,     5,     5,     9,     9,
+    13,    13,     2,     7,     7,     7,     3,     7,     3,     7,
+     3,     3,     3,     3,    13,     3,     3,     3,     2,     7,
+     6,     8,     2 };
+int yychk[]={
+
+ -1000,    -1,    -2,   256,   262,    -3,    -4,    -5,    -6,    -7,
+    -8,   283,   -17,   273,   277,   276,   282,    -2,   257,   363,
+   256,   -13,   -11,   -12,   257,   260,    -9,   -10,   257,   260,
+   257,   262,   -15,   -18,   -20,   -25,   -24,   -26,   256,   -27,
+   -28,   -29,   -30,   -31,   -32,   -33,   -34,   -35,   -36,   -37,
+   340,   280,   345,   346,   348,   309,   292,   307,   301,   297,
+   310,   343,   299,   350,   305,   324,   351,   326,   353,   328,
+   303,   338,   355,   342,   -38,   -39,   -40,   -41,   -42,   -43,
+   -44,   -45,   -46,   266,   257,   279,   263,   357,   366,   364,
+   295,   258,   259,   260,   261,   272,   285,   287,   274,   265,
+   291,   290,   271,   284,   -14,   257,   360,   360,   362,   -21,
+   357,   -19,   -23,   275,   278,   286,   270,   363,   295,   338,
+   313,   312,   317,   316,   347,   349,   308,   304,   302,   306,
+   298,   300,   311,   294,   344,   325,   329,   333,   331,   323,
+   315,   352,   356,   327,   337,   335,   321,   319,   354,   339,
+   296,   341,   289,   345,   326,   336,   334,   320,   318,   353,
+   324,   332,   330,   322,   314,   351,   328,   355,   346,   348,
+   301,   307,   303,   305,   297,   299,   310,   293,   343,   342,
+   340,   292,   364,   366,   357,   309,   -36,   -36,   -36,   -36,
+   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,
+   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,   -36,
+   -24,   -25,   -47,   -25,   -48,   -25,   -47,   272,   257,   -25,
+   -25,   -24,   -24,   -24,   -24,   -24,   -24,   -24,   360,   -12,
+   -10,   258,   357,   -16,   -14,   -20,   -14,   -24,   -20,   -26,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,   -27,
+   -27,   -27,   -27,   -29,   -29,   -31,   -31,   -31,   -31,   -31,
+   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -31,   -32,
+   -32,   -33,   -33,   -33,   -33,   -34,   -34,   -34,   -34,   -34,
+   -36,   -36,   -36,   -47,   -24,   367,   -49,   -25,   -47,   257,
+   358,   360,   367,   363,   365,   268,   288,   281,   268,   268,
+   268,   257,   -22,   -14,   358,   270,   363,   363,   264,   365,
+   -52,   362,   359,   361,   367,   360,   358,   -25,   -48,   -24,
+   -24,   366,   -24,   -24,   -24,   358,   364,   -29,   -24,   -25,
+   269,   -50,   -51,   267,   -24,   365,   365,   -24,   367,   363,
+   362,   362,   -51,   -24,   -24 };
+int yydef[]={
+
+    -2,    -2,     0,     2,     1,     3,     4,     5,     6,     7,
+     8,     0,     0,    20,     0,     0,     0,     0,    22,    34,
+    -2,     0,    15,    16,    18,    19,     9,    10,    12,    13,
+    27,   200,     0,    38,     0,     0,    43,    44,   202,    46,
+    48,    81,    84,    86,   101,   104,   109,   114,   116,   120,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,   145,   146,   147,   148,   149,   150,
+   151,   152,   153,     0,   155,   156,    -2,    -2,    -2,    -2,
+     0,   190,   191,   192,   193,   175,    -2,    -2,     0,     0,
+     0,     0,     0,     0,    21,    32,     0,     0,     0,     0,
+    24,    -2,     0,     0,    36,    37,   201,    -2,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,    -2,    -2,    -2,     0,   121,   122,   123,   124,
+   125,   126,   127,   128,   129,   130,   131,   132,   133,   134,
+   135,   136,   137,   138,   139,   140,   141,   142,   143,   144,
+   154,   157,     0,   186,     0,   198,     0,   166,   167,   176,
+   177,    43,     0,     0,   168,   170,   172,   174,     0,    17,
+    11,    14,    29,     0,    25,     0,     0,     0,    41,    45,
+    47,    49,    50,    51,    52,    53,    54,    55,    56,    57,
+    58,    59,    60,    61,    62,    63,    64,    65,    66,    67,
+    68,    69,    70,    71,    72,    73,    74,    75,    76,    77,
+    78,    79,    80,    82,    85,    87,    88,    89,    90,    91,
+    92,    93,    94,    95,    96,    97,    98,    99,   100,   102,
+   103,   105,   106,   107,   108,   110,   111,   112,   113,   115,
+   117,   118,   119,     0,    43,   162,     0,   188,     0,   165,
+   158,    -2,   159,    -2,   160,     0,     0,     0,     0,     0,
+     0,    33,     0,    30,    23,    26,    35,    39,     0,   161,
+     0,   195,   196,   197,   163,    -2,   164,   187,   199,   178,
+   179,     0,   169,   171,   173,    28,     0,    83,     0,   189,
+     0,     0,   182,     0,     0,    31,   194,   180,   181,     0,
+     0,     0,   183,   184,   185 };
+typedef struct { char *t_name; int t_val; } yytoktype;
+#ifndef YYDEBUG
+#	define YYDEBUG	0	/* don't allow debugging */
+#endif
+
+#if YYDEBUG
+
+yytoktype yytoks[] =
+{
+	"IDENT",	257,
+	"INTLIT",	258,
+	"REALLIT",	259,
+	"STRINGLIT",	260,
+	"CSETLIT",	261,
+	"EOFX",	262,
+	"BREAK",	263,
+	"BY",	264,
+	"CASE",	265,
+	"CREATE",	266,
+	"DEFAULT",	267,
+	"DO",	268,
+	"ELSE",	269,
+	"END",	270,
+	"EVERY",	271,
+	"FAIL",	272,
+	"GLOBAL",	273,
+	"IF",	274,
+	"INITIAL",	275,
+	"INVOCABLE",	276,
+	"LINK",	277,
+	"LOCAL",	278,
+	"NEXT",	279,
+	"NOT",	280,
+	"OF",	281,
+	"PROCEDURE",	282,
+	"RECORD",	283,
+	"REPEAT",	284,
+	"RETURN",	285,
+	"STATIC",	286,
+	"SUSPEND",	287,
+	"THEN",	288,
+	"TO",	289,
+	"UNTIL",	290,
+	"WHILE",	291,
+	"BANG",	292,
+	"MOD",	293,
+	"AUGMOD",	294,
+	"AND",	295,
+	"AUGAND",	296,
+	"STAR",	297,
+	"AUGSTAR",	298,
+	"INTER",	299,
+	"AUGINTER",	300,
+	"PLUS",	301,
+	"AUGPLUS",	302,
+	"UNION",	303,
+	"AUGUNION",	304,
+	"MINUS",	305,
+	"AUGMINUS",	306,
+	"DIFF",	307,
+	"AUGDIFF",	308,
+	"DOT",	309,
+	"SLASH",	310,
+	"AUGSLASH",	311,
+	"ASSIGN",	312,
+	"SWAP",	313,
+	"NMLT",	314,
+	"AUGNMLT",	315,
+	"REVASSIGN",	316,
+	"REVSWAP",	317,
+	"SLT",	318,
+	"AUGSLT",	319,
+	"SLE",	320,
+	"AUGSLE",	321,
+	"NMLE",	322,
+	"AUGNMLE",	323,
+	"NMEQ",	324,
+	"AUGNMEQ",	325,
+	"SEQ",	326,
+	"AUGSEQ",	327,
+	"EQUIV",	328,
+	"AUGEQUIV",	329,
+	"NMGT",	330,
+	"AUGNMGT",	331,
+	"NMGE",	332,
+	"AUGNMGE",	333,
+	"SGT",	334,
+	"AUGSGT",	335,
+	"SGE",	336,
+	"AUGSGE",	337,
+	"QMARK",	338,
+	"AUGQMARK",	339,
+	"AT",	340,
+	"AUGAT",	341,
+	"BACKSLASH",	342,
+	"CARET",	343,
+	"AUGCARET",	344,
+	"BAR",	345,
+	"CONCAT",	346,
+	"AUGCONCAT",	347,
+	"LCONCAT",	348,
+	"AUGLCONCAT",	349,
+	"TILDE",	350,
+	"NMNE",	351,
+	"AUGNMNE",	352,
+	"SNE",	353,
+	"AUGSNE",	354,
+	"NEQUIV",	355,
+	"AUGNEQUIV",	356,
+	"LPAREN",	357,
+	"RPAREN",	358,
+	"PCOLON",	359,
+	"COMMA",	360,
+	"MCOLON",	361,
+	"COLON",	362,
+	"SEMICOL",	363,
+	"LBRACK",	364,
+	"RBRACK",	365,
+	"LBRACE",	366,
+	"RBRACE",	367,
+	"-unknown-",	-1	/* ends search */
+};
+
+char * yyreds[] =
+{
+	"-no such reduction-",
+	"program : decls EOFX",
+	"decls : /* empty */",
+	"decls : decls decl",
+	"decl : record",
+	"decl : proc",
+	"decl : global",
+	"decl : link",
+	"decl : invocable",
+	"invocable : INVOCABLE invoclist",
+	"invoclist : invocop",
+	"invoclist : invoclist COMMA invocop",
+	"invocop : IDENT",
+	"invocop : STRINGLIT",
+	"invocop : STRINGLIT COLON INTLIT",
+	"link : LINK lnklist",
+	"lnklist : lnkfile",
+	"lnklist : lnklist COMMA lnkfile",
+	"lnkfile : IDENT",
+	"lnkfile : STRINGLIT",
+	"global : GLOBAL",
+	"global : GLOBAL idlist",
+	"record : RECORD IDENT",
+	"record : RECORD IDENT LPAREN fldlist RPAREN",
+	"fldlist : /* empty */",
+	"fldlist : idlist",
+	"proc : prochead SEMICOL locals initial procbody END",
+	"prochead : PROCEDURE IDENT",
+	"prochead : PROCEDURE IDENT LPAREN arglist RPAREN",
+	"arglist : /* empty */",
+	"arglist : idlist",
+	"arglist : idlist LBRACK RBRACK",
+	"idlist : IDENT",
+	"idlist : idlist COMMA IDENT",
+	"locals : /* empty */",
+	"locals : locals retention idlist SEMICOL",
+	"retention : LOCAL",
+	"retention : STATIC",
+	"initial : /* empty */",
+	"initial : INITIAL expr SEMICOL",
+	"procbody : /* empty */",
+	"procbody : nexpr SEMICOL procbody",
+	"nexpr : /* empty */",
+	"nexpr : expr",
+	"expr : expr1a",
+	"expr : expr AND expr1a",
+	"expr1a : expr1",
+	"expr1a : expr1a QMARK expr1",
+	"expr1 : expr2",
+	"expr1 : expr2 SWAP expr1",
+	"expr1 : expr2 ASSIGN expr1",
+	"expr1 : expr2 REVSWAP expr1",
+	"expr1 : expr2 REVASSIGN expr1",
+	"expr1 : expr2 AUGCONCAT expr1",
+	"expr1 : expr2 AUGLCONCAT expr1",
+	"expr1 : expr2 AUGDIFF expr1",
+	"expr1 : expr2 AUGUNION expr1",
+	"expr1 : expr2 AUGPLUS expr1",
+	"expr1 : expr2 AUGMINUS expr1",
+	"expr1 : expr2 AUGSTAR expr1",
+	"expr1 : expr2 AUGINTER expr1",
+	"expr1 : expr2 AUGSLASH expr1",
+	"expr1 : expr2 AUGMOD expr1",
+	"expr1 : expr2 AUGCARET expr1",
+	"expr1 : expr2 AUGNMEQ expr1",
+	"expr1 : expr2 AUGEQUIV expr1",
+	"expr1 : expr2 AUGNMGE expr1",
+	"expr1 : expr2 AUGNMGT expr1",
+	"expr1 : expr2 AUGNMLE expr1",
+	"expr1 : expr2 AUGNMLT expr1",
+	"expr1 : expr2 AUGNMNE expr1",
+	"expr1 : expr2 AUGNEQUIV expr1",
+	"expr1 : expr2 AUGSEQ expr1",
+	"expr1 : expr2 AUGSGE expr1",
+	"expr1 : expr2 AUGSGT expr1",
+	"expr1 : expr2 AUGSLE expr1",
+	"expr1 : expr2 AUGSLT expr1",
+	"expr1 : expr2 AUGSNE expr1",
+	"expr1 : expr2 AUGQMARK expr1",
+	"expr1 : expr2 AUGAND expr1",
+	"expr1 : expr2 AUGAT expr1",
+	"expr2 : expr3",
+	"expr2 : expr2 TO expr3",
+	"expr2 : expr2 TO expr3 BY expr3",
+	"expr3 : expr4",
+	"expr3 : expr4 BAR expr3",
+	"expr4 : expr5",
+	"expr4 : expr4 SEQ expr5",
+	"expr4 : expr4 SGE expr5",
+	"expr4 : expr4 SGT expr5",
+	"expr4 : expr4 SLE expr5",
+	"expr4 : expr4 SLT expr5",
+	"expr4 : expr4 SNE expr5",
+	"expr4 : expr4 NMEQ expr5",
+	"expr4 : expr4 NMGE expr5",
+	"expr4 : expr4 NMGT expr5",
+	"expr4 : expr4 NMLE expr5",
+	"expr4 : expr4 NMLT expr5",
+	"expr4 : expr4 NMNE expr5",
+	"expr4 : expr4 EQUIV expr5",
+	"expr4 : expr4 NEQUIV expr5",
+	"expr5 : expr6",
+	"expr5 : expr5 CONCAT expr6",
+	"expr5 : expr5 LCONCAT expr6",
+	"expr6 : expr7",
+	"expr6 : expr6 PLUS expr7",
+	"expr6 : expr6 DIFF expr7",
+	"expr6 : expr6 UNION expr7",
+	"expr6 : expr6 MINUS expr7",
+	"expr7 : expr8",
+	"expr7 : expr7 STAR expr8",
+	"expr7 : expr7 INTER expr8",
+	"expr7 : expr7 SLASH expr8",
+	"expr7 : expr7 MOD expr8",
+	"expr8 : expr9",
+	"expr8 : expr9 CARET expr8",
+	"expr9 : expr10",
+	"expr9 : expr9 BACKSLASH expr10",
+	"expr9 : expr9 AT expr10",
+	"expr9 : expr9 BANG expr10",
+	"expr10 : expr11",
+	"expr10 : AT expr10",
+	"expr10 : NOT expr10",
+	"expr10 : BAR expr10",
+	"expr10 : CONCAT expr10",
+	"expr10 : LCONCAT expr10",
+	"expr10 : DOT expr10",
+	"expr10 : BANG expr10",
+	"expr10 : DIFF expr10",
+	"expr10 : PLUS expr10",
+	"expr10 : STAR expr10",
+	"expr10 : SLASH expr10",
+	"expr10 : CARET expr10",
+	"expr10 : INTER expr10",
+	"expr10 : TILDE expr10",
+	"expr10 : MINUS expr10",
+	"expr10 : NMEQ expr10",
+	"expr10 : NMNE expr10",
+	"expr10 : SEQ expr10",
+	"expr10 : SNE expr10",
+	"expr10 : EQUIV expr10",
+	"expr10 : UNION expr10",
+	"expr10 : QMARK expr10",
+	"expr10 : NEQUIV expr10",
+	"expr10 : BACKSLASH expr10",
+	"expr11 : literal",
+	"expr11 : section",
+	"expr11 : return",
+	"expr11 : if",
+	"expr11 : case",
+	"expr11 : while",
+	"expr11 : until",
+	"expr11 : every",
+	"expr11 : repeat",
+	"expr11 : CREATE expr",
+	"expr11 : IDENT",
+	"expr11 : NEXT",
+	"expr11 : BREAK nexpr",
+	"expr11 : LPAREN exprlist RPAREN",
+	"expr11 : LBRACE compound RBRACE",
+	"expr11 : LBRACK exprlist RBRACK",
+	"expr11 : expr11 LBRACK exprlist RBRACK",
+	"expr11 : expr11 LBRACE RBRACE",
+	"expr11 : expr11 LBRACE pdcolist RBRACE",
+	"expr11 : expr11 LPAREN exprlist RPAREN",
+	"expr11 : expr11 DOT IDENT",
+	"expr11 : AND FAIL",
+	"expr11 : AND IDENT",
+	"while : WHILE expr",
+	"while : WHILE expr DO expr",
+	"until : UNTIL expr",
+	"until : UNTIL expr DO expr",
+	"every : EVERY expr",
+	"every : EVERY expr DO expr",
+	"repeat : REPEAT expr",
+	"return : FAIL",
+	"return : RETURN nexpr",
+	"return : SUSPEND nexpr",
+	"return : SUSPEND expr DO expr",
+	"if : IF expr THEN expr",
+	"if : IF expr THEN expr ELSE expr",
+	"case : CASE expr OF LBRACE caselist RBRACE",
+	"caselist : cclause",
+	"caselist : caselist SEMICOL cclause",
+	"cclause : DEFAULT COLON expr",
+	"cclause : expr COLON expr",
+	"exprlist : nexpr",
+	"exprlist : exprlist COMMA nexpr",
+	"pdcolist : nexpr",
+	"pdcolist : pdcolist COMMA nexpr",
+	"literal : INTLIT",
+	"literal : REALLIT",
+	"literal : STRINGLIT",
+	"literal : CSETLIT",
+	"section : expr11 LBRACK expr sectop expr RBRACK",
+	"sectop : COLON",
+	"sectop : PCOLON",
+	"sectop : MCOLON",
+	"compound : nexpr",
+	"compound : nexpr SEMICOL compound",
+	"program : error decls EOFX",
+	"proc : prochead error procbody END",
+	"expr : error",
+};
+#endif
+#line 1 "/usr/lib/yaccpar"
+/*	@(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10	*/
+
+/*
+** Skeleton parser driver for yacc output
+*/
+
+/*
+** yacc user known macros and defines
+*/
+#define YYERROR		goto yyerrlab
+#define YYACCEPT	{ free(yys); free(yyv); return(0); }
+#define YYABORT		{ free(yys); free(yyv); return(1); }
+#define YYBACKUP( newtoken, newvalue )\
+{\
+	if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
+	{\
+		tsyserr("parser: syntax error - cannot backup" );\
+		goto yyerrlab;\
+	}\
+	yychar = newtoken;\
+	yystate = *yyps;\
+	yylval = newvalue;\
+	goto yynewstate;\
+}
+#define YYRECOVERING()	(!!yyerrflag)
+#ifndef YYDEBUG
+#	define YYDEBUG	1	/* make debugging available */
+#endif
+
+/*
+** user known globals
+*/
+int yydebug;			/* set to 1 to get debugging */
+
+/*
+** driver internal defines
+*/
+#define YYFLAG		(-1000)
+
+/*
+** static variables used by the parser
+*/
+static YYSTYPE *yyv;			/* value stack */
+static int *yys;			/* state stack */
+
+static YYSTYPE *yypv;			/* top of value stack */
+static int *yyps;			/* top of state stack */
+
+static int yystate;			/* current state */
+static int yytmp;			/* extra var (lasts between blocks) */
+
+int yynerrs;			/* number of errors */
+
+int yyerrflag;			/* error recovery flag */
+int yychar;			/* current input token number */
+
+
+/*
+** yyparse - return 0 if worked, 1 if syntax error not recovered from
+*/
+int
+yyparse()
+{
+	register YYSTYPE *yypvt;	/* top of value stack for $vars */
+	unsigned yymaxdepth = YYMAXDEPTH;
+
+	/*
+	** Initialize externals - yyparse may be called more than once
+	*/
+	yyv = (YYSTYPE*)malloc(yymaxdepth*sizeof(YYSTYPE));
+	yys = (int*)malloc(yymaxdepth*sizeof(int));
+	if (!yyv || !yys)
+	{
+		tsyserr("parser: out of memory" );
+		return(1);
+	}
+	yypv = &yyv[-1];
+	yyps = &yys[-1];
+	yystate = 0;
+	yytmp = 0;
+	yynerrs = 0;
+	yyerrflag = 0;
+	yychar = -1;
+
+	goto yystack;
+	{
+		register YYSTYPE *yy_pv;	/* top of value stack */
+		register int *yy_ps;		/* top of state stack */
+		register int yy_state;		/* current state */
+		register int  yy_n;		/* internal state number info */
+
+		/*
+		** get globals into registers.
+		** branch to here only if YYBACKUP was called.
+		*/
+	yynewstate:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+		goto yy_newstate;
+
+		/*
+		** get globals into registers.
+		** either we just started, or we just finished a reduction
+		*/
+	yystack:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+
+		/*
+		** top of for (;;) loop while no reductions done
+		*/
+	yy_stack:
+		/*
+		** put a state and value onto the stacks
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, look up token value in list of value vs.
+		** name pairs.  0 and negative (-1) are special values.
+		** Note: linear search is used since time is not a real
+		** consideration while debugging.
+		*/
+		if ( yydebug )
+		{
+			register int yy_i;
+
+			(void)printf( "State %d, token ", yy_state );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif
+		if ( ++yy_ps >= &yys[ yymaxdepth ] )	/* room on stack? */
+		{
+			/*
+			** reallocate and recover.  Note that pointers
+			** have to be reset, or bad things will happen
+			*/
+			int yyps_index = (yy_ps - yys);
+			int yypv_index = (yy_pv - yyv);
+			int yypvt_index = (yypvt - yyv);
+			yymaxdepth += YYMAXDEPTH;
+			yyv = (YYSTYPE*)realloc((char*)yyv,
+				yymaxdepth * sizeof(YYSTYPE));
+			yys = (int*)realloc((char*)yys,
+				yymaxdepth * sizeof(int));
+			if (!yyv || !yys)
+			{
+				tsyserr("parse stack overflow" );
+				return(1);
+			}
+			yy_ps = yys + yyps_index;
+			yy_pv = yyv + yypv_index;
+			yypvt = yyv + yypvt_index;
+		}
+		*yy_ps = yy_state;
+		*++yy_pv = yyval;
+
+		/*
+		** we have a new state - find out what to do
+		*/
+	yy_newstate:
+		if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
+			goto yydefault;		/* simple state */
+#if YYDEBUG
+		/*
+		** if debugging, need to mark whether new token grabbed
+		*/
+		yytmp = yychar < 0;
+#endif
+		if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+			yychar = 0;		/* reached EOF */
+#if YYDEBUG
+		if ( yydebug && yytmp )
+		{
+			register int yy_i;
+
+			(void)printf( "Received token " );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif
+		if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
+			goto yydefault;
+		if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar )	/*valid shift*/
+		{
+			yychar = -1;
+			yyval = yylval;
+			yy_state = yy_n;
+			if ( yyerrflag > 0 )
+				yyerrflag--;
+			goto yy_stack;
+		}
+
+	yydefault:
+		if ( ( yy_n = yydef[ yy_state ] ) == -2 )
+		{
+#if YYDEBUG
+			yytmp = yychar < 0;
+#endif
+			if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+				yychar = 0;		/* reached EOF */
+#if YYDEBUG
+			if ( yydebug && yytmp )
+			{
+				register int yy_i;
+
+				(void)printf( "Received token " );
+				if ( yychar == 0 )
+					(void)printf( "end-of-file\n" );
+				else if ( yychar < 0 )
+					(void)printf( "-none-\n" );
+				else
+				{
+					for ( yy_i = 0;
+						yytoks[yy_i].t_val >= 0;
+						yy_i++ )
+					{
+						if ( yytoks[yy_i].t_val
+							== yychar )
+						{
+							break;
+						}
+					}
+					(void)printf( "%s\n", yytoks[yy_i].t_name );
+				}
+			}
+#endif
+			/*
+			** look through exception table
+			*/
+			{
+				register int *yyxi = yyexca;
+
+				while ( ( *yyxi != -1 ) ||
+					( yyxi[1] != yy_state ) )
+				{
+					yyxi += 2;
+				}
+				while ( ( *(yyxi += 2) >= 0 ) &&
+					( *yyxi != yychar ) )
+					;
+				if ( ( yy_n = yyxi[1] ) < 0 )
+					YYACCEPT;
+			}
+		}
+
+		/*
+		** check for syntax error
+		*/
+		if ( yy_n == 0 )	/* have an error */
+		{
+			/* no worry about speed here! */
+			switch ( yyerrflag )
+			{
+			case 0:		/* new error */
+				yyerror(yychar, yylval, yy_state );
+				goto skip_init;
+			yyerrlab:
+				/*
+				** get globals into registers.
+				** we have a user generated syntax type error
+				*/
+				yy_pv = yypv;
+				yy_ps = yyps;
+				yy_state = yystate;
+				yynerrs++;
+			skip_init:
+			case 1:
+			case 2:		/* incompletely recovered error */
+					/* try again... */
+				yyerrflag = 3;
+				/*
+				** find state where "error" is a legal
+				** shift action
+				*/
+				while ( yy_ps >= yys )
+				{
+					yy_n = yypact[ *yy_ps ] + YYERRCODE;
+					if ( yy_n >= 0 && yy_n < YYLAST &&
+						yychk[yyact[yy_n]] == YYERRCODE)					{
+						/*
+						** simulate shift of "error"
+						*/
+						yy_state = yyact[ yy_n ];
+						goto yy_stack;
+					}
+					/*
+					** current state has no shift on
+					** "error", pop stack
+					*/
+#if YYDEBUG
+#	define _POP_ "Error recovery pops state %d, uncovers state %d\n"
+					if ( yydebug )
+						(void)printf( _POP_, *yy_ps,
+							yy_ps[-1] );
+#	undef _POP_
+#endif
+					yy_ps--;
+					yy_pv--;
+				}
+				/*
+				** there is no state on stack with "error" as
+				** a valid shift.  give up.
+				*/
+				YYABORT;
+			case 3:		/* no shift yet; eat a token */
+#if YYDEBUG
+				/*
+				** if debugging, look up token in list of
+				** pairs.  0 and negative shouldn't occur,
+				** but since timing doesn't matter when
+				** debugging, it doesn't hurt to leave the
+				** tests here.
+				*/
+				if ( yydebug )
+				{
+					register int yy_i;
+
+					(void)printf( "Error recovery discards " );
+					if ( yychar == 0 )
+						(void)printf( "token end-of-file\n" );
+					else if ( yychar < 0 )
+						(void)printf( "token -none-\n" );
+					else
+					{
+						for ( yy_i = 0;
+							yytoks[yy_i].t_val >= 0;
+							yy_i++ )
+						{
+							if ( yytoks[yy_i].t_val
+								== yychar )
+							{
+								break;
+							}
+						}
+						(void)printf( "token %s\n",
+							yytoks[yy_i].t_name );
+					}
+				}
+#endif
+				if ( yychar == 0 )	/* reached EOF. quit */
+					YYABORT;
+				yychar = -1;
+				goto yy_newstate;
+			}
+		}/* end if ( yy_n == 0 ) */
+		/*
+		** reduction by production yy_n
+		** put stack tops, etc. so things right after switch
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, print the string that is the user's
+		** specification of the reduction which is just about
+		** to be done.
+		*/
+		if ( yydebug )
+			(void)printf( "Reduce by (%d) \"%s\"\n",
+				yy_n, yyreds[ yy_n ] );
+#endif
+		yytmp = yy_n;			/* value to switch over */
+		yypvt = yy_pv;			/* $vars top of value stack */
+		/*
+		** Look in goto table for next state
+		** Sorry about using yy_state here as temporary
+		** register variable, but why not, if it works...
+		** If yyr2[ yy_n ] doesn't have the low order bit
+		** set, then there is no action to be done for
+		** this reduction.  So, no saving & unsaving of
+		** registers done.  The only difference between the
+		** code just after the if and the body of the if is
+		** the goto yy_stack in the body.  This way the test
+		** can be made before the choice of what to do is needed.
+		*/
+		{
+			/* length of production doubled with extra bit */
+			register int yy_len = yyr2[ yy_n ];
+
+			if ( !( yy_len & 01 ) )
+			{
+				yy_len >>= 1;
+				yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+				yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+					*( yy_ps -= yy_len ) + 1;
+				if ( yy_state >= YYLAST ||
+					yychk[ yy_state =
+					yyact[ yy_state ] ] != -yy_n )
+				{
+					yy_state = yyact[ yypgo[ yy_n ] ];
+				}
+				goto yy_stack;
+			}
+			yy_len >>= 1;
+			yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+			yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+				*( yy_ps -= yy_len ) + 1;
+			if ( yy_state >= YYLAST ||
+				yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
+			{
+				yy_state = yyact[ yypgo[ yy_n ] ];
+			}
+		}
+					/* save until reenter driver code */
+		yystate = yy_state;
+		yyps = yy_ps;
+		yypv = yy_pv;
+	}
+	/*
+	** code supplied by user is placed in this switch
+	*/
+	switch( yytmp )
+	{
+		
+case 1:
+# line 177 "cgram.g"
+{;} break;
+case 4:
+# line 182 "cgram.g"
+{;} break;
+case 5:
+# line 183 "cgram.g"
+{proc_lst->tree = yypvt[-0] ;} break;
+case 6:
+# line 184 "cgram.g"
+{;} break;
+case 7:
+# line 185 "cgram.g"
+{;} break;
+case 8:
+# line 186 "cgram.g"
+{;} break;
+case 9:
+# line 188 "cgram.g"
+{;} break;
+case 11:
+# line 191 "cgram.g"
+{;} break;
+case 12:
+# line 193 "cgram.g"
+{invoc_grp(Str0(yypvt[-0])); ;} break;
+case 13:
+# line 194 "cgram.g"
+{invocbl(yypvt[-0], -1); ;} break;
+case 14:
+# line 195 "cgram.g"
+{invocbl(yypvt[-2], atoi(Str0(yypvt[-0]))); ;} break;
+case 15:
+# line 197 "cgram.g"
+{;} break;
+case 17:
+# line 200 "cgram.g"
+{;} break;
+case 18:
+# line 202 "cgram.g"
+{lnkdcl(Str0(yypvt[-0])); ;} break;
+case 19:
+# line 203 "cgram.g"
+{lnkdcl(Str0(yypvt[-0])); ;} break;
+case 20:
+# line 205 "cgram.g"
+{idflag = F_Global ;} break;
+case 21:
+# line 205 "cgram.g"
+{;} break;
+case 22:
+# line 207 "cgram.g"
+{init_rec(Str0(yypvt[-0])); idflag = F_Field ;} break;
+case 23:
+# line 207 "cgram.g"
+{
+		 ;
+		} break;
+case 24:
+# line 211 "cgram.g"
+{;} break;
+case 25:
+# line 212 "cgram.g"
+{;} break;
+case 26:
+# line 214 "cgram.g"
+{
+		yyval = tree6(N_Proc,yypvt[-5],yypvt[-5],yypvt[-2],yypvt[-1],yypvt[-0]) ;
+		} break;
+case 27:
+# line 218 "cgram.g"
+{init_proc(Str0(yypvt[-0]));	idflag = F_Argument ;} break;
+case 28:
+# line 218 "cgram.g"
+{
+		 ;
+		} break;
+case 29:
+# line 222 "cgram.g"
+{;} break;
+case 30:
+# line 223 "cgram.g"
+{;} break;
+case 31:
+# line 224 "cgram.g"
+{proc_lst->nargs = -proc_lst->nargs ;} break;
+case 32:
+# line 227 "cgram.g"
+{
+		install(Str0(yypvt[-0]),idflag) ;
+		} break;
+case 33:
+# line 230 "cgram.g"
+{
+		install(Str0(yypvt[-0]),idflag) ;
+		} break;
+case 34:
+# line 234 "cgram.g"
+{;} break;
+case 35:
+# line 235 "cgram.g"
+{;} break;
+case 36:
+# line 237 "cgram.g"
+{idflag = F_Dynamic ;} break;
+case 37:
+# line 238 "cgram.g"
+{idflag = F_Static ;} break;
+case 38:
+# line 240 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 39:
+# line 241 "cgram.g"
+{yyval = yypvt[-1] ;} break;
+case 40:
+# line 243 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 41:
+# line 244 "cgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 42:
+# line 246 "cgram.g"
+{yyval = tree1(N_Empty)  ;} break;
+case 45:
+# line 250 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 47:
+# line 253 "cgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 49:
+# line 256 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 50:
+# line 257 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 51:
+# line 258 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 52:
+# line 259 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 53:
+# line 260 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 54:
+# line 261 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 55:
+# line 262 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 56:
+# line 263 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 57:
+# line 264 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 58:
+# line 265 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 59:
+# line 266 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 60:
+# line 267 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 61:
+# line 268 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 62:
+# line 269 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 63:
+# line 270 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 64:
+# line 271 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 65:
+# line 272 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 66:
+# line 273 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 67:
+# line 274 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 68:
+# line 275 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 69:
+# line 276 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 70:
+# line 277 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 71:
+# line 278 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 72:
+# line 279 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 73:
+# line 280 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 74:
+# line 281 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 75:
+# line 282 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 76:
+# line 283 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 77:
+# line 284 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 78:
+# line 285 "cgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 79:
+# line 286 "cgram.g"
+{yyval = aug_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 80:
+# line 287 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 82:
+# line 290 "cgram.g"
+{yyval = to_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 83:
+# line 291 "cgram.g"
+{yyval = toby_nd(yypvt[-3],yypvt[-4],yypvt[-2],yypvt[-0]) ;} break;
+case 85:
+# line 294 "cgram.g"
+{yyval = tree4(N_Alt,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 87:
+# line 297 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 88:
+# line 298 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 89:
+# line 299 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 90:
+# line 300 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 91:
+# line 301 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 92:
+# line 302 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 93:
+# line 303 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 94:
+# line 304 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 95:
+# line 305 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 96:
+# line 306 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 97:
+# line 307 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 98:
+# line 308 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 99:
+# line 309 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 100:
+# line 310 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 102:
+# line 313 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 103:
+# line 314 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 105:
+# line 317 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 106:
+# line 318 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 107:
+# line 319 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 108:
+# line 320 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 110:
+# line 323 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 111:
+# line 324 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 112:
+# line 325 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 113:
+# line 326 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 115:
+# line 329 "cgram.g"
+{yyval = binary_nd(yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 117:
+# line 332 "cgram.g"
+{yyval = tree4(N_Limit,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 118:
+# line 333 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 119:
+# line 334 "cgram.g"
+{yyval = tree4(N_Apply,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 121:
+# line 337 "cgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],tree1(N_Empty) ,yypvt[-0]) ;} break;
+case 122:
+# line 338 "cgram.g"
+{yyval = tree3(N_Not,yypvt[-0],yypvt[-0]) ;} break;
+case 123:
+# line 339 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 124:
+# line 340 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 125:
+# line 341 "cgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]) ;} break;
+case 126:
+# line 342 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 127:
+# line 343 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 128:
+# line 344 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 129:
+# line 345 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 130:
+# line 346 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 131:
+# line 347 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 132:
+# line 348 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 133:
+# line 349 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 134:
+# line 350 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 135:
+# line 351 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 136:
+# line 352 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 137:
+# line 353 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 138:
+# line 354 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 139:
+# line 355 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 140:
+# line 356 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 141:
+# line 357 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 142:
+# line 358 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 143:
+# line 359 "cgram.g"
+{yyval = MultiUnary(yypvt[-1],yypvt[-0]) ;} break;
+case 144:
+# line 360 "cgram.g"
+{yyval = unary_nd(yypvt[-1],yypvt[-0]) ;} break;
+case 154:
+# line 371 "cgram.g"
+{yyval = tree3(N_Create,yypvt[-1],yypvt[-0]);	proc_lst->has_coexpr = 1; ;} break;
+case 155:
+# line 372 "cgram.g"
+{LSym0(yypvt[-0]) = putloc(Str0(yypvt[-0]),0) ;} break;
+case 156:
+# line 373 "cgram.g"
+{yyval = tree2(N_Next,yypvt[-0]) ;} break;
+case 157:
+# line 374 "cgram.g"
+{yyval = tree3(N_Break,yypvt[-1],yypvt[-0]) ;} break;
+case 158:
+# line 375 "cgram.g"
+{if ((yypvt[-1])->n_type == N_Elist) yyval = invk_nd(yypvt[-2],tree1(N_Empty) ,yypvt[-1]); else yyval = yypvt[-1] ;} break;
+case 159:
+# line 376 "cgram.g"
+{yyval = yypvt[-1] ;} break;
+case 160:
+# line 377 "cgram.g"
+{yyval = list_nd(yypvt[-2],yypvt[-1]) ;} break;
+case 161:
+# line 378 "cgram.g"
+{yyval = buildarray(yypvt[-3],yypvt[-2],yypvt[-1]) ;} break;
+case 162:
+# line 379 "cgram.g"
+{yyval = invk_nd(yypvt[-1],yypvt[-2],list_nd(yypvt[-1],tree1(N_Empty) )) ;} break;
+case 163:
+# line 380 "cgram.g"
+{yyval = invk_nd(yypvt[-2],yypvt[-3],list_nd(yypvt[-2],yypvt[-1])) ;} break;
+case 164:
+# line 381 "cgram.g"
+{yyval = invk_nd(yypvt[-2],yypvt[-3],yypvt[-1]) ;} break;
+case 165:
+# line 382 "cgram.g"
+{yyval = tree4(N_Field,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 166:
+# line 383 "cgram.g"
+{yyval = key_leaf(yypvt[-1],spec_str("fail")) ;} break;
+case 167:
+# line 384 "cgram.g"
+{yyval = key_leaf(yypvt[-1],Str0(yypvt[-0])) ;} break;
+case 168:
+# line 386 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 169:
+# line 387 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 170:
+# line 389 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 171:
+# line 390 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 172:
+# line 392 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 173:
+# line 393 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 174:
+# line 395 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 175:
+# line 397 "cgram.g"
+{yyval = tree4(N_Ret,yypvt[-0],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 176:
+# line 398 "cgram.g"
+{yyval = tree4(N_Ret,yypvt[-1],yypvt[-1],yypvt[-0]) ;} break;
+case 177:
+# line 399 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 178:
+# line 400 "cgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]) ;} break;
+case 179:
+# line 402 "cgram.g"
+{yyval = tree5(N_If,yypvt[-3],yypvt[-2],yypvt[-0],tree1(N_Empty) ) ;} break;
+case 180:
+# line 403 "cgram.g"
+{yyval = tree5(N_If,yypvt[-5],yypvt[-4],yypvt[-2],yypvt[-0]) ;} break;
+case 181:
+# line 405 "cgram.g"
+{yyval = case_nd(yypvt[-5],yypvt[-4],yypvt[-1]) ;} break;
+case 183:
+# line 408 "cgram.g"
+{yyval = tree4(N_Clist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 184:
+# line 410 "cgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 185:
+# line 411 "cgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+case 186:
+# line 413 "cgram.g"
+{yyval = yypvt[-0]; ;} break;
+case 187:
+# line 414 "cgram.g"
+{yyval = tree4(N_Elist,yypvt[-1],yypvt[-2],yypvt[-0]); ;} break;
+case 188:
+# line 416 "cgram.g"
+{
+		yyval = tree3(N_Create,yypvt[-0],yypvt[-0]);	proc_lst->has_coexpr = 1; ;
+		} break;
+case 189:
+# line 419 "cgram.g"
+{
+		yyval =tree4(N_Elist,yypvt[-1],yypvt[-2],tree3(N_Create,yypvt[-1],yypvt[-0]));	proc_lst->has_coexpr = 1; ;
+		} break;
+case 190:
+# line 423 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_IntLit,0) ;} break;
+case 191:
+# line 424 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_RealLit,0) ;} break;
+case 192:
+# line 425 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_StrLit,(int)Val1(yypvt[-0])) ;} break;
+case 193:
+# line 426 "cgram.g"
+{CSym0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_CsetLit,(int)Val1(yypvt[-0])) ;} break;
+case 194:
+# line 428 "cgram.g"
+{yyval = sect_nd(yypvt[-2],yypvt[-5],yypvt[-3],yypvt[-1]) ;} break;
+case 195:
+# line 430 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 196:
+# line 431 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 197:
+# line 432 "cgram.g"
+{yyval = yypvt[-0] ;} break;
+case 199:
+# line 435 "cgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]) ;} break;
+	}
+	goto yystack;		/* reset registers in driver code */
+}
diff --git a/src/iconc/cproto.h b/src/iconc/cproto.h
new file mode 100644
index 0000000..a32b982
--- /dev/null
+++ b/src/iconc/cproto.h
@@ -0,0 +1,165 @@
+/*
+ * Prototypes for functions in iconc.
+ */
+struct sig_lst   *add_sig    (struct code *sig, struct c_fnc *fnc);
+void           addlib     (char *libname);
+struct code      *alc_ary    (int n);
+int               alc_cbufs  (int num, nodeptr lifetime);
+int               alc_dtmp   (nodeptr lifetime);
+int               alc_itmp   (nodeptr lifetime);
+struct code      *alc_lbl    (char *desc, int flag);
+int               alc_sbufs  (int num, nodeptr lifetime);
+#ifdef OptimizeType
+unsigned int   *alloc_mem_typ   (unsigned int n_types);
+#endif					/* OptimizeType */
+void           arth_anlz  (struct il_code *var1, struct il_code *var2,
+                               int *maybe_int, int *maybe_dbl, int *chk1,
+                               struct code **conv1p, int *chk2,
+                               struct code **conv2p);
+struct node      *aug_nd     (nodeptr op, nodeptr arg1, nodeptr arg2);
+struct node      *binary_nd  (nodeptr op, nodeptr arg1, nodeptr arg2);
+void         bitrange    (int typcd, int *frst_bit, int *last_bit);
+nodeptr           buildarray (nodeptr a, nodeptr lb, nodeptr e);
+void           callc_add  (struct c_fnc *cont);
+void           callo_add  (char *oper_nm, int ret_flag,
+                               struct c_fnc *cont, int need_cont,
+                               struct code *arglist, struct code *on_ret);
+struct node      *case_nd    (nodeptr loc_model, nodeptr expr, nodeptr cases);
+int               ccomp      (char *srcname, char *exename);
+void           cd_add     (struct code *cd);
+struct val_loc   *chk_alc    (struct val_loc *rslt, nodeptr lifetime);
+void           chkinv     (void);
+void           chkstrinv  (void);
+struct node      *c_str_leaf (int type,struct node *loc_model, char *c);
+void	          codegen    (struct node *t);
+int               cond_anlz  (struct il_code *il, struct code **cdp);
+void           const_blks (void);
+struct val_loc   *cvar_loc   (char *name);
+int               do_inlin   (struct implement *impl, nodeptr n, int *sep_cont,
+				struct op_symentry *symtab, int n_va);
+void	          doiconx    (char *s);
+struct val_loc   *dtmp_loc   (int n);
+void          eval_arith (int indx1, int indx2, int *maybe_int, int *maybe_dbl);
+int           eval_cnv   (int typcd, int indx, int def, int *cnv_flags);
+int	eval_is	(int typcd,int indx);
+void           findcases  (struct il_code *il, int has_dflt,
+                               struct case_anlz *case_anlz);
+void           fix_fncs   (struct c_fnc *fnc);
+struct fentry    *flookup    (char *id);
+void           gen_inlin  (struct il_code *il, struct val_loc *rslt,
+                               struct code **scont_strt,
+                               struct code **scont_fail, struct c_fnc *cont,
+                               struct implement *impl, int nsyms,
+                               struct op_symentry *symtab, nodeptr n,
+                               int dcl_var, int n_va);
+int	          getopr     (int ac, int *cc);
+#ifdef OptimizeType
+unsigned int    get_bit_vector (struct typinfo *src, int pos);
+#endif					/* OptimizeType */
+struct gentry    *glookup    (char *id);
+void	          hsyserr    (char **av, char *file);
+struct node      *i_str_leaf (int type,struct node *loc_model,char *c, int d);
+long              iconint    (char *image);
+struct code      *il_copy    (struct il_c *dest, struct val_loc *src);
+struct code      *il_cnv     (int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest);
+struct code      *il_dflt    (int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest);
+void           implproto  (struct implement *ip);
+void           init       (void);
+void           init_proc  (char *name);
+void           init_rec   (char *name);
+void           init_src   (void);
+void           install    (char *name,int flag);
+struct gentry    *instl_p    (char *name, int flag);
+struct node      *int_leaf   (int type,struct node *loc_model,int c);
+struct val_loc   *itmp_loc   (int n);
+struct node      *invk_main  (struct pentry *main_proc);
+struct node      *invk_nd    (struct node *loc_model, struct node *proc,
+                              struct node *args);
+void           invoc_grp  (char *grp);
+void           invocbl    (nodeptr op, int arity);
+struct node      *key_leaf   (nodeptr loc_model, char *keyname);
+void           liveness (nodeptr n, nodeptr resumer, nodeptr *failer, int *gen);
+struct node      *list_nd    (nodeptr loc_model, nodeptr args);
+void           lnkdcl     (char *name);
+void	          readdb     (char *db_name);
+struct val_loc   *loc_cpy    (struct val_loc *loc, int mod_access);
+#ifdef OptimizeType
+void           mark_recs (struct fentry *fp, struct typinfo *typ,
+                              int *num_offsets, int *offset, int *bad_recs);
+#else					/* OptimizeType */
+void           mark_recs (struct fentry *fp, unsigned int *typ,
+                              int *num_offsets, int *offset, int *bad_recs);
+#endif					/* OptimizeType */
+struct code      *mk_goto    (struct code *label);
+struct node      *multiunary (char *op, nodeptr loc_model, nodeptr oprnd);
+struct sig_act   *new_sgact  (struct code *sig, struct code *cd,
+                               struct sig_act *next);
+int               nextchar   (void);
+void           nfatal     (struct node *n, char *s1, char *s2);
+int               n_arg_sym  (struct implement *ip);
+void           outerfnc   (struct c_fnc *fnc);
+int               past_prms  (struct node *n);
+void           proccode   (struct pentry *proc);
+void           prt_fnc    (struct c_fnc *fnc);
+void           prt_frame  (char *prefix, int ntend, int n_itmp,
+				int i, int j, int k);
+struct centry    *putlit     (char *image,int littype,int len);
+struct lentry    *putloc     (char *id,int id_type);
+void	          quit       (char *msg);
+void	          quitf      (char *msg,char *arg);
+void           recconstr  (struct rentry *r);
+void           resolve    (struct pentry *proc);
+unsigned int      round2     (unsigned int n);
+struct code      *sig_cd     (struct code *fail, struct c_fnc *fnc);
+void           src_file   (char *name);
+struct node      *sect_nd    (nodeptr op, nodeptr arg1, nodeptr arg2,
+                               nodeptr arg3);
+void           tfatal     (char *s1,char *s2);
+struct node      *to_nd      (nodeptr loc_model, nodeptr arg1,
+                               nodeptr arg2);
+struct node      *toby_nd    (nodeptr loc_model, nodeptr arg1,
+                               nodeptr arg2, nodeptr arg3);
+int               trans      (void);
+struct node      *tree1      (int type);
+struct node      *tree2      (int type,struct node *loc_model);
+struct node      *tree3      (int type,struct node *loc_model,
+                               struct node *c);
+struct node      *tree4      (int type, struct node *loc_model,
+                               struct node *c, struct node *d);
+struct node      *tree5      (int type, struct node *loc_model,
+			       struct node *c, struct node *d,
+			       struct node *e);
+struct node      *tree6      (int type,struct node *loc_model,
+			       struct node *c, struct node *d,
+			       struct node *e, struct node *f);
+void	          tsyserr    (char *s);
+void	          twarn      (char *s1,char *s2);
+struct code      *typ_chk    (struct il_code *var, int typcd);
+int               type_case  (struct il_code *il, int (*fnc)(),
+                               struct case_anlz *case_anlz);
+void           typeinfer  (void);
+struct node      *unary_nd   (nodeptr op, nodeptr arg);
+void           var_dcls   (void);
+#ifdef OptimizeType
+int               varsubtyp  (struct typinfo *typ, struct lentry **single);
+#else					/* OptimizeType */
+int               varsubtyp  (unsigned int *typ, struct lentry **single);
+#endif					/* OptimizeType */
+void	          writecheck (int rc);
+void	          yyerror    (int tok,struct node *lval,int state);
+int               yylex      (void);
+int               yyparse    (void);
+#ifdef OptimizeType
+void         xfer_packed_types (struct typinfo *type);
+#endif					/* OptimizeType */
+
+#ifdef DeBug
+void symdump (void);
+void ldump   (struct lentry **lhash);
+void gdump   (void);
+void cdump   (void);
+void fdump   (void);
+void rdump   (void);
+#endif					/* DeBug */
diff --git a/src/iconc/csym.c b/src/iconc/csym.c
new file mode 100644
index 0000000..8e764e3
--- /dev/null
+++ b/src/iconc/csym.c
@@ -0,0 +1,853 @@
+/*
+ * csym.c -- functions for symbol table management.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+
+static struct gentry    *alcglob  (struct gentry *blink,
+				    char *name,int flag);
+static struct fentry    *alcfld   (struct fentry *blink, char *name,
+				    struct par_rec *rp);
+static struct centry    *alclit	  (struct centry *blink,
+				    char *image, int len,int flag);
+static struct lentry    *alcloc	  (struct lentry *blink,
+				    char *name,int flag);
+static struct par_rec   *alcprec  (struct rentry *rec, int offset,
+				    struct par_rec *next);
+static struct centry    *clookup  (char *image,int flag);
+static struct lentry    *dcl_loc  (char *id, int id_type,
+                                    struct lentry *next);
+static struct lentry    *llookup  (char *id);
+static void           opstrinv (struct implement *ip);
+static struct gentry    *putglob  (char *id,int id_type);
+static struct gentry    *try_gbl  (char *id);
+
+int max_sym = 0;  /* max number of parameter symbols in run-time routines */
+int max_prm = 0;  /* max number of parameters for any invocable routine */
+
+/*
+ * The operands of the invocable declaration are stored in a list for
+ *  later processing.
+ */
+struct strinv {
+   nodeptr op;
+   int arity;
+   struct strinv *next;
+   };
+struct strinv *strinvlst = NULL;
+int op_tbl_sz;
+
+struct pentry *proc_lst = NULL; /* procedure list */
+struct rentry *rec_lst = NULL;  /* record list */
+
+
+/*
+ *instl_p - install procedure or record in global symbol table, returning
+ *  the symbol table entry.
+ */
+struct gentry *instl_p(name, flag)
+char *name;
+int flag;
+   {
+   struct gentry *gp;
+
+   flag |= F_Global;
+   if ((gp = glookup(name)) == NULL) 
+      gp = putglob(name, flag);
+   else if ((gp->flag & (~F_Global)) == 0) {
+      /* 
+       * superfluous global declaration for record or proc
+       */
+      gp->flag |= flag;
+      }
+   else			/* the user can't make up his mind */
+      tfatal("inconsistent redeclaration", name);
+   return gp;
+   }
+
+/*
+ * install - put an identifier into the global or local symbol table.
+ *  The basic idea here is to look in the right table and install
+ *  the identifier if it isn't already there.  Some semantic checks
+ *  are performed.
+ */
+void install(name, flag)
+char *name;
+int flag;
+   {
+   struct fentry *fp;
+   struct gentry *gp;
+   struct lentry *lp;
+   struct par_rec **rpp;
+   struct fldname *fnp;
+   int foffset;
+
+   switch (flag) {
+      case F_Global:	/* a variable in a global declaration */
+         if ((gp = glookup(name)) == NULL)
+            putglob(name, flag);
+         else
+            gp->flag |= flag;
+         break;
+
+      case F_Static:	/* static declaration */
+         ++proc_lst->nstatic;
+         lp = dcl_loc(name, flag, proc_lst->statics);
+         proc_lst->statics = lp;
+         break;
+
+      case F_Dynamic:	/* local declaration */
+         ++proc_lst->ndynam;
+         lp = dcl_loc(name, flag, proc_lst->dynams);
+         proc_lst->dynams = lp;
+         break;
+
+      case F_Argument:	/* formal parameter */
+         ++proc_lst->nargs;
+         if (proc_lst->nargs > max_prm)
+            max_prm = proc_lst->nargs;
+         lp = dcl_loc(name, flag, proc_lst->args);
+         proc_lst->args = lp;
+         break;
+
+      case F_Field: /* field declaration */
+         fnp = NewStruct(fldname);
+         fnp->name = name;
+         fnp->next = rec_lst->fields;
+         rec_lst->fields = fnp;
+         foffset = rec_lst->nfields++;
+         if (foffset > max_prm)
+            max_prm = foffset;
+         if ((fp = flookup(name)) == NULL) {
+            /*
+             * first occurrence of this field name.
+             */
+            fhash[FHasher(name)] = alcfld(fhash[FHasher(name)], name,
+               alcprec(rec_lst, foffset, NULL));
+            }
+         else {
+            rpp = &(fp->rlist);
+            while (*rpp != NULL && (*rpp)->offset <= foffset &&
+               (*rpp)->rec != rec_lst)
+               rpp = &((*rpp)->next);
+            if (*rpp == NULL || (*rpp)->offset > foffset)
+               *rpp = alcprec(rec_lst, foffset, *rpp);
+            else
+               tfatal("duplicate field name", name);
+            }
+         break;
+
+      default:
+         tsyserr("install: unrecognized symbol table flag.");
+      }
+   }
+
+/*
+ * dcl_loc - handle declaration of a local identifier.
+ */
+static struct lentry *dcl_loc(name, flag, next)
+char *name;
+int flag;
+struct lentry *next;
+   {
+   register struct lentry *lp;
+
+   if ((lp = llookup(name)) == NULL) {
+      lp = putloc(name,flag);
+      lp->next = next;
+      }
+   else if (lp->flag == flag) /* previously declared as same type */
+      twarn("redeclared identifier", name);
+   else		/* previously declared as different type */
+      tfatal("inconsistent redeclaration", name);
+   return lp;
+   }
+
+/*
+ * putloc - make a local symbol table entry and return pointer to it.
+ */
+struct lentry *putloc(id,id_type)
+char *id;
+int id_type;
+   {
+   register struct lentry *ptr;
+   register struct lentry **lhash;
+   unsigned hashval;
+
+   if ((ptr = llookup(id)) == NULL) {	/* add to head of hash chain */
+      lhash = proc_lst->lhash;
+      hashval = LHasher(id);
+      ptr = alcloc(lhash[hashval], id, id_type);
+      lhash[hashval] = ptr;
+      ptr->next = NULL;
+      }
+   return ptr;
+   }
+
+/*
+ * putglob makes a global symbol table entry and returns a pointer to it.
+ */
+static struct gentry *putglob(id, id_type)
+char *id;
+int id_type;
+   {
+   register struct gentry *ptr;
+   register unsigned hashval;
+
+   if ((ptr = glookup(id)) == NULL) {	 /* add to head of hash chain */
+      hashval = GHasher(id);
+      ptr = alcglob(ghash[hashval], id, id_type);
+      ghash[hashval] = ptr;
+      }
+   return ptr;
+   }
+
+/*
+ * putlit makes a constant symbol table entry and returns a pointer to it.
+ */
+struct centry *putlit(image, littype, len)
+char *image;
+int len, littype;
+   {
+   register struct centry *ptr;
+   register unsigned hashval;
+
+   if ((ptr = clookup(image,littype)) == NULL) { /* add to head of hash chain */
+      hashval = CHasher(image);
+      ptr = alclit(chash[hashval], image, len, littype);
+      chash[hashval] = ptr;
+      }
+   return ptr;
+   }
+
+/*
+ * llookup looks up id in local symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+
+static struct lentry *llookup(id)
+char *id;
+   {
+   register struct lentry *ptr;
+
+   ptr = proc_lst->lhash[LHasher(id)];
+   while (ptr != NULL && ptr->name != id)
+      ptr = ptr->blink;
+   return ptr;
+   }
+
+/*
+ * flookup looks up id in flobal symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+struct fentry *flookup(id)
+char *id;
+   {
+   register struct fentry *ptr;
+
+   ptr = fhash[FHasher(id)];
+   while (ptr != NULL && ptr->name != id) {
+      ptr = ptr->blink;
+      }
+   return ptr;
+   }
+
+/*
+ * glookup looks up id in global symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+struct gentry *glookup(id)
+char *id;
+   {
+   register struct gentry *ptr;
+
+   ptr = ghash[GHasher(id)];
+   while (ptr != NULL && ptr->name != id) {
+      ptr = ptr->blink;
+      }
+   return ptr;
+   }
+
+/*
+ * clookup looks up id in constant symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+static struct centry *clookup(image,flag)
+char *image;
+int flag;
+   {
+   register struct centry *ptr;
+
+   ptr = chash[CHasher(image)];
+   while (ptr != NULL && (ptr->image != image || ptr->flag != flag))
+      ptr = ptr->blink;
+
+   return ptr;
+   }
+
+#ifdef DeBug
+/*
+ * symdump - dump symbol tables.
+ */
+void symdump()
+   {
+   struct pentry *proc;
+
+   gdump();
+   cdump();
+   rdump();
+   fdump();
+   for (proc = proc_lst; proc != NULL; proc = proc->next) {
+      fprintf(stderr,"\n");
+      fprintf(stderr,"Procedure %s\n", proc->sym_entry->name);
+      ldump(proc->lhash);
+      }
+   }
+
+/*
+ * prt_flgs - print flags from a symbol table entry.
+ */
+static void prt_flgs(flags)
+int flags;
+   {
+   if (flags & F_Global)
+      fprintf(stderr, " F_Global");
+   if (flags & F_Proc)
+      fprintf(stderr, " F_Proc");
+   if (flags & F_Record)
+      fprintf(stderr, " F_Record");
+   if (flags & F_Dynamic)
+      fprintf(stderr, " F_Dynamic");
+   if (flags & F_Static)
+      fprintf(stderr, " F_Static");
+   if (flags & F_Builtin)
+      fprintf(stderr, " F_Builtin");
+   if (flags & F_StrInv)
+      fprintf(stderr, " F_StrInv");
+   if (flags & F_ImpError)
+      fprintf(stderr, " F_ImpError");
+   if (flags & F_Argument)
+      fprintf(stderr, " F_Argument");
+   if (flags & F_IntLit)
+      fprintf(stderr, " F_IntLit");
+   if (flags & F_RealLit)
+      fprintf(stderr, " F_RealLit");
+   if (flags & F_StrLit)
+      fprintf(stderr, " F_StrLit");
+   if (flags & F_CsetLit)
+      fprintf(stderr, " F_CsetLit");
+   if (flags & F_Field)
+      fprintf(stderr, " F_Field");
+   fprintf(stderr, "\n");
+   }
+/*
+ * ldump displays local symbol table to stderr.
+ */
+
+void ldump(lhash)
+struct lentry **lhash;
+   {
+   register int i;
+   register struct lentry *lptr;
+
+   fprintf(stderr,"   Dump of local symbol table\n");
+   fprintf(stderr,"     address                 name  globol-ref  flags\n");
+   for (i = 0; i < LHSize; i++)
+      for (lptr = lhash[i]; lptr != NULL; lptr = lptr->blink) {
+         fprintf(stderr,"    %8x %20s    ", lptr, lptr->name);
+         if (lptr->flag & F_Global)
+            fprintf(stderr, "%8x ", lptr->val.global);
+         else
+            fprintf(stderr, "       - ");
+         prt_flgs(lptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * gdump displays global symbol table to stderr.
+ */
+
+void gdump()
+   {
+   register int i;
+   register struct gentry *gptr;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of global symbol table\n");
+   fprintf(stderr,"  address                 name  nargs  flags\n");
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         fprintf(stderr," %8x %20s   %4d ", gptr,
+		gptr->name, gptr->nargs);
+         prt_flgs(gptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * cdump displays constant symbol table to stderr.
+ */
+
+void cdump()
+   {
+   register int i;
+   register struct centry *cptr;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of constant symbol table\n");
+   fprintf(stderr,
+      "  address  value                                      flags\n");
+   for (i = 0; i < CHSize; i++)
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr->blink) {
+         fprintf(stderr," %8x  %-40.40s  ", cptr, cptr->image);
+         prt_flgs(cptr->flag);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * fdump displays field symbol table to stderr.
+ */
+void fdump()
+   {
+   int i;
+   struct par_rec *prptr;
+   struct fentry *fp;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of field symbol table\n");
+   fprintf(stderr,
+      "  address                field  global-ref  offset\n");
+   for (i = 0; i < FHSize; i++)
+      for (fp = fhash[i]; fp != NULL; fp = fp->blink) {
+         fprintf(stderr," %8x %20s\n", fp, fp->name);
+         for (prptr = fp->rlist; prptr != NULL; prptr = prptr->next)
+            fprintf(stderr,"                                  %8x    %4d\n",
+               prptr->sym_entry, prptr->offset);
+         }
+   fflush(stderr);
+   }
+
+/*
+ * prt_flds - print a list of fields stored in reverse order.
+ */
+static void prt_flds(f)
+struct fldname *f;
+   {
+   if (f == NULL)
+     return;
+   prt_flds(f->next);
+   fprintf(stderr, "  %s", f->name);
+   }
+
+/*
+ * rdump displays list of records and their fields.
+ */
+void rdump()
+   {
+   struct rentry *rp;
+
+   fprintf(stderr,"\n");
+   fprintf(stderr,"Dump of record list\n");
+   fprintf(stderr, " global-ref   fields\n");
+   for (rp = rec_lst; rp != NULL; rp = rp->next) {
+      fprintf(stderr, "   %8x ", rp->sym_entry);
+      prt_flds(rp->fields);
+      fprintf(stderr, "\n");
+      }
+   }
+#endif					/* DeBug */
+
+/*
+ * alcloc allocates a local symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct lentry *alcloc(blink, name, flag)
+struct lentry *blink;
+char *name;
+int flag;
+   {
+   register struct lentry *lp;
+
+   lp = NewStruct(lentry);
+   lp->blink = blink;
+   lp->name = name;
+   lp->flag = flag;
+   return lp;
+   }
+
+/*
+ * alcfld allocates a field symbol table entry, fills in the entry with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct fentry *alcfld(blink, name, rp)
+struct fentry *blink;
+char *name;
+struct par_rec *rp;
+   {
+   register struct fentry *fp;
+
+   fp = NewStruct(fentry);
+   fp->blink = blink;
+   fp->name = name;
+   fp->rlist = rp;
+   return fp;
+   }
+
+/*
+ * alcglob allocates a global symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct gentry *alcglob(blink, name, flag)
+struct gentry *blink;
+char *name;
+int flag;
+   {
+   register struct gentry *gp;
+
+   gp = NewStruct(gentry);
+   gp->blink = blink;
+   gp->name = name;
+   gp->flag = flag;
+   return gp;
+   }
+
+/*
+ * alclit allocates a constant symbol table entry, fills in fields with
+ *  specified values and returns pointer to new entry.  
+ */
+static struct centry *alclit(blink, image, len, flag)
+struct centry *blink;
+char *image;
+int len, flag;
+   {
+   register struct centry *cp;
+
+   cp = NewStruct(centry);
+   cp->blink = blink;
+   cp->image = image;
+   cp->length = len;
+   cp->flag = flag;
+   switch (flag) {
+      case F_IntLit:
+         cp->u.intgr = iconint(image);
+         break;
+      case F_CsetLit:
+         cp->u.cset = bitvect(image, len);
+         break;
+      }
+   return cp;
+   }
+
+/*
+ * alcprec allocates an entry for the parent record list for a field.
+ */
+static struct par_rec *alcprec(rec, offset, next)
+struct rentry *rec;
+int offset;
+struct par_rec *next;
+   {
+   register struct par_rec *rp;
+
+   rp = NewStruct(par_rec);
+   rp->rec= rec;
+   rp->offset = offset;
+   rp->next = next;
+   return rp;
+   }
+
+/*
+ * resolve - resolve the scope of undeclared identifiers.
+ */
+void resolve(proc)
+struct pentry *proc;
+   {
+   struct lentry **lhash;
+   register struct lentry *lp;
+   struct gentry *gp;
+   int i;
+   char *id;
+
+   lhash = proc->lhash;
+
+   for (i = 0; i < LHSize; ++i) {
+      lp = lhash[i];
+      while (lp != NULL) {
+         id = lp->name;
+         if (lp->flag == 0) {				/* undeclared */
+            if ((gp = try_gbl(id)) != NULL) {		/* check global */
+               lp->flag = F_Global;
+               lp->val.global = gp;
+               }
+            else {					/* implicit local */
+               if (uwarn) {
+                  fprintf(stderr, "%s undeclared identifier, procedure %s\n",
+                     id, proc->name);
+                  ++twarns;
+                  }
+               lp->flag = F_Dynamic;
+               lp->next = proc->dynams;
+               proc->dynams = lp;
+               ++proc->ndynam;
+               }
+            }
+         lp = lp->blink;
+         }
+      }
+   }
+
+/*
+ * try_glb - see if the identifier is or should be a global variable.
+ */
+static struct gentry *try_gbl(id)
+char *id;
+   {
+   struct gentry *gp;
+   register struct implement *iptr;
+   int nargs;
+   int n;
+
+   gp = glookup(id);
+   if (gp == NULL) {
+      /*
+       * See if it is a built-in function.
+       */
+      iptr = db_ilkup(id, bhash);
+      if (iptr == NULL)
+         return NULL;
+      else {
+        if (iptr->in_line == NULL)
+           nfatal(NULL, "built-in function not installed", id);
+         nargs = iptr->nargs;
+         if (nargs > 0 && iptr->arg_flgs[nargs - 1] & VarPrm)
+            nargs = -nargs;
+         gp = putglob(id, F_Global | F_Builtin);
+         gp->val.builtin = iptr;
+
+         n = n_arg_sym(iptr);
+         if (n > max_sym)
+            max_sym = n;
+         }
+      }
+   return gp;
+   }
+
+/*
+ * invoc_grp - called when "invocable all" is encountered.
+ */
+void invoc_grp(grp)
+char *grp;
+   {
+   if (grp == spec_str("all"))
+      str_inv = 1; /* enable full string invocation */
+   else
+      tfatal("invalid operand to invocable", grp);
+   }
+
+/*
+ * invocbl - indicate that the operator is needed for for string invocation.
+ */
+void invocbl(op, arity)
+nodeptr op;
+int arity;
+   {
+   struct strinv *si;
+   
+   si = NewStruct(strinv);
+   si->op = op;
+   si->arity = arity;
+   si->next = strinvlst;
+   strinvlst = si;  
+   }
+
+/*
+ * chkstrinv - check to see what is needed for string invocation.
+ */
+void chkstrinv()
+   {
+   struct strinv *si;
+   struct gentry *gp;
+   struct implement *ip;
+   char *op_name;
+   int arity;
+   int i;
+
+   /*
+    * A table of procedure blocks for operators is set up for use by
+    *  string invocation.
+    */
+   op_tbl_sz = 0;
+   fprintf(codefile, "\nstatic B_IProc(2) init_op_tbl[OpTblSz]");
+
+   if (str_inv) {
+      /*
+       * All operations must be available for string invocation. Make sure all
+       *  built-in functions have either been hidden by global declarations
+       *  or are in global variables, make sure no global variables are
+       *  optimized away, and make sure all operations are in the table of
+       *  operations.
+       */
+      for (i = 0; i < IHSize; ++i)  /* built-in function table */
+         for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+            try_gbl(ip->name);
+      for (i = 0; i < GHSize; i++)  /* global symbol table */
+         for (gp = ghash[i]; gp != NULL; gp = gp->blink)
+            gp->flag |= F_StrInv;
+      for (i = 0; i < IHSize; ++i)  /* operator table */
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            opstrinv(ip);
+      }
+   else {
+      /*
+       * selected operations must be available for string invocation.
+       */
+      for (si = strinvlst; si != NULL; si = si->next) {
+         op_name = Str0(si->op);
+         if (isalpha(*op_name) || (*op_name == '_')) {
+             /*
+              * This needs to be something in a global variable: function,
+              *  procedure, or constructor.
+              */
+             gp = try_gbl(op_name);
+             if (gp == NULL)
+                nfatal(si->op, "not available for string invocation", op_name);
+             else
+                gp->flag |= F_StrInv;
+             }
+         else {
+             /*
+              * must be an operator.
+              */
+             arity = si->arity;
+             i = IHasher(op_name);
+             for (ip = ohash[i]; ip != NULL && ip->op != op_name;
+                 ip = ip->blink)
+                 ;
+             if (arity < 0) {
+                /*
+                 * Operators of all arities with this symbol.
+                 */
+                while (ip != NULL && ip->op == op_name) {
+                   opstrinv(ip);
+                   ip = ip->blink;
+                   }
+                }
+             else {
+                /*
+                 * Operator of a specific arity.
+                 */
+                while (ip != NULL && ip->nargs != arity)
+                   ip = ip->blink;
+                if (ip == NULL || ip->op != op_name)
+                   nfatal(si->op, "not available for string invocation",
+                      op_name);
+                else
+                   opstrinv(ip);
+                }
+             }
+         }
+      }
+
+   /*
+    * Add definitions to the header file indicating the size of the operator
+    *  table and finish the declaration in the code file.
+    */
+   if (op_tbl_sz == 0) {
+      fprintf(inclfile, "#define OpTblSz 1\n");
+      fprintf(inclfile, "int op_tbl_sz = 0;\n");
+      fprintf(codefile, ";\n");
+      }
+   else {
+      fprintf(inclfile, "#define OpTblSz %d\n", op_tbl_sz);
+      fprintf(inclfile, "int op_tbl_sz = OpTblSz;\n");
+      fprintf(codefile, "\n   };\n");
+      }
+   }
+
+/*
+ * opstrinv - set up string invocation for an operator.
+ */
+static void opstrinv(ip)
+struct implement *ip;
+   {
+   char c1, c2;
+   char *name;
+   char *op;
+   register char *s;
+   int nargs;
+   int n;
+
+   if (ip == NULL || ip->iconc_flgs & InStrTbl) 
+      return;
+
+   /*
+    * Keep track of the maximum number of argument symbols in any operation
+    *  so type inference can allocate enough storage for the worst case of
+    *  general invocation.
+    */
+   n = n_arg_sym(ip);
+   if (n > max_sym)
+      max_sym = n;
+
+   name = ip->name;
+   c1 = ip->prefix[0];
+   c2 = ip->prefix[1];
+   op = ip->op;
+   nargs = ip->nargs;
+   if (ip->arg_flgs[nargs - 1] & VarPrm)
+      nargs = -nargs;   /* indicate varargs with negative number of params */
+
+   if (op_tbl_sz++ == 0) {
+       fprintf(inclfile, "\n");
+       fprintf(codefile, " = {\n");
+       }
+   else
+       fprintf(codefile, ",\n");
+   implproto(ip);   /* output prototype */
+
+   /*
+    * Output procedure block for this operator into table used by string
+    *  invocation.
+    */
+   fprintf(codefile, "   {T_Proc, 11, O%c%c_%s, %d, -1, 0, 0, {{%d, \"", c1, c2,
+      name, nargs, strlen(op));
+   for (s = op; *s != '\0'; ++s) {
+      if (*s == '\\')
+         fprintf(codefile, "\\");
+      fprintf(codefile, "%c", *s);
+      }
+   fprintf(codefile, "\"}}}");
+   ip->iconc_flgs |= InStrTbl;
+   }
+
+/*
+ * n_arg_sym - determine the number of argument symbols (dereferenced
+ *  and undereferenced arguments are separate symbols) for an operation
+ *  in the data base.
+ */
+int n_arg_sym(ip)
+struct implement *ip;
+   {
+   int i;
+   int num;
+
+   num = 0;
+   for (i = 0; i < ip->nargs; ++i) {
+      if (ip->arg_flgs[i] & RtParm)
+         ++num;
+      if (ip->arg_flgs[i] & DrfPrm)
+         ++num;
+      }
+   return num;
+   }
diff --git a/src/iconc/csym.h b/src/iconc/csym.h
new file mode 100644
index 0000000..cf104af
--- /dev/null
+++ b/src/iconc/csym.h
@@ -0,0 +1,380 @@
+/*
+ * Structures for symbol table entries.
+ */
+
+#define MaybeTrue  1 /* condition might be true at run time */
+#define MaybeFalse 2 /* condition might be false at run time */
+
+#define MayConvert 1 /* type conversion may convert the value */ 
+#define MayDefault 2 /* defaulting type conversion may use default */
+#define MayKeep    4 /* conversion may succeed without any actual conversion */
+
+#ifdef OptimizeType
+#define NULL_T     0x1000000 
+#define REAL_T     0x2000000
+#define INT_T      0x4000000
+#define CSET_T     0x8000000
+#define STR_T      0x10000000
+
+#define TYPINFO_BLOCK 400000
+
+/* 
+ * Optimized type structure for bit vectors  
+ *     All previous occurencess of unsigned int * (at least
+ *     when refering to bit vectors) have been replaced by 
+ *     struct typinfo.
+ */
+struct typinfo {
+   unsigned int packed;       /* packed representation of types */
+   unsigned int  *bits;         /* full length bit vector         */
+};
+#endif					/* OptimizeType */
+
+/*
+ * Data base type codes are mapped to type inferencing information using
+ *  an array.
+ */
+struct typ_info {
+   int frst_bit;      /* first bit in bit vector allocated to this type */
+   int num_bits;      /* number of bits in bit vector allocated to this type */
+   int new_indx;      /* index into arrays of allocated types for operation */
+#ifdef OptimizeType
+   struct typinfo *typ; /* for variables: initial type */
+#else					/* OptimizeType */
+   unsigned int *typ;   /* for variabled: initial type */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * A type is a bit vector representing a union of basic types. There
+ *  are 3 sizes of types: first class types (Icon language types),
+ *  intermediate value types (first class types plus variable references), 
+ *  run-time routine types (intermediate value types plus internal
+ *  references to descriptors such as set elements). When the size of
+ *  the type is known from context, a simple bit vector can be used.
+ *  In other contexts, the size must be included.
+ */
+struct type {
+   int size;
+#ifdef OptimizeType
+   struct typinfo *bits;
+#else					/* OptimizeType */
+   unsigned int *bits;
+#endif					/* OptimizeType */
+   struct type *next;
+   };
+
+
+#define DecodeSize(x)		(x & 0xFFFFFF)
+#define DecodePacked(x)		(x >> 24)
+/*
+ * NumInts - convert from the number of bits in a bit vector to the
+ *  number of integers implementing it.
+ */
+#define NumInts(n_bits) (n_bits - 1) / IntBits + 1
+
+/*
+ * ClrTyp - zero out the bit vector for a type.
+ */
+#ifdef OptimizeType
+#define ClrTyp(size,typ) {\
+   int typ_indx;\
+   if ((typ)->bits == NULL)\
+      clr_packed((typ),(size));\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+         (typ)->bits[typ_indx] = 0;}
+#else					/* OptimizeType */
+#define ClrTyp(size,typ) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (typ)[typ_indx] = 0;}
+#endif					/* OptimizeType */
+
+/*
+ * CpyTyp - copy a type of the given size from one bit vector to another.
+ */
+#ifdef OptimizeType
+#define CpyTyp(nsize,src,dest) {\
+   int typ_indx, num;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL))  {\
+      ClrTyp((nsize),(dest));\
+      cpy_packed_to_packed((src),(dest),(nsize));\
+   }\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL)) {\
+      ClrTyp((nsize),(dest));\
+      xfer_packed_to_bits((src),(dest),(nsize));\
+   }\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL))  {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] = (src)->bits[typ_indx];\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] = (src)->bits[typ_indx];}
+#else					/* OptimizeType */
+#define CpyTyp(size,src,dest) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (dest)[typ_indx] = (src)[typ_indx];}
+#endif					/* OptimizeType */
+
+/*
+ * MrgTyp - merge a type of the given size from one bit vector into another.
+ */
+#ifdef OptimizeType
+#define MrgTyp(nsize,src,dest) {\
+   int typ_indx;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL))\
+      mrg_packed_to_packed((src),(dest),(nsize));\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL))\
+      xfer_packed_to_bits((src),(dest),(nsize));\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL)) {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx)\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];}
+#else					/* OptimizeType */
+#define MrgTyp(size,src,dest) {\
+   int typ_indx;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx)\
+      (dest)[typ_indx] |= (src)[typ_indx];}
+#endif					/* OptimizeType */
+
+/*
+ * ChkMrgTyp - merge a type of the given size from one bit vector into another,
+ *  updating the changed flag if the destination is changed by the merger.
+ */
+#ifdef OptimizeType
+#define ChkMrgTyp(nsize,src,dest) {\
+   int typ_indx, ret; unsigned int old;\
+   if (((src)->bits == NULL) && ((dest)->bits == NULL)) {\
+       ret = mrg_packed_to_packed((src),(dest),(nsize));\
+       changed += ret;\
+   }\
+   else if (((src)->bits == NULL) && ((dest)->bits != NULL)) {\
+      ret = xfer_packed_to_bits((src),(dest),(nsize));\
+      changed += ret;\
+   }\
+   else if (((src)->bits != NULL) && ((dest)->bits == NULL)) {\
+      (dest)->bits = alloc_mem_typ(DecodeSize((dest)->packed));\
+      xfer_packed_types((dest));\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx) {\
+         old = (dest)->bits[typ_indx];\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+         if (old != (dest)->bits[typ_indx]) ++changed;}\
+   }\
+   else\
+      for (typ_indx = 0; typ_indx < NumInts((nsize)); ++typ_indx) {\
+         old = (dest)->bits[typ_indx];\
+         (dest)->bits[typ_indx] |= (src)->bits[typ_indx];\
+         if (old != (dest)->bits[typ_indx]) ++changed;}}
+#else					/* OptimizeType */
+#define ChkMrgTyp(size,src,dest) {\
+   int typ_indx; unsigned int old;\
+   for (typ_indx = 0; typ_indx < NumInts((size)); ++typ_indx) {\
+      old = (dest)[typ_indx];\
+      (dest)[typ_indx] |= (src)[typ_indx];\
+      if (old != (dest)[typ_indx]) ++changed;}}
+#endif					/* OptimizeType */
+
+
+struct centry {		/* constant table entry */
+   struct centry *blink;	/*   link for bucket chain */
+   char *image;			/*   pointer to string image of literal */
+   int length;			/*   length of string */
+   union {
+      unsigned short *cset;	/*   pointer to bit string for cset literal */
+      long intgr;		/*   value of integer literal */
+      } u;
+   uword flag;			/*   type of literal flag */
+   char prefix[PrfxSz+1];	/*   unique prefix used in data block name */
+   };
+
+struct fentry {			/* field table entry */
+   struct fentry *blink;	/*   link for bucket chain */
+   char *name;			/*   name of field */
+   struct par_rec *rlist;	/*   head of list of records */
+   };
+
+struct lentry {			/* local table entry */
+   struct lentry *blink;	/*   link for bucket chain */
+   char *name;			/*   name of variable */
+   uword flag;			/*   variable flags */
+   union {
+      struct gentry *global;    /*   for globals: global symbol table entry */
+      int index;                /*   type index; run-time descriptor index */
+      } val;
+   struct lentry *next;		/*   used for linking a class of variables */
+   };
+
+struct gentry {			 /* global table entry */
+   struct gentry *blink;	 /*   link for bucket chain */
+   char *name;			 /*   name of variable */
+   uword flag;			 /*   variable flags */
+   union {
+      struct implement *builtin; /*   pointer to built-in function */
+      struct pentry *proc;	 /*   pointer to procedure entry */
+      struct rentry *rec;	 /*   pointer to record entry */
+      } val;
+   int index;			 /*   index into global array */
+   int init_type;                /*   initial type if procedure */
+   };
+
+/*
+ * Structure for list of parent records for a field name.
+ */
+struct par_rec {
+   struct rentry *rec;		/* parent record */
+   int offset;			/* field's offset within this record */
+   int mark;                    /* used during code generation */
+   struct par_rec *next;
+   };
+
+/*
+ * Structure for a procedure.
+ */
+struct pentry {
+   char *name;			/* name of procedure */
+   char prefix[PrfxSz+1];	/* prefix to make name unique */
+   struct lentry **lhash;	/* hash area for procedure's local table */
+   int nargs;			/* number of args */
+   struct lentry *args;		/* list of arguments in reverse order */
+   int ndynam;                  /* number of dynamic locals */
+   struct lentry *dynams;       /* list of dynamics in reverse order */
+   int nstatic;                 /* number of statics */
+   struct lentry *statics;	/* list of statics in reverse order */
+   struct node *tree;		/* syntax tree for procedure */
+   int has_coexpr;		/* this procedure contains co-expressions */
+   int tnd_loc;			/* number of tended dynamic locals */
+   int ret_flag;		/* proc returns, suspends, and/or fails */
+   int reachable;               /* this procedure may be executed */
+   int iteration;		/* last iteration of type inference performed */
+   int arg_lst;			/* for varargs - the type number of the list */
+#ifdef OptimizeType
+   struct typinfo *ret_typ;	/* type returned from procedure */
+#else					/* OptimizeType */
+   unsigned int *ret_typ;	/* type returned from procedure */
+#endif					/* OptimizeType */
+   struct store *in_store;	/* store at start of procedure */
+   struct store *susp_store;	/* store for resumption points of procedure */
+   struct store *out_store;	/* store on exiting procedure */
+   struct lentry **vartypmap;   /* mapping from var types to symtab entries */
+#ifdef OptimizeType
+   struct typinfo *coexprs;     /* co-expressions in which proc may be called */
+#else					/* OptimizeType */
+   unsigned int *coexprs;     /* co-expressions in which proc may be called */
+#endif					/* OptimizeType */
+   struct pentry *next;
+   };
+
+/*
+ * Structure for a record.
+ */
+struct rentry {
+   char *name;			/* name of record */
+   char prefix[PrfxSz+1];	/* prefix to make name unique */
+   int frst_fld;		/* offset of variable type of 1st field */
+   int nfields;			/* number of fields */
+   struct fldname *fields;	/* list of field names in reverse order */
+   int rec_num;			/* id number for record */
+   struct rentry *next;
+   };
+
+struct fldname {                /* record field */
+   char *name;                  /* field name */
+   struct fldname *next;
+   };
+
+/*
+ * Structure used to analyze whether a type_case statement can be in-lined.
+ *  Only one type check is supported: the type_case will be implemented
+ *  as an "if" statement.
+ */
+struct case_anlz {
+   int n_cases;             /* number of cases actually needed for this use */
+   int typcd;               /* for "if" optimization, the type code to check */
+   struct il_code *il_then; /* for "if" optimization, the then clause */
+   struct il_code *il_else; /* for "if" optimization, the else clause */
+   };
+
+/*
+ * spec_op contains the implementations for operations with do not have
+ *  standard unary/binary syntax.
+ */
+#define ToOp      0  /* index into spec_op of i to j */
+#define ToByOp    1  /* index into spec_op of i to j by k */
+#define SectOp    2  /* index into spec_op of x[i:j] */
+#define SubscOp   3  /* index into spec_op of x[i] */
+#define ListOp    4  /* index into spec_op of [e1, e2, ... ] */
+#define NumSpecOp 5
+extern struct implement *spec_op[NumSpecOp];
+
+/*
+ * Flag values.
+ */
+
+#define F_Global	    01	/* variable declared global externally */
+#define F_Proc		    04	/* procedure */
+#define F_Record	   010	/* record */
+#define F_Dynamic	   020	/* variable declared local dynamic */
+#define F_Static	   040	/* variable declared local static */
+#define F_Builtin	  0100	/* identifier refers to built-in procedure */
+#define F_StrInv          0200  /* variable needed for string invocation */
+#define F_ImpError	  0400	/* procedure has default error */
+#define F_Argument	 01000	/* variable is a formal parameter */
+#define F_IntLit	 02000	/* literal is an integer */
+#define F_RealLit	 04000	/* literal is a real */
+#define F_StrLit	010000	/* literal is a string */
+#define F_CsetLit	020000	/* literal is a cset */
+#define F_Field		040000  /* identifier refers to a record field */
+#define F_SmplInv      0100000  /* identifier only used in simple invocation */
+
+/*
+ * Symbol table region pointers.
+ */
+
+extern struct implement *bhash[];	/* hash area for built-in func table */
+extern struct centry *chash[];		/* hash area for constant table */
+extern struct fentry *fhash[];		/* hash area for field table */
+extern struct gentry *ghash[];		/* hash area for global table */
+extern struct implement *khash[];	/* hash area for keyword table */
+extern struct implement *ohash[];	/* hash area for operator table */
+
+extern struct pentry *proc_lst; /* procedure list */
+extern struct rentry *rec_lst;  /* record list */
+
+extern int max_sym; /* max number of parameter symbols in run-time routines */
+extern int max_prm; /* max number of parameters for any invocable routine */
+
+extern struct symtyps *cur_symtyps; /* maps run-time routine symbols to types */
+extern struct pentry *cur_proc; /* procedure currently being translated */
+
+/*
+ * Hash functions for symbol tables. Note, hash table sizes (xHSize)
+ *  are all a power of 2.
+ */
+
+#define CHasher(x)	(((word)x)&(CHSize-1))	 /* constant symbol table */
+#define FHasher(x)	(((word)x)&(FHSize-1))	 /* field symbol table */
+#define GHasher(x)	(((word)x)&(GHSize-1))	 /* global symbol table */
+#define LHasher(x)	(((word)x)&(LHSize-1))	 /* local symbol table */
+
+/*
+ * flags for implementation entries.
+ */
+#define ProtoPrint 1  /* a prototype has already been printed */
+#define InStrTbl   2  /* operator is in string table */
+
+/*
+ * Whether an operation can fail may depend on whether error conversion
+ *  is allowed. The following macro checks this.
+ */
+#define MightFail(ret_flag) ((ret_flag & DoesFail) ||\
+   (err_conv && (ret_flag & DoesEFail)))
diff --git a/src/iconc/ctoken.h b/src/iconc/ctoken.h
new file mode 100644
index 0000000..1e95e98
--- /dev/null
+++ b/src/iconc/ctoken.h
@@ -0,0 +1,111 @@
+# define IDENT 257
+# define INTLIT 258
+# define REALLIT 259
+# define STRINGLIT 260
+# define CSETLIT 261
+# define EOFX 262
+# define BREAK 263
+# define BY 264
+# define CASE 265
+# define CREATE 266
+# define DEFAULT 267
+# define DO 268
+# define ELSE 269
+# define END 270
+# define EVERY 271
+# define FAIL 272
+# define GLOBAL 273
+# define IF 274
+# define INITIAL 275
+# define INVOCABLE 276
+# define LINK 277
+# define LOCAL 278
+# define NEXT 279
+# define NOT 280
+# define OF 281
+# define PROCEDURE 282
+# define RECORD 283
+# define REPEAT 284
+# define RETURN 285
+# define STATIC 286
+# define SUSPEND 287
+# define THEN 288
+# define TO 289
+# define UNTIL 290
+# define WHILE 291
+# define BANG 292
+# define MOD 293
+# define AUGMOD 294
+# define AND 295
+# define AUGAND 296
+# define STAR 297
+# define AUGSTAR 298
+# define INTER 299
+# define AUGINTER 300
+# define PLUS 301
+# define AUGPLUS 302
+# define UNION 303
+# define AUGUNION 304
+# define MINUS 305
+# define AUGMINUS 306
+# define DIFF 307
+# define AUGDIFF 308
+# define DOT 309
+# define SLASH 310
+# define AUGSLASH 311
+# define ASSIGN 312
+# define SWAP 313
+# define NMLT 314
+# define AUGNMLT 315
+# define REVASSIGN 316
+# define REVSWAP 317
+# define SLT 318
+# define AUGSLT 319
+# define SLE 320
+# define AUGSLE 321
+# define NMLE 322
+# define AUGNMLE 323
+# define NMEQ 324
+# define AUGNMEQ 325
+# define SEQ 326
+# define AUGSEQ 327
+# define EQUIV 328
+# define AUGEQUIV 329
+# define NMGT 330
+# define AUGNMGT 331
+# define NMGE 332
+# define AUGNMGE 333
+# define SGT 334
+# define AUGSGT 335
+# define SGE 336
+# define AUGSGE 337
+# define QMARK 338
+# define AUGQMARK 339
+# define AT 340
+# define AUGAT 341
+# define BACKSLASH 342
+# define CARET 343
+# define AUGCARET 344
+# define BAR 345
+# define CONCAT 346
+# define AUGCONCAT 347
+# define LCONCAT 348
+# define AUGLCONCAT 349
+# define TILDE 350
+# define NMNE 351
+# define AUGNMNE 352
+# define SNE 353
+# define AUGSNE 354
+# define NEQUIV 355
+# define AUGNEQUIV 356
+# define LPAREN 357
+# define RPAREN 358
+# define PCOLON 359
+# define COMMA 360
+# define MCOLON 361
+# define COLON 362
+# define SEMICOL 363
+# define LBRACK 364
+# define RBRACK 365
+# define LBRACE 366
+# define RBRACE 367
diff --git a/src/iconc/ctrans.c b/src/iconc/ctrans.c
new file mode 100644
index 0000000..7d33ac5
--- /dev/null
+++ b/src/iconc/ctrans.c
@@ -0,0 +1,184 @@
+/*
+ * ctrans.c - main control of the translation process.
+ */
+#include "../h/gsupport.h"
+#include "cglobals.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes.
+ */
+static void	trans1		(char *filename);
+
+/*
+ * Variables.
+ */
+int tfatals = 0;		/* total number of fatal errors */
+int twarns = 0;			/* total number of warnings */
+int nocode;			/* set by lexer; unused in compiler */
+int in_line;			/* current input line number */
+int incol;			/* current input column number */
+int peekc;			/* one-character look ahead */
+struct srcfile *srclst = NULL;	/* list of source files to translate */
+
+static char *lpath;		/* LPATH value */
+
+/*
+ * translate a number of files, returning an error count
+ */
+int trans()
+   {
+   register struct pentry *proc;
+   struct srcfile *sf;
+
+   lpath = getenv("LPATH");	/* remains null if unspecified */
+
+   for (sf = srclst; sf != NULL; sf = sf->next)
+      trans1(sf->name);	/* translate each file in turn */
+
+   if (!pponly) {
+      /*
+       * Resolve undeclared references.
+       */
+      for (proc = proc_lst; proc != NULL; proc = proc->next)
+         resolve(proc);
+   
+#ifdef DeBug
+      symdump();
+#endif					/* DeBug */
+   
+      if (tfatals == 0) {
+         chkstrinv();  /* see what needs be available for string invocation */
+         chkinv();     /* perform "naive" optimizations */
+         }
+   
+      if (tfatals == 0)
+         typeinfer();        /* perform type inference */
+   
+      if (just_type_trace)
+         return tfatals;     /* stop without generating code */
+   
+      if (tfatals == 0) {
+         var_dcls();         /* output declarations for globals and statics */
+         const_blks();       /* output blocks for cset and real literals */
+         for (proc = proc_lst; proc != NULL; proc = proc->next)
+            proccode(proc);  /* output code for a procedure */
+         recconstr(rec_lst); /* output code for record constructors */
+/* ANTHONY */
+/*
+	 print_ghash();
+*/
+      }
+    }
+
+   /*
+    * Report information about errors and warnings and be correct about it.
+    */
+   if (tfatals == 1)
+      fprintf(stderr, "1 error; ");
+   else if (tfatals > 1)
+      fprintf(stderr, "%d errors; ", tfatals);
+   else if (verbose > 0)
+      fprintf(stderr, "No errors; ");
+
+   if (twarns == 1)
+      fprintf(stderr, "1 warning\n");
+   else if (twarns > 1)
+      fprintf(stderr, "%d warnings\n", twarns);
+   else if (verbose > 0)
+      fprintf(stderr, "no warnings\n");
+   else if (tfatals > 0)
+      fprintf(stderr, "\n");
+
+#ifdef TranStats
+   tokdump();
+#endif					/* TranStats */
+
+   return tfatals;
+   }
+
+/*
+ * translate one file.
+ */
+static void trans1(filename)
+char *filename;
+   {
+   in_line = 1;			/* start with line 1, column 0 */
+   incol = 0;
+   peekc = 0;			/* clear character lookahead */
+
+   if (!ppinit(filename,lpath?lpath:".",m4pre)) {
+      tfatal(filename, "cannot open source file");
+      return;
+      }
+   if (!largeints)		/* undefine predef symbol if no -l option */
+      ppdef("_LARGE_INTEGERS", (char *)NULL);
+   ppdef("_MULTITASKING", (char *)NULL);	/* never defined in compiler */
+   ppdef("_EVENT_MONITOR", (char *)NULL);
+   ppdef("_MEMORY_MONITOR", (char *)NULL);
+   ppdef("_VISUALIZATION", (char *)NULL);
+
+   if (strcmp(filename,"-") == 0)
+      filename = "stdin";
+   if (verbose > 0)
+      fprintf(stderr, "%s:\n",filename);
+
+   tok_loc.n_file = filename;
+   in_line = 1;
+
+   if (pponly)
+      ppecho();			/* preprocess only */
+   else
+   yyparse();				/* Parse the input */
+      }
+
+/*
+ * writecheck - check the return code from a stdio output operation
+ */
+void writecheck(rc)
+   int rc;
+
+   {
+   if (rc < 0)
+      quit("unable to write to icode file");
+   }
+
+/*
+ * lnkdcl - find file locally or on LPATH and add to source list.
+ */
+void lnkdcl(name)
+char *name;
+{
+   struct srcfile **pp;
+   struct srcfile *p;
+   char buf[MaxPath];
+
+   if (pathfind(buf, lpath, name, SourceSuffix))
+      src_file(buf);
+   else
+      tfatal("cannot resolve reference to file name", name);
+      }
+
+/*
+ * src_file - add the file name to the list of source files to be translated,
+ *   if it is not already on the list.
+ */
+void src_file(name)
+char *name;
+   {
+   struct srcfile **pp;
+   struct srcfile *p;
+
+   for (pp = &srclst; *pp != NULL; pp = &(*pp)->next)
+     if (strcmp((*pp)->name, name) == 0)
+        return;
+   p = NewStruct(srcfile);
+   p->name = salloc(name);
+   p->next = NULL;
+   *pp = p;
+}
diff --git a/src/iconc/ctrans.h b/src/iconc/ctrans.h
new file mode 100644
index 0000000..3e03d06
--- /dev/null
+++ b/src/iconc/ctrans.h
@@ -0,0 +1,47 @@
+/*
+ *  Miscellaneous compiler-specific definitions.
+ */
+
+#define Iconc
+
+#ifndef CUsage
+   #define CUsage "[-C C-comp] [-E] [-T] [-c] [-f{adelns}] [-n{acest}]\n\
+ [-o ofile] [-p C-opts] [-r runtime] [-s] [-t] [-u] [-v i]"
+#endif					/* CUsage */
+
+#define Abs(n) ((n) >= 0 ? (n) : -(n))
+#define Max(x,y) ((x)>(y)?(x):(y))
+
+#define tonum(c)	(isdigit(c) ? (c - '0') : ((c & 037) + 9))
+
+/*
+ * Hash tables must be a power of 2.
+ */
+#define CHSize 128	/* size of constant hash table */
+#define FHSize  32	/* size of field hash table */
+#define GHSize 128	/* size of global hash table */
+#define LHSize 128	/* size of local hash table */
+
+#define PrfxSz 3        /* size of prefix */
+
+/*
+ * srcfile is used construct the queue of source files to be translated.
+ */
+struct srcfile {
+   char *name;
+   struct srcfile *next;
+   };
+
+extern struct srcfile *srclst;
+
+/*
+ * External definitions needed throughout translator.
+ */
+extern int twarns;
+
+#ifdef TranStats
+#include "tstats.h"
+#else					/* TranStats */
+#define TokInc(x)
+#define TokDec(x)
+#endif					/* TranStats */
diff --git a/src/iconc/ctree.c b/src/iconc/ctree.c
new file mode 100644
index 0000000..170a631
--- /dev/null
+++ b/src/iconc/ctree.c
@@ -0,0 +1,777 @@
+/*
+ * ctree.c -- functions for constructing parse trees.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "ctree.h"
+#include "csym.h"
+#include "ctoken.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * prototypes for static functions.
+ */
+static nodeptr chk_empty (nodeptr n);
+static void put_elms  (nodeptr t, nodeptr args, int slot);
+static nodeptr subsc_nd  (nodeptr op, nodeptr arg1, nodeptr arg2);
+
+/*
+ *  tree[1-6] construct parse tree nodes with specified values.
+ *   loc_model is a node containing the same line and column information
+ *   as is needed in this node, while parameters a through d are values to
+ *   be assigned to n_field[0-3]. Note that this could be done with a
+ *   single routine; a separate routine for each node size is used for
+ *   speed and simplicity.
+ */
+
+nodeptr tree1(type)
+int type;
+   {
+   register nodeptr t;
+
+   t = NewNode(0);
+   t->n_type = type;
+   t->n_file = NULL;
+   t->n_line = 0;
+   t->n_col = 0;
+   t->freetmp = NULL;
+   return t;
+   }
+
+nodeptr tree2(type, loc_model)
+int type;
+nodeptr loc_model;
+   {
+   register nodeptr t;
+
+   t = NewNode(0);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   return t;
+   }
+
+nodeptr tree3(type, loc_model, a)
+int type;
+nodeptr loc_model;
+nodeptr a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   return t;
+   }
+
+nodeptr tree4(type, loc_model, a, b)
+int type;
+nodeptr loc_model;
+nodeptr a, b;
+   {
+   register nodeptr t;
+
+   t = NewNode(2);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   return t;
+   }
+
+nodeptr tree5(type, loc_model, a, b, c)
+int type;
+nodeptr loc_model;
+nodeptr a, b, c;
+   {
+   register nodeptr t;
+
+   t = NewNode(3);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   t->n_field[2].n_ptr = c;
+   return t;
+   }
+
+nodeptr tree6(type, loc_model, a, b, c, d)
+int type;
+nodeptr loc_model;
+nodeptr a, b, c, d;
+   {
+   register nodeptr t;
+
+   t = NewNode(4);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = a;
+   t->n_field[1].n_ptr = b;
+   t->n_field[2].n_ptr = c;
+   t->n_field[3].n_ptr = d;
+   return t;
+   }
+
+nodeptr int_leaf(type, loc_model, a)
+int type;
+nodeptr loc_model;
+int a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = a;
+   return t;
+   }
+
+nodeptr c_str_leaf(type, loc_model, a)
+int type;
+nodeptr loc_model;
+char *a;
+   {
+   register nodeptr t;
+
+   t = NewNode(1);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_str = a;
+   return t;
+   }
+
+/*
+ * i_str_leaf - create a leaf node containing a string and length.
+ */
+nodeptr i_str_leaf(type, loc_model, a, b)
+int type;
+nodeptr loc_model;
+char *a;
+int b;
+   {
+   register nodeptr t;
+
+   t = NewNode(2);
+   t->n_type = type;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_str = a;
+   t->n_field[1].n_val = b;
+   return t;
+   }
+
+/*
+ * key_leaf - create a leaf node for a keyword.
+ */
+nodeptr key_leaf(loc_model, keyname)
+nodeptr loc_model;
+char *keyname;
+   {
+   register nodeptr t;
+   struct implement *ip;
+   struct il_code *il;
+   char *s;
+   int typcd;
+
+   /*
+    * Find the data base entry for the keyword, if it exists.
+    */
+   ip = db_ilkup(keyname, khash);
+
+   if (ip == NULL)
+      tfatal("invalid keyword", keyname);
+   else if (ip->in_line == NULL)
+      tfatal("keyword not installed", keyname);
+   else {
+      il = ip->in_line;
+      s = il->u[1].s;
+      if (il->il_type == IL_Const) {
+        /*
+         * This is a constant keyword, treat it as a literal.
+         */
+        t = NewNode(1);
+        t->n_file = loc_model->n_file;
+        t->n_line = loc_model->n_line;
+        t->n_col = loc_model->n_col;
+        t->freetmp = NULL;
+        typcd = il->u[0].n;
+        if (typcd == cset_typ) {
+           t->n_type =  N_Cset;
+           CSym0(t) = putlit(&s[1], F_CsetLit, strlen(s) - 2);
+           }
+        else if (typcd == int_typ) {
+           t->n_type = N_Int;
+           CSym0(t) = putlit(s, F_IntLit, 0);
+           }
+        else if (typcd == real_typ) {
+           t->n_type = N_Real;
+           CSym0(t) = putlit(s, F_RealLit, 0);
+           }
+        else if (typcd == str_typ) {
+           t->n_type = N_Str;
+           CSym0(t) = putlit(&s[1], F_StrLit, strlen(s) - 2);
+           }
+        return t;
+        }
+     }
+
+   t = NewNode(2);
+   t->n_type = N_InvOp;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 0;      /* number of arguments */
+   t->n_field[1].ip = ip;
+   return t;
+   }
+
+/*
+ * list_nd - create a list creation node.
+ */
+nodeptr list_nd(loc_model, args)
+nodeptr loc_model;
+nodeptr args;
+   {
+   register nodeptr t;
+   struct implement *impl;
+   int nargs;
+
+   /*
+    * Determine the number of arguments.
+    */
+   if (args->n_type == N_Empty)
+      nargs = 0;
+   else {
+      nargs = 1;
+      for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
+         ++nargs;
+      if (nargs > max_prm)
+         max_prm = nargs;
+      }
+
+   impl = spec_op[ListOp];
+   if (impl == NULL)
+      nfatal(loc_model, "list creation not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(loc_model, "list creation not installed", NULL);
+
+   t = NewNode(nargs + 2);
+   t->n_type = N_InvOp;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = nargs;
+   t->n_field[1].ip = impl;
+   if (nargs > 0)
+      put_elms(t, args, nargs + 1);
+   return t;
+   }
+
+/*
+ * invk_nd - create a node for invocation.
+ */
+nodeptr invk_nd(loc_model, proc, args)
+nodeptr loc_model;
+nodeptr proc;
+nodeptr args;
+   {
+   register nodeptr t;
+   int nargs;
+
+   /*
+    * Determine the number of arguments.
+    */
+   if (args->n_type == N_Empty)
+      nargs = 0;
+   else {
+      nargs = 1;
+      for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
+         ++nargs;
+      if (nargs > max_prm)
+         max_prm = nargs;
+      }
+
+   t = NewNode(nargs + 2);
+   t->n_type = N_Invok;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = nargs;
+   t->n_field[1].n_ptr = proc;
+   if (nargs > 0)
+      put_elms(t, args, nargs + 1);
+   return t;
+   }
+
+/*
+ * put_elms - convert a linked list of arguments into an array of arguments
+ *  in a node.
+ */
+static void put_elms(t, args, slot)
+nodeptr t;
+nodeptr args;
+int slot;
+   {
+   if (args->n_type == N_Elist) {
+      /*
+       * The linked list is in reverse argument order.
+       */
+      t->n_field[slot].n_ptr = chk_empty(args->n_field[1].n_ptr);
+      put_elms(t, args->n_field[0].n_ptr, slot - 1);
+      free(args);
+      }
+   else
+      t->n_field[slot].n_ptr = chk_empty(args);
+   }
+
+/*
+ * chk_empty - if an argument is empty, replace it with &null.
+ */
+static nodeptr chk_empty(n)
+nodeptr n;
+   {
+   if (n->n_type == N_Empty)
+      n = key_leaf(n, spec_str("null"));
+   return n;
+   }
+
+/*
+ * case_nd - create a node for a case statement.
+ */
+nodeptr case_nd(loc_model, expr, cases)
+nodeptr loc_model;
+nodeptr expr;
+nodeptr cases;
+   {
+   register nodeptr t;
+   nodeptr reverse;
+   nodeptr nxt_cases;
+   nodeptr ccls;
+
+   t = NewNode(3);
+   t->n_type = N_Case;
+   t->n_file = loc_model->n_file;
+   t->n_line = loc_model->n_line;
+   t->n_col = loc_model->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_ptr = expr;
+   t->n_field[2].n_ptr = NULL;
+
+   /*
+    * The list of cases is in reverse order. Walk the list reversing it,
+    *  and extract the default clause if one exists.
+    */
+   reverse = NULL;
+   while (cases->n_type != N_Ccls) {
+      nxt_cases = cases->n_field[0].n_ptr;
+      ccls = cases->n_field[1].n_ptr;
+      if (ccls->n_field[0].n_ptr->n_type == N_Res) {
+         /*
+          * default clause.
+          */
+         if (t->n_field[2].n_ptr == NULL)
+            t->n_field[2].n_ptr = ccls->n_field[1].n_ptr;
+         else
+            nfatal(ccls, "duplicate default clause", NULL);
+         }
+       else {
+          if (reverse == NULL) {
+             reverse = cases;
+             reverse->n_field[0].n_ptr = ccls;
+             }
+          else {
+             reverse->n_field[1].n_ptr = ccls;
+             cases->n_field[0].n_ptr = reverse;
+             reverse = cases;
+             }
+         }
+      cases = nxt_cases;
+      }
+
+   /*
+    * Last element in list.
+    */
+   if (cases->n_field[0].n_ptr->n_type == N_Res) {
+      /*
+       * default clause.
+       */
+      if (t->n_field[2].n_ptr == NULL)
+         t->n_field[2].n_ptr = cases->n_field[1].n_ptr;
+      else
+         nfatal(ccls, "duplicate default clause", NULL);
+      if (reverse != NULL)
+         reverse = reverse->n_field[0].n_ptr;
+      }
+   else {
+      if (reverse == NULL)
+         reverse = cases;
+      else
+         reverse->n_field[1].n_ptr = cases;
+      }
+   t->n_field[1].n_ptr = reverse;
+   return t;
+   }
+
+/*
+ * multiunary - construct nodes to implement a sequence of unary operators
+ *  that have been lexically analyzed as one operator.
+ */
+nodeptr multiunary(op, loc_model, oprnd)
+nodeptr loc_model;
+char *op;
+nodeptr oprnd;
+   {
+   int n;
+   nodeptr nd;
+
+   if (*op == '\0')
+     return oprnd;
+   for (n = 0; optab[n].tok.t_word != NULL; ++n)
+      if ((optab[n].expected & Unary) & (*(optab[n].tok.t_word) == *op)) {
+         nd = OpNode(n);
+         nd->n_file = loc_model->n_file;
+         nd->n_line = loc_model->n_line;
+         nd->n_col = loc_model->n_col;
+         return unary_nd(nd,multiunary(++op,loc_model,oprnd));
+         }
+   fprintf(stderr, "compiler error: inconsistent parsing of unary operators");
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * binary_nd - construct a node for a binary operator.
+ */
+nodeptr binary_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for the operator.
+    */
+   impl = optab[Val0(op)].binary;
+   if (impl == NULL)
+      nfatal(op, "binary operator not implemented", optab[Val0(op)].tok.t_word);
+   else if (impl->in_line == NULL)
+      nfatal(op, "binary operator not installed", optab[Val0(op)].tok.t_word);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * unary_nd - construct a node for a unary operator.
+ */
+nodeptr unary_nd(op, arg)
+nodeptr op;
+nodeptr arg;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for the operator.
+    */
+   impl = optab[Val0(op)].unary;
+   if (impl == NULL)
+      nfatal(op, "unary operator not implemented", optab[Val0(op)].tok.t_word);
+   else if (impl->in_line == NULL)
+      nfatal(op, "unary operator not installed", optab[Val0(op)].tok.t_word);
+
+   t = NewNode(3);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 1;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg;
+   return t;
+   }
+
+/*
+ * buildarray - convert "multi-dimensional" subscripting into a sequence
+ *  of subsripting operations.
+ */
+nodeptr buildarray(a,lb,e)
+nodeptr a, lb, e;
+   {
+   register nodeptr t, t2;
+   if (e->n_type == N_Elist) {
+      t2 = int_leaf(lb->n_type, lb, lb->n_field[0].n_val);
+      t = subsc_nd(t2, buildarray(a,lb,e->n_field[0].n_ptr),
+         e->n_field[1].n_ptr);
+      free(e);
+      }
+   else
+      t = subsc_nd(lb, a, e);
+   return t;
+   }
+
+/*
+ * subsc_nd - construct a node for subscripting.
+ */
+static nodeptr subsc_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for subscripting.
+    */
+   impl = spec_op[SubscOp];
+   if (impl == NULL)
+      nfatal(op, "subscripting not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "subscripting not installed", NULL);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * to_nd - construct a node for binary to.
+ */
+nodeptr to_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for to.
+    */
+   impl = spec_op[ToOp];
+   if (impl == NULL)
+      nfatal(op, "'i to j' not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "'i to j' not installed", NULL);
+
+   t = NewNode(4);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 2;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   return t;
+   }
+
+/*
+ * toby_nd - construct a node for binary to-by.
+ */
+nodeptr toby_nd(op, arg1, arg2, arg3)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+nodeptr arg3;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   /*
+    * Find the data base entry for to-by.
+    */
+   impl = spec_op[ToByOp];
+   if (impl == NULL)
+      nfatal(op, "'i to j by k' not implemented", NULL);
+   else if (impl->in_line == NULL)
+      nfatal(op, "'i to j by k' not installed", NULL);
+
+   t = NewNode(5);
+   t->n_type = N_InvOp;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 3;      /* number of arguments */
+   t->n_field[1].ip = impl;
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   t->n_field[4].n_ptr = arg3;
+   return t;
+   }
+
+/*
+ * aug_nd - create a node for an augmented assignment.
+ */
+nodeptr aug_nd(op, arg1, arg2)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+   {
+   register nodeptr t;
+   struct implement *impl;
+
+   t = NewNode(5);
+   t->n_type = N_Augop;
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+
+   /*
+    * Find the data base entry for assignment.
+    */
+   impl = optab[asgn_loc].binary;
+   if (impl == NULL)
+      nfatal(op, "assignment not implemented", NULL);
+   t->n_field[0].ip = impl;
+
+   /*
+    * The operator table entry for the augmented assignment is
+    *  immediately after the entry for the operation.
+    */
+   impl = optab[Val0(op) - 1].binary;
+   if (impl == NULL)
+      nfatal(op, "binary operator not implemented",
+         optab[Val0(op) - 1].tok.t_word);
+   t->n_field[1].ip = impl;
+
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   /* t->n_field[4].typ - type of intermediate result */
+   return t;
+   }
+
+/*
+ * sect_nd - create a node for sectioning.
+ */
+nodeptr sect_nd(op, arg1, arg2, arg3)
+nodeptr op;
+nodeptr arg1;
+nodeptr arg2;
+nodeptr arg3;
+   {
+   register nodeptr t;
+   int tok;
+   struct implement *impl;
+   struct implement *impl1;
+
+   t = NewNode(5);
+   t->n_file = op->n_file;
+   t->n_line = op->n_line;
+   t->n_col = op->n_col;
+   t->freetmp = NULL;
+
+   /*
+    * Find the data base entry for sectioning.
+    */
+   impl = spec_op[SectOp];
+   if (impl == NULL)
+      nfatal(op, "sectioning not implemented", NULL);
+
+   tok = optab[Val0(op)].tok.t_type;
+   if (tok == COLON) {
+      /*
+       * Simple sectioning, treat as a ternary operator.
+       */
+      t->n_type = N_InvOp;
+      t->n_field[0].n_val = 3;      /* number of arguments */
+      t->n_field[1].ip = impl;
+      }
+   else {
+      /*
+       * Find the data base entry for addition or subtraction.
+       */
+      if (tok == PCOLON) {
+         impl1 = optab[plus_loc].binary;
+         if (impl1 == NULL)
+            nfatal(op, "addition not implemented", NULL);
+         }
+      else { /* MCOLON */
+         impl1 = optab[minus_loc].binary;
+         if (impl1 == NULL)
+            nfatal(op, "subtraction not implemented", NULL);
+         }
+      t->n_type = N_Sect;
+      t->n_field[0].ip = impl;
+      t->n_field[1].ip = impl1;
+      }
+   t->n_field[2].n_ptr = arg1;
+   t->n_field[3].n_ptr = arg2;
+   t->n_field[4].n_ptr = arg3;
+   return t;
+   }
+
+/*
+ * invk_main - produce an procedure invocation node with one argument for
+ *  use in the initial invocation to main() during type inference.
+ */
+nodeptr invk_main(main_proc)
+struct pentry *main_proc;
+   {
+   register nodeptr t;
+
+   t = NewNode(3);
+   t->n_type = N_InvProc;
+   t->n_file = NULL; 
+   t->n_line = 0;
+   t->n_col = 0;
+   t->freetmp = NULL;
+   t->n_field[0].n_val = 1;               /* 1 argument */
+   t->n_field[1].proc = main_proc;
+   t->n_field[2].n_ptr = tree1(N_Empty);
+
+   if (max_prm < 1)
+      max_prm = 1;
+   return t;
+   }
diff --git a/src/iconc/ctree.h b/src/iconc/ctree.h
new file mode 100644
index 0000000..d38d3c4
--- /dev/null
+++ b/src/iconc/ctree.h
@@ -0,0 +1,200 @@
+/*
+ * Structure of a tree node.
+ */
+
+typedef	struct node	*nodeptr;
+
+/*
+ * Kinds of fields in syntax tree node.
+ */
+union field {
+   long n_val;		 /* integer-valued fields */
+   char *n_str;		 /* string-valued fields */
+   struct lentry *lsym;  /* fields referencing local symbol table entries */ 
+   struct centry *csym;  /* fields referencing constant symbol table entries */
+   struct implement *ip; /* fields referencing an operation */
+   struct pentry *proc;	 /* pointer to procedure entry */
+   struct rentry *rec;	 /* pointer to record entry */
+#ifdef OptimizeType
+   struct typinfo *typ;  /* extra type field */
+#else					/* OptimizeType */
+   unsigned int *typ;    /* extra type field */
+#endif					/* OptimizeType */
+   nodeptr n_ptr;	 /* subtree pointers */
+   };
+
+/*
+ * A store is an array that maps variables types (which are given indexes)
+ *  to the types stored within the variables.
+ */
+struct store {
+   struct store *next;
+   int perm;               /* flag: whether store stays across iterations */
+#ifdef OptimizeType
+   struct typinfo *types[1]; /* actual size is number of variables */
+#else					/* OptimizeType */
+   unsigned int *types[1]; /* actual size is number of variables */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * Array of parameter types for an operation call.
+ */
+struct symtyps {
+   int nsyms;                /* number of parameter symbols */
+   struct symtyps *next;
+#ifdef OptimizeType
+   struct typinfo *types[1];   /* really one for every symbol */
+#else					/* OptimizeType */
+   unsigned int *types[1];   /* really one for every symbol */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * definitions for maintaining allocation status.
+ */
+#define NotAlloc 0   /* temp var neither in use nor reserved */
+#define InUnse   1   /* temp var currently contains live variable */
+/*            n < 0     reserved: must be free by node with postn field = n */
+
+#define DescTmp 1    /* allocation of descriptor temporary */
+#define CIntTmp 2    /* allocation of C integer temporary */
+#define CDblTmp 3    /* allocation of C double temporary */
+#define SBuf    4    /* allocation of string buffer */
+#define CBuf    5    /* allocation of cset buffer */
+
+struct freetmp {     /* list of things to free at a node */
+   int kind;         /*   DescTmp, CIntTmp, CDblTmp, SBuf, or CBuf */
+   int indx;         /*   index into status array */
+   int old;          /*   old status */
+   struct freetmp *next;
+   };
+
+struct node {
+   int n_type;		    /* node type */
+   char *n_file;	    /* name of file containing source program */
+   int n_line;		    /* line number in source program */
+   int n_col;		    /* column number in source program */
+   int flag;
+   int *new_types;          /* pntr to array of struct types created here */
+#ifdef OptimizeType
+   struct typinfo *type;	    /* type of this expression */
+#else					/* OptimizeType */
+   unsigned int *type;		    /* type of this expression */
+#endif					/* OptimizeType */
+   struct store *store;     /* if needed, store saved between iterations */
+   struct symtyps *symtyps; /* for operation in data base: types of arg syms */
+   nodeptr lifetime;        /* lifetime of intermediate result */
+   int reuse;               /* result may be reused without being recomputed */
+   nodeptr intrnl_lftm;     /* lifetime of variables internal to operation */
+   int postn;               /* relative position of node in execution order */
+   struct freetmp *freetmp; /* temporary variables to free at this point */
+   union field n_field[1];  /* node fields */
+   };
+
+/*
+ * NewNode - allocate a parse tree node with "size" fields.
+ */
+#define NewNode(size) (struct node *)alloc((unsigned int)\
+    (sizeof(struct node) + (size-1) * sizeof(union field)))
+
+/*
+ * Macros to access fields of parse tree nodes.
+ */
+
+#define Type(t)		t->n_type
+#define File(t)		t->n_file
+#define Line(t)		t->n_line
+#define Col(t)		t->n_col
+#define Tree0(t)	t->n_field[0].n_ptr
+#define Tree1(t)	t->n_field[1].n_ptr
+#define Tree2(t)	t->n_field[2].n_ptr
+#define Tree3(t)	t->n_field[3].n_ptr
+#define Tree4(t)	t->n_field[4].n_ptr
+#define Val0(t)		t->n_field[0].n_val
+#define Val1(t)		t->n_field[1].n_val
+#define Val2(t)		t->n_field[2].n_val
+#define Val3(t)		t->n_field[3].n_val
+#define Val4(t)		t->n_field[4].n_val
+#define Str0(t)		t->n_field[0].n_str
+#define Str1(t)		t->n_field[1].n_str
+#define Str2(t)		t->n_field[2].n_str
+#define Str3(t)		t->n_field[3].n_str
+#define LSym0(t)	t->n_field[0].lsym
+#define CSym0(t)	t->n_field[0].csym
+#define Impl0(t)	t->n_field[0].ip
+#define Impl1(t)	t->n_field[1].ip
+#define Rec1(t)		t->n_field[1].rec
+#define Proc1(t)	t->n_field[1].proc
+#define Typ4(t)		t->n_field[4].typ
+
+/*
+ * External declarations.
+ */
+
+extern nodeptr yylval;		/* parser's current token value */
+extern struct node tok_loc;     /* "model" token holding current location */
+
+/*
+ * Node types.
+ */
+
+#define N_Activat	 1		/* activation control structure */
+#define N_Alt		 2		/* alternation operator */
+#define N_Apply		 3		/* procedure application */
+#define N_Augop		 4		/* augmented operator */
+#define N_Bar		 5		/* generator control structure */
+#define N_Break		 6		/* break statement */
+#define N_Case		 7		/* case statement */
+#define N_Ccls		 8		/* case clause */
+#define N_Clist		 9		/* list of case clauses */
+#define N_Create	10		/* create control structure */
+#define N_Cset		11		/* cset literal */
+#define N_Elist		12		/* list of expressions */
+#define N_Empty		13		/* empty expression or statement */
+#define N_Field		14		/* record field reference */
+#define N_Id		15		/* identifier token */
+#define N_If		16		/* if-then-else statement */
+#define N_Int		17		/* integer literal */
+#define N_Invok		18		/* invocation */
+#define N_InvOp		19		/* invoke operation */
+#define N_InvProc	20		/* invoke operation */
+#define N_InvRec	21		/* invoke operation */
+#define N_Limit		22		/* LIMIT control structure */
+#define N_Loop		23		/* while, until, every, or repeat */
+#define N_Next		24		/* next statement */
+#define N_Not		25		/* not prefix control structure */
+#define N_Op		26		/* operator token */
+#define N_Proc		27		/* procedure */
+#define N_Real		28		/* real literal */
+#define N_Res		29		/* reserved word token */
+#define N_Ret		30		/* fail, return, or succeed */
+#define N_Scan		31		/* scan-using statement */
+#define N_Sect		32		/* s[i:j] (section) */
+#define N_Slist		33		/* list of statements */
+#define N_Str		34		/* string literal */
+#define N_SmplAsgn	35		/* simple assignment to named var */ 
+#define N_SmplAug	36		/* simple assignment to named var */ 
+
+#define AsgnDirect 0  /* rhs of special := can compute directly into var */
+#define AsgnCopy   1  /* special := must copy result into var */
+#define AsgnDeref  2  /* special := must dereference result into var */
+
+
+/*
+ * Macros for constructing basic nodes.
+ */
+
+#define CsetNode(a,b)		i_str_leaf(N_Cset,&tok_loc,a,b) 
+#define IdNode(a)		c_str_leaf(N_Id,&tok_loc,a) 
+#define IntNode(a)		c_str_leaf(N_Int,&tok_loc,a) 
+#define OpNode(a)		int_leaf(N_Op,&tok_loc,a) 
+#define RealNode(a)		c_str_leaf(N_Real,&tok_loc,a) 
+#define ResNode(a)		int_leaf(N_Res,&tok_loc,a) 
+#define StrNode(a,b)		i_str_leaf(N_Str,&tok_loc,a,b) 
+
+/*
+ * MultiUnary - create subtree from an operator symbol that represents
+ *  multiple unary operators.
+ */
+#define MultiUnary(a,b) multiunary(optab[Val0(a)].tok.t_word, a, b)
diff --git a/src/iconc/dbase.c b/src/iconc/dbase.c
new file mode 100644
index 0000000..fdd3e50
--- /dev/null
+++ b/src/iconc/dbase.c
@@ -0,0 +1,196 @@
+/*
+ * dbase.c - routines to access data base of implementation information
+ *  produced by rtt.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+/*
+ * Prototypes.
+ */
+static int chck_spec (struct implement *ip);
+static int acpt_op   (struct implement *ip);
+
+
+static struct optab *optr; /* pointer into operator table */
+
+/*
+ * readdb - read data base produced by rtt.
+ */
+void readdb(db_name)
+char *db_name;
+   {
+   char *op, *s;
+   int i;
+   struct implement *ip;
+   char buf[MaxPath];			/* file name construction buffer */
+   struct fileparts *fp;
+   unsigned hashval;
+
+   fp = fparse(db_name);
+   if (*fp->ext == '\0')
+      db_name = salloc(makename(buf, NULL, db_name, DBSuffix));
+   else if (!smatch(fp->ext, DBSuffix))
+      quitf("bad data base name: %s", db_name);
+
+   if (!db_open(db_name, &s))
+        db_err1(1, "cannot open data base");
+
+   if (largeints && (*s == 'N')) {
+       twarn("Warning, run-time system does not support large integers", NULL);
+       largeints = 0;
+       }
+
+   /*
+    * Read information about functions.
+    */
+   db_tbl("functions", bhash);
+
+   /*
+    * Read information about operators.
+    */
+   optr = optab;
+
+   /*
+    * read past operators header.
+    */
+   db_chstr("operators", "operators");
+
+   while ((op = db_string()) != NULL) {
+      if ((ip = db_impl('O')) == NULL)
+         db_err2(1, "no implementation information for operator", op);
+      ip->op = op;
+      if (acpt_op(ip)) {
+         db_code(ip);
+         hashval = IHasher(op);
+         ip->blink = ohash[hashval];
+         ohash[hashval] = ip;
+         db_chstr("end", "end");
+         }
+      else
+         db_dscrd(ip);
+      }
+   db_chstr("endsect", "endsect");
+
+   /*
+    * Read information about keywords.
+    */
+   db_tbl("keywords", khash);
+
+   db_close();
+
+   /*
+    * If error conversion is supported, make sure it is reflected in
+    *   the minimum result sequence of operations.
+    */
+   if (err_conv) {
+      for (i = 0; i < IHSize; ++i)
+         for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      for (i = 0; i < IHSize; ++i)
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      for (i = 0; i < IHSize; ++i)
+         for (ip = khash[i]; ip != NULL; ip = ip->blink)
+            if (ip->ret_flag & DoesEFail)
+               ip->min_result = 0;
+      }
+   }
+
+/*
+ * acpt_opt - given a data base entry for an operator determine if it
+ *  is in iconc's operator table.
+ */
+static int acpt_op(ip)
+struct implement *ip;
+   {
+   register char *op;
+   register int opcmp;
+
+   /*
+    * Calls to this function are in lexical order by operator symbol continue
+    *  searching operator table  from where we left off.
+    */
+   op = ip->op;
+   for (;;) {
+      /*
+       * optab has augmented assignments out of lexical order. Skip anything
+       *  which does not expect an implementation. This gets augmented
+       *  assignments out of the way.
+       */
+      while (optr->expected == 0 && optr->tok.t_word != NULL)
+         ++optr;
+      if (optr->tok.t_word == NULL)
+         return chck_spec(ip);
+      opcmp = strcmp(op, optr->tok.t_word);
+      if (opcmp > 0)
+         ++optr;
+      else if (opcmp < 0)
+         return chck_spec(ip);
+      else {
+         if (ip->nargs == 1 && (optr->expected & Unary)) {
+            if (optr->unary == NULL) {
+               optr->unary = ip;
+               return 1;
+               }
+            else
+               return 0;
+            }
+         else if (ip->nargs == 2 && (optr->expected & Binary)) {
+            if (optr->binary == NULL) {
+               optr->binary = ip;
+               return 1;
+               }
+            else
+               return 0;
+            }
+         else
+            return chck_spec(ip);
+         }
+      }
+   }
+
+/*
+ * chck_spec - check whether the operator is one that does not use standard
+ *    unary or binary syntax.
+ */
+static int chck_spec(ip)
+struct implement *ip;
+   {
+   register char *op;
+   int indx;
+
+   indx = -1;
+   op = ip->op;
+   if (strcmp(op, "...") == 0) {
+      if (ip->nargs == 2)
+         indx = ToOp;
+      else
+         indx = ToByOp;
+      }
+   else if (strcmp(op, "[:]") == 0)
+      indx = SectOp;
+   else if (strcmp(op, "[]") == 0)
+      indx = SubscOp;
+   else if (strcmp(op, "[...]") == 0)
+      indx = ListOp;
+
+   if (indx == -1) {
+      db_err2(0, "unexpected operator (or arity),", op);
+      return 0;
+      }
+   if (spec_op[indx] == NULL) {
+      spec_op[indx] = ip;
+      return 1;
+      }
+   else
+      return 0;
+   }
diff --git a/src/iconc/fixcode.c b/src/iconc/fixcode.c
new file mode 100644
index 0000000..b8c06e0
--- /dev/null
+++ b/src/iconc/fixcode.c
@@ -0,0 +1,372 @@
+/*
+ * fixcode.c - routines to "fix code" by determining what signals are returned
+ *   by continuations and what must be done when they are.  Also perform
+ *   optional control flow optimizations.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "ctree.h"
+#include "csym.h"
+#include "cproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static struct code    *ck_unneed (struct code *cd, struct code *lbl);
+static void         clps_brch (struct code *branch);
+static void         dec_refs  (struct code *cd);
+static void         rm_unrch  (struct code *cd);
+
+/*
+ * fix_fncs - go through the generated C functions, determine how calls
+ *  handle signals, in-line trivial functions where possible, remove
+ *  goto's which immediately precede their labels, and remove unreachable
+ *  code.
+ */
+void fix_fncs(fnc)
+struct c_fnc *fnc;
+   {
+   struct code *cd, *cd1;
+   struct code *contbody;
+   struct sig_act *sa;
+   struct sig_lst *sl;
+   struct code *call;
+   struct code *create;
+   struct code *ret_sig;
+   struct code *sig;
+   struct c_fnc *calledcont;
+   int no_break;
+   int collapse;
+
+   /*
+    * Fix any called functions and decide how the calls handle the
+    *  returned signals.
+    */
+   fnc->flag |= CF_Mark;
+   for (call = fnc->call_lst; call != NULL; call = call->NextCall) {
+      calledcont = call->Cont;
+      if (calledcont != NULL) {
+         if  (!(calledcont->flag & CF_Mark))
+            fix_fncs(calledcont);
+         if (calledcont->flag & CF_ForeignSig) {
+            call->Flags |= ForeignSig;
+            fnc->flag |= CF_ForeignSig;
+            }
+         }
+
+
+      /*
+       * Try to collapse call chains of continuations.
+       */
+      if (opt_cntrl && calledcont != NULL) {
+         contbody = calledcont->cd.next;
+         if (call->OperName == NULL && contbody->cd_id == C_RetSig) {
+           /*
+            * A direct call of a continuation which consists of just a
+            *  return. Replace call with code to handle the returned signal.
+            */
+           ret_sig = contbody->SigRef->sig;
+           if (ret_sig == &resume)
+               cd1 = sig_cd(call->ContFail, fnc);
+            else
+               cd1 = sig_cd(ret_sig, fnc);
+            cd1->prev = call->prev;
+            cd1->prev->next = cd1;
+            cd1->next = call->next;
+            if (cd1->next != NULL)
+               cd1->next->prev = cd1;
+            --calledcont->ref_cnt;
+            continue;	/* move on to next call */
+            }
+         else if (contbody->cd_id == C_CallSig && contbody->next == NULL) {
+            /*
+             * The called continuation contains only a call.
+             */
+            if (call->OperName == NULL) {
+               /*
+                * We call the continuation directly, so we can in-line it.
+                *  We must replace signal returns with appropriate actions.
+                */
+               if (--calledcont->ref_cnt != 0 && contbody->Cont != NULL)
+                  ++contbody->Cont->ref_cnt;
+               call->OperName = contbody->OperName;
+               call->ArgLst = contbody->ArgLst;
+               call->Cont = contbody->Cont;
+               call->Flags = contbody->Flags;
+               for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                  ret_sig = sa->cd->SigRef->sig;
+                  if (ret_sig == &resume)
+                     cd1 = sig_cd(call->ContFail, fnc);
+                  else
+                     cd1 = sig_cd(ret_sig, fnc);
+                  call->SigActs = new_sgact(sa->sig, cd1, call->SigActs);
+                  }
+               continue;	/* move on to next call */
+               }
+            else if (contbody->OperName == NULL) {
+               /*
+                * The continuation simply calls another continuation. We can
+                *  eliminate the intermediate continuation as long as we can
+                *  move signal conversions to the other side of the operation.
+                *  The operation only intercepts resume signals.
+                */
+               collapse = 1;
+               for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                  ret_sig = sa->cd->SigRef->sig;
+                  if (sa->sig != ret_sig && (sa->sig == &resume ||
+                      ret_sig == &resume))
+                     collapse = 0;
+                  }
+               if (collapse) {
+                  if (--calledcont->ref_cnt != 0 && contbody->Cont != NULL)
+                     ++contbody->Cont->ref_cnt;
+                  call->Cont = contbody->Cont;
+                  for (sa = contbody->SigActs; sa != NULL; sa = sa->next) {
+                     ret_sig = sa->cd->SigRef->sig;
+                     if (ret_sig != &resume)
+                        call->SigActs = new_sgact(sa->sig, sig_cd(ret_sig, fnc),
+                           call->SigActs);
+                     }
+                  continue;	/* move on to next call */
+                  }
+               }
+            }
+         }
+
+      /*
+       * We didn't do any optimizations. We must still figure out
+       *  out how to handle signals returned by the continuation.
+       */
+      if (calledcont != NULL) {
+         for (sl = calledcont->sig_lst; sl != NULL; sl = sl->next) {
+            if (sl->ref_cnt > 0) {
+               sig = sl->sig;
+               /*
+                * If an operation is being called, it handles failure from the
+                *  continuation.
+                */
+               if (sig != &resume || call->OperName == NULL) {
+                  if (sig == &resume)
+                     cd1 = sig_cd(call->ContFail, fnc);
+                  else
+                     cd1 = sig_cd(sig, fnc);
+                  call->SigActs = new_sgact(sig, cd1, call->SigActs);
+                  }
+               }
+            }
+         }
+      }
+
+   /*
+    * fix up the signal handling in the functions implementing co-expressions.
+    */
+   for (create = fnc->creatlst; create != NULL; create = create->NextCreat)
+      fix_fncs(create->Cont);
+
+   if (!opt_cntrl)
+      return;  /* control flow optimizations disabled. */
+   /*
+    * Collapse branch chains and remove unreachable code.
+    */
+   for (cd = &(fnc->cd); cd != NULL; cd = cd->next) {
+      switch (cd->cd_id) {
+         case C_CallSig:
+            no_break = 1;
+            for (sa = cd->SigActs; sa != NULL; sa = sa->next) {
+               if (sa->cd->cd_id == C_Break) {
+                  switch (cd->next->cd_id) {
+                     case C_Goto:
+                        sa->cd->cd_id = cd->next->cd_id;
+                        sa->cd->Lbl = cd->next->Lbl;
+                        ++sa->cd->Lbl->RefCnt;
+                        break;
+                     case C_RetSig:
+                        sa->cd->cd_id = cd->next->cd_id;
+                        sa->cd->SigRef= cd->next->SigRef;
+                        ++sa->cd->SigRef->ref_cnt;
+                        break;
+                     default: 
+                        no_break = 0;
+                     }
+                  }
+               if (sa->cd->cd_id == C_Goto)
+                  clps_brch(sa->cd);
+               }
+            if (no_break)
+               rm_unrch(cd);
+            /*
+             * Try converting gotos into breaks.
+             */
+            for (sa = cd->SigActs; sa != NULL; sa = sa->next)
+               if (sa->cd->cd_id == C_Goto) {
+                  cd1 = cd->next;
+                  while (cd1 != NULL && (cd1->cd_id == C_Label ||
+                     cd1->cd_id == C_RBrack)) {
+                        if (cd1 == sa->cd->Lbl) {
+                           sa->cd->cd_id = C_Break;
+                           --cd1->RefCnt;
+                           break;
+                           }
+                        cd1 = cd1->next;
+                        }
+                  }
+            break;
+
+         case C_Goto:
+            clps_brch(cd);
+            rm_unrch(cd);
+            if (cd->cd_id == C_Goto)
+               ck_unneed(cd, cd->Lbl);
+            break;
+
+         case C_If:
+            if (cd->ThenStmt->cd_id == C_Goto) {
+               clps_brch(cd->ThenStmt);
+               if (cd->ThenStmt->cd_id == C_Goto)
+                  ck_unneed(cd, cd->ThenStmt->Lbl);
+               }
+            break;
+
+         case C_PFail:
+         case C_PRet:
+         case C_RetSig:
+            rm_unrch(cd);
+            break;
+         }
+      }
+
+   /*
+    * If this function only contains a return, indicate that we can
+    *  call a shared signal returning function instead of it. This is
+    *  a special case of "common subROUTINE elimination".
+    */
+   if (fnc->cd.next->cd_id == C_RetSig)
+      fnc->flag |= CF_SigOnly;
+   }
+
+/*
+ * clps_brch - collapse branch chains.
+ */
+static void clps_brch(branch)
+struct code *branch;
+   {
+   struct code *cd;
+   int save_id;
+
+   cd = branch->Lbl->next;
+   while (cd->cd_id == C_Label)
+      cd = cd->next;
+
+   /*
+    * Avoid infinite recursion on empty infinite loops.
+    */
+   save_id = branch->cd_id;
+   branch->cd_id = 0;
+   if (cd->cd_id == C_Goto)
+      clps_brch(cd);
+   branch->cd_id = save_id;
+
+   switch (cd->cd_id) {
+      case C_Goto:
+         --branch->Lbl->RefCnt;
+         ++cd->Lbl->RefCnt;
+         branch->Lbl = cd->Lbl;
+         break;
+      case C_RetSig:
+         /*
+          * This optimization requires that C_Goto have as many fields
+          *  as C_RetSig.
+          */
+         --branch->Lbl->RefCnt;
+         ++cd->SigRef->ref_cnt;
+         branch->cd_id = C_RetSig;
+         branch->SigRef = cd->SigRef;
+         break;
+      }
+   }
+
+/*
+ * rm_unrch - any code after the given point up to the next label is
+ *   unreachable. Remove it.
+ */
+static void rm_unrch(cd)
+struct code *cd;
+   {
+   struct code *cd1;
+
+   for (cd1 = cd->next; cd1 != NULL && cd1->cd_id != C_LBrack &&
+      (cd1->cd_id != C_Label || cd1->RefCnt == 0); cd1 = cd1->next) {
+         if (cd1->cd_id == C_RBrack) {
+            /*
+             * Continue deleting past a '}', but don't delete the '}' itself.
+             */
+            cd->next = cd1;
+            cd1->prev = cd;
+            cd = cd1;
+            }
+         else
+            dec_refs(cd1);
+         }
+   cd->next = cd1;
+   if (cd1 != NULL)
+      cd1->prev = cd;
+   }
+
+/*
+ * dec_refs - decrement reference counts for things this code references.
+ */
+static void dec_refs(cd)
+struct code *cd;
+   {
+   struct sig_act *sa;
+
+   if (cd == NULL)
+      return;
+   switch (cd->cd_id) {
+      case C_Goto:
+         --cd->Lbl->RefCnt;
+         return;
+      case C_RetSig:
+         --cd->SigRef->ref_cnt;
+         return;
+      case C_CallSig:
+         if (cd->Cont != NULL)
+            --cd->Cont->ref_cnt;
+         for (sa = cd->SigActs; sa != NULL; sa = sa->next)
+            dec_refs(sa->cd);
+         return;
+     case C_If:
+         dec_refs(cd->ThenStmt);
+         return;
+     case C_Create:
+        --cd->Cont->ref_cnt;
+         return;
+        }
+   }
+
+/*
+ * ck_unneed - if there is nothing between a goto and its label, except
+ *   perhaps other labels or '}', it is useless, so remove it.
+ */
+static struct code *ck_unneed(cd, lbl)
+struct code *cd;
+struct code *lbl;
+   {
+   struct code *cd1;
+
+   cd1 = cd->next;
+   while (cd1 != NULL && (cd1->cd_id == C_Label || cd1->cd_id == C_RBrack)) {
+      if (cd1 == lbl) {
+         cd = cd->prev;
+         cd->next = cd->next->next;
+         cd->next->prev = cd;
+         --lbl->RefCnt;
+         break;
+         }
+      cd1 = cd1->next;
+      }
+   return cd;
+   }
+
diff --git a/src/iconc/incheck.c b/src/iconc/incheck.c
new file mode 100644
index 0000000..d4110f9
--- /dev/null
+++ b/src/iconc/incheck.c
@@ -0,0 +1,802 @@
+/*
+ * incheck.c - analyze a run-time operation using type information.
+ *   Determine wither the operation can be in-lined and what kinds
+ *   of parameter passing optimizations can be done.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+
+struct op_symentry *cur_symtab; /* symbol table for current operation */
+
+/*
+ * Prototypes for static functions.
+ */
+static struct code *and_cond (struct code *cd1, struct code *cd2);
+static int          cnv_anlz (unsigned int typcd, struct il_code *src,
+                               struct il_c *dflt, struct il_c *dest,
+                               struct code **cdp);
+static int          defer_il (struct il_code *il);
+static int          if_anlz  (struct il_code *il);
+static void      ilc_anlz (struct il_c *ilc);
+static int          il_anlz  (struct il_code *il);
+static void      ret_anlz (struct il_c *ilc);
+static int          tc_anlz  (struct il_code *il, int has_dflt);
+
+static int n_branches;  /* number branches caused by run-time type checking */
+static int side_effect; /* abstract clause indicates side-effect */
+static int n_vararg;    /* size of variable part of arg list to operation */
+static int n_susp;      /* number of suspends */
+static int n_ret;       /* number of returns */
+
+/*
+ * do_inlin - determine if this operation can be in-lined at the current
+ *  invocation. Also gather information about how arguments are used,
+ *  and determine where the success continuation for the operation
+ *  should be put.
+ */
+int do_inlin(impl, n, cont_loc, symtab, n_va) 
+struct implement *impl;
+nodeptr n;
+int *cont_loc;
+struct op_symentry *symtab;
+int n_va;
+   {
+   int nsyms;
+   int i;
+
+   /*
+    * Copy arguments needed by other functions into globals and
+    *  initialize flags and counters for information to be gathered
+    *  during analysis.
+    */
+   cur_symtyps = n->symtyps; /* mapping from arguments to types */
+   cur_symtab = symtab;      /* parameter info to be filled in */
+   n_vararg = n_va;
+   n_branches = 0;
+   side_effect = 0;
+   n_susp = 0;
+   n_ret = 0;
+
+   /*
+    * Analyze the code for this operation using type information for
+    *  the arguments to the invocation.
+    */
+   il_anlz(impl->in_line);
+
+
+   /*
+    * Don't in-line if there is more than one decision made based on
+    *  run-time type checks (this is a heuristic).
+    */
+   if (n_branches > 1)
+      return 0;
+
+   /*
+    * If the operation (after eliminating code not used in this context)
+    *  has one suspend and no returns, the "success continuation" can
+    *  be placed in-line at the suspend site. Otherwise, any suspends
+    *  require a separate function for the continuation.
+    */
+   if (n_susp == 1 && n_ret == 0)
+     *cont_loc = SContIL;    /* in-line continuation */
+   else if (n_susp > 0)
+     *cont_loc = SepFnc;     /* separate function for continuation */
+   else
+     *cont_loc = EndOper;    /* place "continuation" after the operation */
+
+   /*
+    * When an argument at the source level is an Icon variable, it is
+    *  sometimes safe to use it directly in the generated code as the
+    *  argument to the operation. However, it is NOT safe under the
+    *  following conditions:
+    *
+    *    - if the operation modifies the argument.
+    *    - if the operation suspends and resumes so that intervening
+    *      changes to the variable would be visible as changes to the
+    *      argument.
+    *    - if the operation has side effects that might involve the
+    *      variable and be visible as changes to the argument.
+    */
+   nsyms = (cur_symtyps == NULL ? 0 : cur_symtyps->nsyms);
+   for (i = 0; i < nsyms; ++i)
+      if (symtab[i].n_mods == 0 && n->intrnl_lftm == n && !side_effect)
+        symtab[i].var_safe = 1;
+
+   return 1;
+   }
+
+/*
+ * il_anlz - analyze a piece of RTL code. Return an indication of
+ *  whether execution can continue beyond it.
+ */
+static int il_anlz(il)
+struct il_code *il;
+   {
+   int fall_thru;
+   int ncases;
+   int condition;
+   int indx;
+   int i, j;
+
+   if (il == NULL)
+       return 1;
+
+   switch (il->il_type) {
+      case IL_Const: /* should have been replaced by literal node */
+         return 1;
+
+      case IL_If1:
+         /*
+          * if-then statement. Determine whether the condition may
+          *  succeed or fail. Analyze the then clause if needed.
+          */
+         condition = if_anlz(il->u[0].fld);
+         fall_thru = 0;
+         if (condition & MaybeTrue)
+            fall_thru |= il_anlz(il->u[1].fld);
+         if (condition & MaybeFalse)
+            fall_thru = 1;
+         return fall_thru;
+
+      case IL_If2:
+         /*
+          * if-then-else statement. Determine whether the condition may
+          *  succeed or fail. Analyze the "then" clause and the "else"
+          *  clause if needed.
+          */
+         condition = if_anlz(il->u[0].fld);
+         fall_thru = 0;
+         if (condition & MaybeTrue)
+            fall_thru |= il_anlz(il->u[1].fld);
+         if (condition & MaybeFalse)
+            fall_thru |= il_anlz(il->u[2].fld);
+         return fall_thru;
+
+      case IL_Tcase1:
+         /*
+          * type_case statement with no default clause.
+          */
+         return tc_anlz(il, 0);
+
+      case IL_Tcase2:
+         /*
+          * type_case statement with a default clause.
+          */
+         return tc_anlz(il, 1);
+
+      case IL_Lcase:
+         /*
+          * len_case statement. Determine which case matches the number
+          *  of arguments.
+          */
+         ncases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < ncases; ++i) {
+            if (il->u[indx++].n == n_vararg)     /* selection number */
+               return il_anlz(il->u[indx].fld);  /* action */
+            ++indx;
+            }
+         return il_anlz(il->u[indx].fld);        /* default */
+
+      case IL_Acase: {
+         /*
+          * arith_case statement.
+          */
+         struct il_code *var1;
+         struct il_code *var2;
+         int maybe_int;
+         int maybe_dbl;
+         int chk1;
+         int chk2;
+
+         var1 = il->u[0].fld;
+         var2 = il->u[1].fld;
+         arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, NULL,
+           &chk2, NULL);
+
+         /*
+          * Analyze the selected case (note, large integer code is not
+          *  currently in-lined and can be ignored).
+          */
+         fall_thru = 0;
+         if (maybe_int)
+            fall_thru |= il_anlz(il->u[2].fld);     /* C_integer action */
+         if (maybe_dbl)
+            fall_thru |= il_anlz(il->u[4].fld);     /* C_double action */
+         return fall_thru;
+         }
+
+      case IL_Err1:
+         /*
+          * runerr() with no offending value.
+          */
+         return 0;
+
+      case IL_Err2:
+         /*
+          * runerr() with an offending value. Note the reference to
+          *  the offending value descriptor.
+          */
+         indx = il->u[1].fld->u[0].n;    /* symbol table index of variable */
+         if (indx < cur_symtyps->nsyms)
+            ++cur_symtab[indx].n_refs;
+         return 0;
+
+      case IL_Block:
+         /*
+          * inline {...} statement.
+          */
+         i = il->u[1].n + 2;              /* skip declaration stuff */
+         ilc_anlz(il->u[i].c_cd);         /* body of block */
+         return il->u[0].n;
+
+      case IL_Call:
+         /*
+          * call to body function.
+          */
+         if (il->u[3].n & DoesSusp)
+            n_susp = 2;  /* force continuation into separate function */
+
+         /*
+          * Analyze the C code for prototype parameter declarations
+          *  and actual arguments. There are twice as many pieces of
+          *  C code to look at as there are parameters.
+          */
+         j = 2 * il->u[7].n;
+         i = 8;              /* index of first piece of C code */
+         while (j--)
+            ilc_anlz(il->u[i++].c_cd);
+         return ((il->u[3].n & DoesFThru) != 0);
+
+      case IL_Lst:
+         /*
+          * Two consecutive pieces of RTL code.
+          */
+         fall_thru = il_anlz(il->u[0].fld);
+         if (fall_thru)
+            fall_thru = il_anlz(il->u[1].fld);
+         return fall_thru;
+
+      case IL_Abstr:
+         /*
+          * abstract type computation. See if it indicates side effects.
+          */
+         if (il->u[0].fld != NULL)
+             side_effect = 1;
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * if_anlz - analyze the condition of an if statement.
+ */
+static int if_anlz(il)
+struct il_code *il;
+   {
+   int cond;
+   int cond1;
+
+   if (il->il_type == IL_Bang) {
+      /*
+       * ! <condition>, negate the result of the condition
+       */
+      cond1 = cond_anlz(il->u[0].fld, NULL);
+      cond = 0;
+      if (cond1 & MaybeTrue)
+         cond = MaybeFalse;
+      if (cond1 & MaybeFalse)
+         cond |= MaybeTrue;
+      }
+   else
+      cond = cond_anlz(il, NULL);
+   if (cond == (MaybeTrue | MaybeFalse))
+      ++n_branches;  /* must make a run-time decision */
+   return cond;
+   }
+
+/*
+ * cond_anlz - analyze a simple condition or the conjunction of two
+ *   conditions. If cdp is not NULL, use it to return a pointer code
+ *   that implements the condition.
+ */
+int cond_anlz(il, cdp)
+struct il_code *il;
+struct code **cdp;
+   {
+   struct code *cd1;
+   struct code *cd2;
+   int cond1;
+   int cond2;
+   int indx;
+
+   switch (il->il_type) {
+      case IL_And:
+         /*
+          * <cond> && <cond>
+          */
+         cond1 = cond_anlz(il->u[0].fld, (cdp == NULL ? NULL : &cd1));
+         if (cond1 & MaybeTrue) {
+            cond2 = cond_anlz(il->u[1].fld, (cdp == NULL ? NULL : &cd2));
+            if (cdp != NULL) {
+               if (!(cond2 & MaybeTrue))
+                  *cdp = NULL;
+               else
+                  *cdp = and_cond(cd1, cd2);
+               }
+            return (cond1 & MaybeFalse) | cond2;
+            }
+         else {
+            if (cdp != NULL)
+               *cdp = cd1;
+            return cond1;
+            }
+
+      case IL_Cnv1:
+         /*
+          * cnv:<dest-type>(<source>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, NULL, NULL, cdp);
+
+      case IL_Cnv2:
+         /*
+          * cnv:<dest-type>(<source>,<destination>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, NULL, il->u[2].c_cd, cdp);
+
+      case IL_Def1:
+         /*
+          * def:<dest-type>(<source>,<default-value>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, il->u[2].c_cd, NULL, cdp);
+
+      case IL_Def2:
+         /*
+          * def:<dest-type>(<source>,<default-value>,<destination>)
+          */
+         return cnv_anlz(il->u[0].n, il->u[1].fld, il->u[2].c_cd, il->u[3].c_cd,
+            cdp);
+
+      case IL_Is:
+         /*
+          * is:<type-name>(<variable>)
+          */
+         indx = il->u[1].fld->u[0].n;
+         cond1 = eval_is(il->u[0].n, indx);
+         if (cdp == NULL) {
+            if (indx < cur_symtyps->nsyms && cond1 == (MaybeTrue | MaybeFalse))
+               ++cur_symtab[indx].n_refs;
+            }
+         else {
+            if (cond1 == (MaybeTrue | MaybeFalse))
+               *cdp = typ_chk(il->u[1].fld, il->u[0].n);
+            else
+               *cdp = NULL;
+            }
+         return cond1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+
+/*
+ * and_cond - construct && of two conditions, either of which may have
+ *  been optimized away.
+ */
+static struct code *and_cond(cd1, cd2)
+struct code *cd1;
+struct code *cd2;
+   {
+   struct code *cd;
+
+   if (cd1 == NULL)
+      return cd2;
+   else if (cd2 == NULL)
+      return cd1;
+   else {
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Ary;
+      cd->Array(0) =            cd1;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =              " && ";
+      cd->ElemTyp(2) = A_Ary;
+      cd->Array(2) =            cd2;
+      return cd;
+      }
+   }
+
+/*
+ * cnv_anlz - analyze a type conversion. Determine whether it can succeed
+ *  and, if requested, produce code to perform the conversion. Also
+ *  gather information about the variables it uses.
+ */
+static int cnv_anlz(typcd, src, dflt, dest, cdp)
+unsigned int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+struct code **cdp;
+   {
+   struct val_loc *src_loc;
+   int cond;
+   int cnv_flags;
+   int indx;
+
+   /*
+    * Find out what is going on in the default and destination subexpressions.
+    *  (The information is used elsewhere.)
+    */
+   ilc_anlz(dflt);
+   ilc_anlz(dest);
+
+   if (cdp != NULL)
+      *cdp = NULL;   /* clear code pointer in case it is not set below */
+
+   /*
+    * Determine whether the conversion may succeed, whether it may fail,
+    *  and whether it may actually convert a value or use the default
+    *  value when it succeeds.
+    */
+   indx = src->u[0].n;  /* symbol table index for source of conversion */
+   cond = eval_cnv(typcd, indx, dflt != NULL, &cnv_flags);
+
+   /*
+    * Many optimizations are possible depending on whether a conversion
+    *  is actually needed, whether type checking is needed, whether defaulting
+    *  is done, and whether there is an explicit destination. Several
+    *  optimizations are performed here; more may be added in the future.
+    */
+   if (!(cnv_flags & MayDefault))
+      dflt = NULL;  /* demote defaulting to simple conversion */
+
+   if (cond & MaybeTrue) {
+      if (cnv_flags == MayKeep && dest == NULL) {
+          /*
+           * No type conversion, defaulting, or copying is needed.
+           */
+         if (cond & MaybeFalse) {
+            /*
+             * A type check is needed.
+             */
+            ++cur_symtab[indx].n_refs; /* non-modifying reference to source. */
+            if (cdp != NULL) {
+               switch (typcd) {
+                  case TypECInt:
+                     *cdp = typ_chk(src, TypCInt);
+                     break;
+                  case TypEInt:
+                     *cdp = typ_chk(src, int_typ);
+                     break;
+                  case TypTStr:
+                     *cdp = typ_chk(src, str_typ);
+                     break;
+                  case TypTCset:
+                     *cdp = typ_chk(src, cset_typ);
+                     break;
+                  default:
+                     *cdp = typ_chk(src, typcd);
+                  }
+               }
+            }
+
+         if (cdp != NULL) {
+            /*
+             * Conversion from an integer to a C_integer can be done without
+             *  any executable code; this is not considered a real conversion.
+             *  It is accomplished by changing the symbol table so only the
+             *  dword of the descriptor is accessed.
+             */
+            switch (typcd) {
+               case TypCInt:
+               case TypECInt:
+                  cur_symtab[indx].loc = loc_cpy(cur_symtab[indx].loc, M_CInt);
+                  break;
+               }
+            }
+         }
+      else if (dest != NULL && cnv_flags == MayKeep && cond == MaybeTrue) {
+         /*
+          *  There is an explicit destination, but no conversion, defaulting,
+          *   or type checking is needed. Just copy the value to the
+          *   destination.
+          */
+         ++cur_symtab[indx].n_refs; /* non-modifying reference to source */
+         if (cdp != NULL)  {
+            src_loc = cur_symtab[indx].loc;
+            switch (typcd) {
+               case TypCInt:
+               case TypECInt:
+                  /*
+                   * The value is in the dword of the descriptor.
+                   */
+                  src_loc = loc_cpy(src_loc, M_CInt);
+                  break;
+               }
+            *cdp = il_copy(dest, src_loc);
+            }
+         }
+      else if (cnv_flags == MayDefault) {
+         /*
+          * The default value is used.
+          */
+         if (dest == NULL)
+            ++cur_symtab[indx].n_mods; /* modifying reference */
+         if (cdp != NULL) 
+            *cdp = il_dflt(typcd, src, dflt, dest);
+         }
+      else {
+         /*
+          * Produce code to do the actual conversion.
+          *  Determine whether the source location is being modified
+          *  or just referenced.
+          */
+         if (dest == NULL) {
+            /*
+             * "In place" conversion.
+             */
+            switch (typcd) {
+               case TypCDbl:
+               case TypCInt:
+               case TypECInt:
+                  /*
+                   * not really converted in-place.
+                   */
+                  ++cur_symtab[indx].n_refs; /* non-modifying reference */
+                  break;
+               default:
+                  ++cur_symtab[indx].n_mods; /* modifying reference */
+               }
+            }
+         else
+            ++cur_symtab[indx].n_refs; /* non-modifying reference */
+
+         if (cdp != NULL) 
+            *cdp = il_cnv(typcd, src, dflt, dest);
+         }
+      }
+   return cond;
+   }
+
+/*
+ * ilc_anlz - gather information about in-line C code.
+ */
+static void ilc_anlz(ilc)
+struct il_c *ilc;
+   {
+   while (ilc != NULL) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+            /* 
+             * Non-modifying reference to variable
+             */
+            if (ilc->n != RsltIndx) {
+               ++cur_symtab[ilc->n].n_refs;
+               }
+            break;
+
+         case ILC_Mod:
+            /* 
+             * Modifying reference to variable
+             */
+            if (ilc->n != RsltIndx) {
+               ++cur_symtab[ilc->n].n_mods;
+               }
+            break;
+
+         case ILC_Ret:
+            /*
+             * Return statement.
+             */
+            ++n_ret;
+            ret_anlz(ilc);
+            break;
+
+         case ILC_Susp:
+            /*
+             * Suspend statement.
+             */
+            ++n_susp;
+            ret_anlz(ilc);
+            break;
+
+         case ILC_CGto:
+            /*
+             * Conditional goto.
+             */
+            ilc_anlz(ilc->code[0]);
+            break;
+         }
+      ilc = ilc->next;
+      }
+   }
+
+/*
+ * ret_anlz - gather information about the in-line C code associated
+ *   with a return or suspend.
+ */
+static void ret_anlz(ilc)
+struct il_c *ilc;
+   {
+   int i;
+   int j;
+
+   /*
+    * See if the code is simply returning a parameter.
+    */
+   if (ilc->n == RetDesc && ilc->code[0]->il_c_type == ILC_Ref &&
+      ilc->code[0]->next == NULL) {
+         j = ilc->code[0]->n;
+         ++cur_symtab[j].n_refs;
+         ++cur_symtab[j].n_rets;
+         }
+   else {
+      for (i = 0; i < 3 && ilc->code[i] != NULL; ++i)
+         ilc_anlz(ilc->code[i]);
+      }
+   }
+
+/*
+ * deref_il - dummy routine to pass to a code walk.
+ */
+/*ARGSUSED*/
+static int defer_il(il)
+struct il_code *il;
+   {
+   /*
+    * Called for each case in a type_case statement that might be selected.
+    *  However, the actual analysis of the case, if it is needed,
+    *  is done elsewhere, so just return.
+    */
+   return 0;
+   }
+
+/*
+ * findcases - determine how many cases of an type_case statement may
+ *   be true. If there are two or less, determine the "if" statement
+ *   that can be used (if there are more than two, the code is not
+ *   in-lined).
+ */
+void findcases(il, has_dflt, case_anlz)
+struct il_code *il;
+int has_dflt;
+struct case_anlz *case_anlz;
+   {
+   int i;
+
+   case_anlz->n_cases = 0;
+   case_anlz->typcd = -1;
+   case_anlz->il_then = NULL;
+   case_anlz->il_else = NULL;
+   i = type_case(il, defer_il, case_anlz);
+   /*
+    * See if the explicit cases have accounted for all possible
+    *  types that might be present.
+    */
+   if (i == -1) {  /* all types accounted for */
+      if (case_anlz->il_else == NULL && case_anlz->il_then != NULL) {
+         /*   
+          * We don't need to actually check the type.
+          */
+         case_anlz->il_else = case_anlz->il_then;
+         case_anlz->il_then = NULL;
+         case_anlz->typcd = -1;
+         }
+      }
+    else {  /* not all types accounted for */
+      if (case_anlz->il_else != NULL)
+         case_anlz->n_cases = 3; /* force no inlining */
+      else if (has_dflt)
+         case_anlz->il_else = il->u[i].fld;         /* default */
+      }
+
+   if (case_anlz->n_cases > 2)
+      n_branches = 2;  /* no in-lining */
+   else if (case_anlz->il_then != NULL)
+      ++n_branches;
+   }
+
+
+/*
+ * tc_anlz - analyze a type_case statement. It is only of interest for
+ *   in-lining if it can be reduced to an "if" statement or an
+ *   unconditional statement.
+ */
+static int tc_anlz(il, has_dflt)
+struct il_code *il;
+int has_dflt;
+   {
+   struct case_anlz case_anlz;
+   int fall_thru;
+   int indx;
+
+   findcases(il, has_dflt, &case_anlz);
+
+   if (case_anlz.il_else == NULL)
+      fall_thru = 1;   /* either no code at all or condition with no "else" */
+   else
+      fall_thru = 0;   /* either unconditional or if-then-else: check code  */
+
+   if (case_anlz.il_then != NULL) {
+      fall_thru |= il_anlz(case_anlz.il_then);
+      indx = il->u[0].fld->u[0].n;    /* symbol table index of variable */
+      if (indx < cur_symtyps->nsyms)
+         ++cur_symtab[indx].n_refs;
+      }
+   if (case_anlz.il_else != NULL)
+      fall_thru |= il_anlz(case_anlz.il_else);
+   return fall_thru;
+   }
+
+/*
+ * arth_anlz - analyze the type checking of an arith_case statement.
+ */
+void arth_anlz(var1, var2, maybe_int, maybe_dbl, chk1, conv1p, chk2, conv2p)
+struct il_code *var1;
+struct il_code *var2;
+int *maybe_int;
+int *maybe_dbl;
+int *chk1;
+struct code **conv1p;
+int *chk2;
+struct code **conv2p;
+   {
+   int cond;
+   int cnv_typ;
+
+
+   /*
+    * First do an analysis to find out which cases are needed. This is
+    *  more accurate than analysing the conversions separately, but does
+    *  not get all the information we need.
+    */
+   eval_arith(var1->u[0].n, var2->u[0].n, maybe_int, maybe_dbl);
+
+   if (*maybe_int & (largeints | *maybe_dbl)) {
+      /*
+       * Too much type checking; don't bother with these cases. Force no
+       *   in-lining.
+       */
+      n_branches += 2;
+      }
+   else {
+      if (*maybe_int)
+         cnv_typ = TypCInt;
+      else
+         cnv_typ = TypCDbl;
+
+      /*
+       * See exactly what kinds of conversions/type checks are needed and,
+       *  if requested, generate code for them.
+       */
+      *chk1 = 0;
+      *chk2 = 0;
+
+      cond = cnv_anlz(cnv_typ, var1, NULL, NULL, conv1p);
+      if (cond & MaybeFalse) {
+         ++n_branches;          /* run-time decision */
+         *chk1 = 1;
+         if (var1->u[0].n < cur_symtyps->nsyms)
+            ++cur_symtab[var1->u[0].n].n_refs;  /* used in runerr2() */
+         }
+      cond = cnv_anlz(cnv_typ, var2, NULL, NULL, conv2p);
+      if (cond & MaybeFalse) {
+         ++n_branches;          /* run-time decision */
+         *chk2 = 1;
+         if (var2->u[0].n < cur_symtyps->nsyms)
+            ++cur_symtab[var2->u[0].n].n_refs;  /* used in runerr2() */
+         }
+      }
+   }
diff --git a/src/iconc/inline.c b/src/iconc/inline.c
new file mode 100644
index 0000000..234229c
--- /dev/null
+++ b/src/iconc/inline.c
@@ -0,0 +1,2007 @@
+/*
+ * inline.c - routines to put run-time routines in-line.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "ccode.h"
+#include "csym.h"
+#include "ctree.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static void          arth_arg  ( struct il_code *var,
+                                    struct val_loc *v_orig, int chk,
+                                    struct code *cnv);
+static int              body_fnc  (struct il_code *il);
+static void          chkforblk (void);
+static void          cnv_dest  (int loc, int is_cstr,
+                                    struct il_code *src, int sym_indx,
+                                    struct il_c *dest, struct code *cd, int i);
+static void          dwrd_asgn (struct val_loc *vloc, char *typ);
+static struct il_c     *line_ilc  (struct il_c *ilc);
+static int              gen_if    (struct code *cond_cd,
+                                    struct il_code *il_then,
+                                    struct il_code *il_else,
+                                    struct val_loc **locs);
+static int              gen_il    (struct il_code *il);
+static void          gen_ilc   (struct il_c *il);
+static void          gen_ilret (struct il_c *ilc);
+static int              gen_tcase (struct il_code *il, int has_dflt);
+static void          il_var    (struct il_code *il, struct code *cd,
+                                    int indx);
+static void          mrg_locs  (struct val_loc **locs);
+static struct code     *oper_lbl  (char *s);
+static void          part_asgn (struct val_loc *vloc, char *asgn,
+                                    struct il_c *value);
+static void          rstr_locs (struct val_loc **locs);
+static struct val_loc **sav_locs  (void);
+static void         sub_ilc    (struct il_c *ilc, struct code *cd, int indx);
+
+/*
+ * There are many parameters that are shared by multiple routines. There
+ *  are copied into statics.
+ */
+static struct val_loc *rslt;     /* result location */
+static struct code **scont_strt; /* label following operation code */
+static struct code **scont_fail; /* resumption label for in-line suspend */
+static struct c_fnc *cont;       /* success continuation */
+static struct implement *impl;   /* data base entry for operation */
+static int nsyms;                /* number symbols in operation symbol table */
+static int n_vararg;             /* size of variable part of arg list */
+static nodeptr intrnl_lftm;      /* lifetime of internal variables */
+static struct val_loc **tended;  /* array of tended locals */
+
+/*
+ * gen_inlin - generate in-line code for an operation.
+ */
+void gen_inlin(il, r, strt, fail, c, ip, ns, st, n, dcl_var, n_va)
+struct il_code *il;
+struct val_loc *r;
+struct code **strt;
+struct code **fail;
+struct c_fnc *c;
+struct implement *ip;
+int ns;
+struct op_symentry *st;
+nodeptr n;
+int dcl_var;
+int n_va;
+   {
+   struct code *cd;
+   struct val_loc *tnd;
+   int i;
+
+   /*
+    * Copy arguments in to globals.
+    */
+   rslt = r;
+   scont_strt = strt;
+   scont_fail = fail;
+   cont = c;
+   impl = ip;
+   nsyms = ns;
+   cur_symtab = st;
+   intrnl_lftm = n->intrnl_lftm;
+   cur_symtyps = n->symtyps;
+   n_vararg = n_va;
+
+   /*
+    * Generate code to initialize local tended descriptors and determine
+    *  how to access the descriptors.
+    */
+   for (i = 0; i < impl->ntnds; ++i) {
+      if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
+         tnd = chk_alc(NULL, n->intrnl_lftm);
+          switch (impl->tnds[i].var_type) {
+             case TndDesc:
+                cur_symtab[dcl_var].loc = tnd; 
+                break;
+             case TndStr:
+                cd = alc_ary(2);
+                cd->ElemTyp(0) = A_ValLoc;
+                cd->ValLoc(0) =                tnd;
+                cd->ElemTyp(1) = A_Str;
+                cd->Str(1) =                   " = emptystr;";
+                cd_add(cd);
+                cur_symtab[dcl_var].loc = loc_cpy(tnd, M_CharPtr);
+                break;
+             case TndBlk:
+                cd = alc_ary(2);
+                cd->ElemTyp(0) = A_ValLoc;
+                cd->ValLoc(0) =                tnd;
+                cd->ElemTyp(1) = A_Str;
+                cd->Str(1) =                   " = nullptr;"; 
+                cd_add(cd);
+                cur_symtab[dcl_var].loc = loc_cpy(tnd, M_BlkPtr);
+                cur_symtab[dcl_var].loc->blk_name = impl->tnds[i].blk_name;
+                break;
+             }
+         if (impl->tnds[i].init != NULL) {
+             cd = alc_ary(4);
+             cd->ElemTyp(0) = A_ValLoc;
+             cd->ValLoc(0) =                cur_symtab[dcl_var].loc;
+             cd->ElemTyp(1) = A_Str;
+             cd->Str(1) =                   " = "; 
+             sub_ilc(impl->tnds[i].init, cd, 2);
+             cd->ElemTyp(3) = A_Str;
+             cd->Str(3) =                   ";"; 
+             cd_add(cd);
+             }
+         }
+      ++dcl_var;
+      }
+
+   /*
+    * If there are local non-tended variables, generate code for the
+    *  declarations, placing everything in braces.
+     */
+   if (impl->nvars > 0) {
+      cd = NewCode(0);
+      cd->cd_id = C_LBrack;    /* { */
+      cd_add(cd);
+      for (i = 0;  i < impl->nvars; ++i) {
+         if (cur_symtab[dcl_var].n_refs + cur_symtab[dcl_var].n_mods > 0) {
+            gen_ilc(impl->vars[i].dcl);
+            cur_symtab[dcl_var].loc = cvar_loc(impl->vars[i].name);
+            }
+         ++dcl_var;
+         }
+      }
+
+   gen_il(il);  /* generate executable code */
+
+   if (impl->nvars > 0) {
+      cd = NewCode(0);
+      cd->cd_id = C_RBrack;    /* } */
+      cd_add(cd);
+      }
+   }
+
+/*
+ * gen_il - generate code from a sub-tree of in-line code from the data
+ *  base. Determine if execution can continue past this code.
+ *
+ */
+static int gen_il(il)
+struct il_code *il;
+   {
+   struct code *cd;
+   struct code *cd1;
+   struct il_code *il_cond;
+   struct il_code *il_then;
+   struct il_code *il_else;
+   struct il_code *il_t;
+   struct val_loc **locs;
+   struct val_loc **locs1;
+   struct val_loc *tnd;
+   int fall_thru;
+   int cond;
+   int ncases;
+   int indx;
+   int ntended;
+   int i;
+
+   if (il == NULL)
+      return 1;
+
+   switch (il->il_type) {
+      case IL_Const: /* should have been replaced by literal node */
+         return 1;
+
+      case IL_If1:
+      case IL_If2:
+         /*
+          * if-then or if-then-else statement.
+          */
+         il_then = il->u[1].fld;
+         if (il->il_type == IL_If2)
+            il_else = il->u[2].fld;
+         else
+            il_else = NULL;
+         il_cond = il->u[0].fld;
+         if (il->u[0].fld->il_type == IL_Bang) {
+            il_cond = il_cond->u[0].fld;
+            il_t = il_then;
+            il_then = il_else;
+            il_else = il_t;
+            }
+         locs = sav_locs();
+         cond = cond_anlz(il_cond, &cd1);
+         if (cond == (MaybeTrue | MaybeFalse))
+            fall_thru = gen_if(cd1, il_then, il_else, locs);
+         else {
+            if (cd1 != NULL) {
+               cd_add(cd1);  /* condition contains needed conversions */
+               cd = alc_ary(1);
+               cd->ElemTyp(0) = A_Str;
+               cd->Str(0) =              ";";
+               cd_add(cd);
+               }
+            if (cond == MaybeTrue)
+               fall_thru = gen_il(il_then);
+            else if (cond == MaybeFalse) {
+               locs1 = sav_locs();
+               rstr_locs(locs);
+               locs = locs1;
+               fall_thru = gen_il(il_else);
+               }
+            mrg_locs(locs);
+            }
+         return fall_thru;
+
+      case IL_Tcase1:
+         /*
+          * type_case statement with no default clause.
+          */
+         return gen_tcase(il, 0);
+
+      case IL_Tcase2:
+         /*
+          * type_case statement with a default clause.
+          */
+         return gen_tcase(il, 1);
+
+      case IL_Lcase:
+         /*
+          * len_case statement. Determine which case matches the number
+          *  of arguments.
+          */
+         ncases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < ncases; ++i) {
+            if (il->u[indx++].n == n_vararg)    /* selection number */
+               return gen_il(il->u[indx].fld);  /* action */
+            ++indx;
+            }
+         return gen_il(il->u[indx].fld);        /* default */
+
+      case IL_Acase: {
+         /*
+          * arith_case statement.
+          */
+         struct il_code *var1;
+         struct il_code *var2;
+         struct val_loc *v_orig1;
+         struct val_loc *v_orig2;
+         struct code *cnv1;
+         struct code *cnv2;
+         int maybe_int;
+         int maybe_dbl;
+         int chk1;
+         int chk2;
+
+         var1 = il->u[0].fld;
+         var2 = il->u[1].fld;
+         v_orig1 = cur_symtab[var1->u[0].n].loc;  /* remember for error msgs */
+         v_orig2 = cur_symtab[var2->u[0].n].loc;  /* remember for error msgs */
+         arth_anlz(var1, var2, &maybe_int, &maybe_dbl, &chk1, &cnv1,
+           &chk2, &cnv2);
+
+         /*
+          * This statement is in-lined if there is only C integer
+          *  arithmetic, only C double arithmetic, or only a run-time
+          *  error.
+          */
+         arth_arg(var1, v_orig1, chk1, cnv1);
+         arth_arg(var2, v_orig2, chk2, cnv2);
+         if (maybe_int)
+            return gen_il(il->u[2].fld);     /* C_integer action */
+         else if (maybe_dbl)
+            return gen_il(il->u[4].fld);     /* C_double action */
+         else
+            return 0;
+         }
+
+      case IL_Err1:
+         /*
+          * runerr() with no offending value.
+          */
+         cd = alc_ary(3);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "err_msg(";
+         cd->ElemTyp(1) = A_Intgr;
+         cd->Intgr(1) =            il->u[0].n;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =              ", NULL);";
+         cd_add(cd);
+         if (err_conv)
+            cd_add(sig_cd(on_failure, cur_fnc));
+         for (i = 0; i < nsyms; ++i)
+            cur_symtab[i].loc = NULL;
+         return 0;
+
+      case IL_Err2:
+         /*
+          * runerr() with an offending value. Note the reference to
+          *  the offending value descriptor.
+          */
+         cd = alc_ary(5);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =              "err_msg(";
+         cd->ElemTyp(1) = A_Intgr;
+         cd->Intgr(1) =            il->u[0].n;
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =              ", &(";
+         il_var(il->u[1].fld, cd, 3);
+         cd->ElemTyp(4) = A_Str;
+         cd->Str(4) =              "));";
+         cd_add(cd);
+         if (err_conv)
+            cd_add(sig_cd(on_failure, cur_fnc));
+         for (i = 0; i < nsyms; ++i)
+            cur_symtab[i].loc = NULL;
+         return 0;
+
+      case IL_Lst:
+         /*
+          * Two consecutive pieces of RTL code.
+          */
+         fall_thru = gen_il(il->u[0].fld);
+         if (fall_thru)
+            fall_thru = gen_il(il->u[1].fld);
+         return fall_thru;
+
+      case IL_Block:
+         /*
+          * inline {...} statement.
+          *
+          *  Allocate and initialize any tended locals.
+          */
+         ntended = il->u[1].n;
+         if (ntended > 0)
+            tended = (struct val_loc **)alloc((unsigned int)
+               sizeof(struct val_loc *) * ntended);
+         for (i = 2; i - 2 < ntended; ++i) {
+             tnd = chk_alc(NULL, intrnl_lftm);
+             tended[i - 2] = tnd;
+             switch (il->u[i].n) {
+                case TndDesc:
+                   break;
+                case TndStr:
+                   cd = alc_ary(2);
+                   cd->ElemTyp(0) = A_ValLoc;
+                   cd->ValLoc(0) =                tnd;
+                   cd->ElemTyp(1) = A_Str;
+                   cd->Str(1) =                   " = emptystr;";
+                   cd_add(cd);
+                   break;
+                case TndBlk:
+                   cd = alc_ary(2);
+                   cd->ElemTyp(0) = A_ValLoc;
+                   cd->ValLoc(0) =                tnd;
+                   cd->ElemTyp(1) = A_Str;
+                   cd->Str(1) =                   " = nullptr;"; 
+                   cd_add(cd);
+                   break;
+                }
+            }
+         gen_ilc(il->u[i].c_cd);    /* body of block */
+         /*
+          * See if execution can fall through this code.
+          */
+         if (il->u[0].n)
+            return 1;
+         else {
+            for (i = 0; i < nsyms; ++i)
+               cur_symtab[i].loc = NULL;
+            return 0;
+            }
+
+      case IL_Call:
+         /*
+          * call to body function.
+          */
+         return body_fnc(il);
+
+      case IL_Abstr:
+         /*
+          * abstract type computation. Only used by type inference.
+          */
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(1);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * arth_arg - in-line code to check a conversion for an arith_case statement.
+ */
+static void arth_arg(var, v_orig, chk, cnv)
+struct il_code *var;
+struct val_loc *v_orig;
+int chk;
+struct code *cnv;
+   {
+   struct code *lbl;
+   struct code *cd;
+
+   if (chk) {
+      /*
+       * Must check the conversion.
+       */
+      lbl = oper_lbl("converted");
+      cd_add(lbl);
+      cur_fnc->cursor = lbl->prev;        /* code goes before label */
+      if (cnv != NULL) {
+         cd = NewCode(2);
+         cd->cd_id = C_If;
+         cd->Cond = cnv;
+         cd->ThenStmt = mk_goto(lbl);
+         cd_add(cd);
+         }
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              "err_msg(102, &(";
+      cd->ElemTyp(1) = A_ValLoc;
+      cd->ValLoc(1) =           v_orig;    /* var location before conversion */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =              "));";
+      cd_add(cd);
+      if (err_conv)
+         cd_add(sig_cd(on_failure, cur_fnc));
+      cur_fnc->cursor = lbl;
+      }
+   else if (cnv != NULL) {
+      cd_add(cnv);          /* conversion cannot fail  */
+      cd = alc_ary(1);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =              ";";
+      cd_add(cd);
+      }
+   }
+
+/*
+ * body_fnc - generate code to call a body function.
+ */
+static int body_fnc(il)
+struct il_code *il;
+   {
+   struct code *arg_lst;
+   struct code *cd;
+   struct c_fnc *cont1;
+   char *oper_nm;
+   int ret_val;
+   int ret_flag;
+   int need_rslt;
+   int num_sbuf;
+   int num_cbuf;
+   int expl_args;
+   int arglst_sz;  /* size of arg list in number of code pieces */
+   int il_indx;
+   int cd_indx;
+   int proto_prt;
+   int i;
+
+   /*
+    * Determine if a function prototype has been printed yet for this
+    *  body function.
+    */
+   proto_prt = il->u[0].n;
+   il->u[0].n = 1;
+
+   /*
+    * Construct the name of the body function.
+    */
+   oper_nm = (char *)alloc((unsigned int)(strlen(impl->name) + 6));
+   sprintf(oper_nm, "%c%c%c%c_%s", impl->oper_typ, impl->prefix[0],
+      impl->prefix[1], (char)il->u[1].n, impl->name);
+
+   /*
+    * Extract from the call the flags and other information describing
+    *  the function, then use this information to deduce the arguments
+    *  needed by the function.
+    */
+   ret_val = il->u[2].n;
+   ret_flag = il->u[3].n;
+   need_rslt = il->u[4].n;
+   num_sbuf = il->u[5].n;
+   num_cbuf = il->u[6].n;
+   expl_args = il->u[7].n;
+
+   /*
+    * determine how large the argument list is.
+    */
+   arglst_sz = 2 * expl_args - 1;
+   if (num_sbuf > 0)
+      arglst_sz += 3;
+   if (num_cbuf > 0)
+      arglst_sz += 2;
+   if (need_rslt)
+      arglst_sz += 3;
+   if (arglst_sz > 0)
+      arg_lst = alc_ary(arglst_sz);
+   else
+      arg_lst = alc_ary(0);
+
+   if (!proto_prt) {
+      /*
+       * Determine whether the body function returns a C integer, double,
+       *  no value, or a signal.
+       */
+      switch (ret_val) {
+         case RetInt:
+            fprintf(inclfile, "C_integer %s (", oper_nm);
+            break;
+         case RetDbl:
+            fprintf(inclfile, "double %s (", oper_nm);
+            break;
+         case RetNoVal:
+            fprintf(inclfile, "void %s (", oper_nm);
+            break;
+         case RetSig:
+            fprintf(inclfile, "int %s (", oper_nm);
+            break;
+         }
+     }
+
+   /*
+    * Produce prototype and code for the explicit arguments in the
+    *  function call. Note that the call entry contains C code for both.
+    */
+   il_indx = 8;
+   cd_indx = 0;
+   while (expl_args--) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;                /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      if (!proto_prt)
+        fprintf(inclfile, "%s", il->u[il_indx].c_cd->s);   /* parameter dcl */
+      ++il_indx;
+      sub_ilc(il->u[il_indx++].c_cd, arg_lst, cd_indx++);
+      }
+
+   /*
+    * If string buffers are needed, allocate them and pass pointer to
+    *   function.
+    */
+   if (num_sbuf > 0) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_Str;
+      arg_lst->Str(cd_indx) = "(char (*)[MaxCvtLen])";
+      ++cd_indx;
+      arg_lst->ElemTyp(cd_indx) = A_SBuf;
+      arg_lst->Intgr(cd_indx) = alc_sbufs(num_sbuf, intrnl_lftm);
+      if (!proto_prt)
+         fprintf(inclfile, "char (*r_sbuf)[MaxCvtLen]");
+      ++cd_indx;
+      }
+
+   /*
+    * If cset buffers are needed, allocate them and pass pointer to
+    *   function.
+    */
+   if (num_cbuf > 0) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_CBuf;
+      arg_lst->Intgr(cd_indx) = alc_cbufs(num_cbuf, intrnl_lftm);
+      if (!proto_prt)
+         fprintf(inclfile, "struct b_cset *r_cbuf");
+      ++cd_indx;
+      }
+
+   /*
+    * See if the function needs a pointer to the result location
+    *  of the operation.
+    */
+   if (need_rslt) {
+      if (cd_indx > 0) {
+         /*
+          * Not first entry, precede by ','.
+          */
+         arg_lst->ElemTyp(cd_indx) = A_Str;        /* , */
+         arg_lst->Str(cd_indx) = ", ";
+         if (!proto_prt)
+            fprintf(inclfile, ", ");
+         ++cd_indx;
+         }
+      arg_lst->ElemTyp(cd_indx) = A_Str;        /* location of result */
+      arg_lst->Str(cd_indx) = "&";
+      ++cd_indx;
+      arg_lst->ElemTyp(cd_indx) = A_ValLoc;
+      arg_lst->ValLoc(cd_indx) = rslt;
+      if (!proto_prt)
+         fprintf(inclfile, "dptr rslt");
+      ++cd_indx;
+      }
+
+   if (!proto_prt) {
+      /*
+       * The last possible argument is the success continuation.
+       *  If there are no arguments, indicate this in the prototype.
+       */
+      if (ret_flag & DoesSusp) {
+         if (cd_indx > 0)
+            fprintf(inclfile, ", ");
+         fprintf(inclfile, "continuation succ_cont");
+         }
+      else if (cd_indx == 0)
+         fprintf(inclfile, "void");
+      fprintf(inclfile, ");\n");
+      }
+
+   /*
+    * Does this call need the success continuation for the operation.
+    */
+   if (ret_flag & DoesSusp)
+       cont1 = cont;
+   else
+       cont1 = NULL;
+
+   switch (ret_val) {
+      case RetInt:
+         /*
+          * The body function returns a C integer.
+          */
+         cd = alc_ary(6);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =               rslt;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  ".vword.integr = ";
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                  oper_nm;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  "(";
+         cd->ElemTyp(4) = A_Ary;
+         cd->Array(4) =                  arg_lst;
+         cd->ElemTyp(5) = A_Str;
+         cd->Str(5) =                  ");";
+         cd_add(cd);
+         dwrd_asgn(rslt, "Integer");
+         cd_add(mk_goto(*scont_strt));
+         break;
+      case RetDbl:
+         /*
+          * The body function returns a C double.
+          */
+         cd = alc_ary(6);
+         cd->ElemTyp(0) = A_ValLoc;
+         cd->ValLoc(0) =               rslt;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  ".vword.bptr = (union block *)alcreal(";
+         cd->ElemTyp(2) = A_Str;
+         cd->Str(2) =                  oper_nm;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  "(";
+         cd->ElemTyp(4) = A_Ary;
+         cd->Array(4) =                  arg_lst;
+         cd->ElemTyp(5) = A_Str;
+         cd->Str(5) =                  "));";
+         cd_add(cd);
+         dwrd_asgn(rslt, "Real");
+         chkforblk();    /* make sure the block allocation succeeded */
+         cd_add(mk_goto(*scont_strt));
+         break;
+      case RetNoVal:
+         /*
+          * The body function does not directly return a value.
+          */
+         cd = alc_ary(4);
+         cd->ElemTyp(0) = A_Str;
+         cd->Str(0) =                  oper_nm;
+         cd->ElemTyp(1) = A_Str;
+         cd->Str(1) =                  "(";
+         cd->ElemTyp(2) = A_Ary;
+         cd->Array(2) =                  arg_lst;
+         cd->ElemTyp(3) = A_Str;
+         cd->Str(3) =                  ");";
+         cd_add(cd);
+         if (ret_flag & DoesFail | (err_conv && (ret_flag & DoesEFail)))
+            cd_add(sig_cd(on_failure, cur_fnc));
+         else if (ret_flag & DoesRet)
+            cd_add(mk_goto(*scont_strt));
+         break;
+      case RetSig:
+         /*
+          * The body function returns a signal.
+          */
+         callo_add(oper_nm, ret_flag, cont1, 0, arg_lst, mk_goto(*scont_strt));
+         break;
+      }
+   /*
+    * See if execution can fall through this call.
+    */
+   if (ret_flag & DoesFThru)
+      return 1;
+   else {
+      for (i = 0; i < nsyms; ++i)
+         cur_symtab[i].loc = NULL;
+      return 0;
+      }
+   }
+
+
+/*
+ * il_var - generate code for a possibly subscripted variable into
+ *   an element of a code array.
+ */
+static void il_var(il, cd, indx)
+struct il_code *il;
+struct code *cd;
+int indx;
+   {
+   struct code *cd1;
+
+   if (il->il_type == IL_Subscr) {
+      /*
+       * Subscripted variable.
+       */
+      cd1 = cd;
+      cd = alc_ary(4);
+      cd1->ElemTyp(indx) = A_Ary;
+      cd1->Array(indx) = cd;
+      indx = 0;
+      cd->ElemTyp(1) = A_Str;
+      cd->Str(1) =                  "[";
+      cd->ElemTyp(2) = A_Intgr;
+      cd->Intgr(2) =                il->u[1].n;
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) =                  "]";
+      }
+
+   /*
+    * See if this is the result location of the operation or an ordinary
+    *  variable.
+    */
+   cd->ElemTyp(indx) = A_ValLoc;
+   if (il->u[0].n == RsltIndx)
+      cd->ValLoc(indx) = rslt;
+   else
+      cd->ValLoc(indx) = cur_symtab[il->u[0].n].loc;
+   }
+
+/*
+ * part_asgn - generate code for an assignment to (part of) a descriptor.
+ */
+static void part_asgn(vloc, asgn, value)
+struct val_loc *vloc;
+char *asgn;
+struct il_c *value;
+   {
+   struct code *cd;
+
+   cd = alc_ary(4);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =                          vloc;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                             asgn;
+   sub_ilc(value, cd, 2);                /* value */
+   cd->ElemTyp(3) = A_Str;
+   cd->Str(3) =                             ";";
+   cd_add(cd);
+   }
+
+/*
+ * dwrd_asgn - generate code to assign a type code to the dword of a descriptor.
+ */
+static void dwrd_asgn(vloc, typ)
+struct val_loc *vloc;
+char *typ;
+   {
+   struct code *cd;
+
+   cd = alc_ary(4);
+   cd->ElemTyp(0) = A_ValLoc;
+   cd->ValLoc(0) =               vloc;
+   cd->ElemTyp(1) = A_Str;
+   cd->Str(1) =                  ".dword = D_";
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) =                  typ;
+   cd->ElemTyp(3) = A_Str;
+   cd->Str(3) =                  ";";
+   cd_add(cd);
+   }
+
+/*
+ * sub_ilc - generate code from a sequence of C code and place it
+ *  in a slot in a code array.
+ */
+static void sub_ilc(ilc, cd, indx)
+struct il_c *ilc;
+struct code *cd;
+int indx;
+   {
+   struct il_c *ilc1;
+   struct code *cd1;
+   int n;
+
+   /*
+    * Count the number of pieces of C code to process.
+    */
+   n = 0;
+   for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next)
+      ++n;
+
+   /*
+    * If there is only one piece of code, place it directly in the 
+    *  slot of the array. Otherwise allocate a sub-array and place it
+    *  in the slot.
+    */
+   if (n > 1) {
+      cd1 = cd;
+      cd = alc_ary(n);
+      cd1->ElemTyp(indx) = A_Ary;
+      cd1->Array(indx) = cd;
+      indx = 0;
+      }
+
+   while (ilc != NULL) {
+      switch (ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+            /*
+             * Reference to variable in symbol table.
+             */
+            cd->ElemTyp(indx) = A_ValLoc;
+            if (ilc->n == RsltIndx)
+               cd->ValLoc(indx) = rslt;
+            else {
+               if (ilc->s == NULL)
+                  cd->ValLoc(indx) = cur_symtab[ilc->n].loc;
+               else {
+                  /*
+                   * Access the entire descriptor.
+                   */
+                  cd->ValLoc(indx) = loc_cpy(cur_symtab[ilc->n].loc, M_None);
+                  }
+               }
+            break;
+
+         case ILC_Tend:
+            /*
+             * Reference to a tended variable.
+             */
+            cd->ElemTyp(indx) = A_ValLoc;
+            cd->ValLoc(indx) = tended[ilc->n];
+            break;
+
+         case ILC_Str:
+            /*
+             * String representing C code.
+             */
+            cd->ElemTyp(indx) = A_Str;
+            cd->Str(indx) = ilc->s;
+            break;
+
+         case ILC_SBuf:
+            /*
+             * String buffer for a conversion.
+             */
+            cd->ElemTyp(indx) = A_SBuf;
+            cd->Intgr(indx) = alc_sbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_CBuf:
+            /*
+             * Cset buffer for a conversion.
+             */
+            cd->ElemTyp(indx) = A_CBuf;
+            cd->Intgr(indx) = alc_cbufs(1, intrnl_lftm);
+            break;
+
+
+         default:
+            fprintf(stderr, "compiler error: unknown info in data base\n");
+            exit(1);
+         }
+      ilc = ilc->next;
+      ++indx;
+      }
+
+   }
+
+/*
+ * gen_ilret - generate code to set the result value from a suspend or
+ *   return.
+ */
+static void gen_ilret(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc0;
+   struct code *cd;
+   char *cap_id;
+   int typcd;
+
+   if (rslt == &ignore)
+      return;    /* Don't bother computing the result; it's never used */
+
+   ilc0 = ilc->code[0];
+   typcd = ilc->n;
+
+   if (typcd < 0) {
+      /*
+       * RTL returns that do not look like function calls to standard Icon
+       *  type name.
+       */
+      switch (typcd) {
+         case TypCInt:
+            /*
+             * return/suspend C_integer <expr>;
+             */
+            part_asgn(rslt, ".vword.integr = ", ilc0);
+            dwrd_asgn(rslt, "Integer");
+            break;
+         case TypCDbl:
+            /*
+             * return/suspend C_double <expr>;
+             */
+            cd = alc_ary(4);
+            cd->ElemTyp(0) = A_ValLoc;
+            cd->ValLoc(0) =             rslt;
+            cd->ElemTyp(1) = A_Str;
+            cd->Str(1) =                ".vword.bptr = (union block *)alcreal(";
+            sub_ilc(ilc0, cd, 2);       /* value */
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) =                ");";
+            cd_add(cd);
+            dwrd_asgn(rslt, "Real");
+            chkforblk();    /* make sure the block allocation succeeded */
+            break;
+         case TypCStr:
+            /*
+             * return/suspend C_string <expr>;
+             */
+            cd = alc_ary(5);
+            cd->ElemTyp(0) = A_Str;
+            cd->Str(0) =                  "AsgnCStr(";
+            cd->ElemTyp(1) = A_ValLoc;
+            cd->ValLoc(1) =               rslt;
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                  ", ";
+            sub_ilc(ilc0, cd, 3);         /* <expr> */
+            cd->ElemTyp(4) = A_Str;
+            cd->Str(4) =                  ");";
+            cd_add(cd);
+            break;
+         case RetDesc:
+            /*
+             * return/suspend <expr>;
+             */
+            part_asgn(rslt, " = ", ilc0);
+            break;
+         case RetNVar:
+            /*
+             * return/suspend named_var(<desc-pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = ", ilc0);
+            dwrd_asgn(rslt, "Var");
+            break;
+         case RetSVar:
+            /*
+             * return/suspend struct_var(<desc-pntr>, <block_pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = (dptr)", ilc->code[1]);
+            cd = alc_ary(6);
+            cd->ElemTyp(0) = A_ValLoc;
+            cd->ValLoc(0) =               rslt;
+            cd->ElemTyp(1) = A_Str;
+            cd->Str(1) =                  ".dword = D_Var + ((word *)";
+            sub_ilc(ilc0, cd, 2);       /* value */
+            cd->ElemTyp(3) = A_Str;
+            cd->Str(3) =                  " - (word *)";
+            cd->ElemTyp(4) = A_ValLoc;
+            cd->ValLoc(4) =               rslt;
+            cd->ElemTyp(5) = A_Str;
+            cd->Str(5) =                  ".vword.descptr);";
+            cd_add(cd);
+            break;
+         case RetNone:
+            /*
+             * return/suspend result;
+             *
+             *  Result already set, do nothing.
+             */
+            break;
+         default:
+            fprintf(stderr,
+               "compiler error: unknown RLT return in data base\n");
+            exit(1);
+            /* NOTREACHED */
+         }
+      }
+   else {
+      /*
+       * RTL returns that look like function calls to standard Icon type
+       *  names.
+       */
+      cap_id = icontypes[typcd].cap_id;
+      switch (icontypes[typcd].rtl_ret) {
+         case TRetBlkP:
+            /*
+             * return/suspend <type>(<block-pntr>);
+             */
+            part_asgn(rslt, ".vword.bptr = (union block *)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetDescP:
+            /*
+             * return/suspend <type>(<descriptor-pntr>);
+             */
+            part_asgn(rslt, ".vword.descptr = (dptr)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetCharP:
+            /*
+             * return/suspend <type>(<char-pntr>);
+             */
+            part_asgn(rslt, ".vword.sptr = (char *)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetCInt:
+            /*
+             * return/suspend <type>(<integer>);
+             */
+            part_asgn(rslt, ".vword.integr = (word)", ilc0);
+            dwrd_asgn(rslt, cap_id);
+            break;
+         case TRetSpcl:
+            /*
+             * RTL returns that look like function calls to standard type
+             *  names but take more than one argument.
+             */
+            if (typcd == str_typ) {
+                /*
+                * return/suspend string(<len>, <char-pntr>);
+                */
+               part_asgn(rslt, ".vword.sptr = ", ilc->code[1]);
+               part_asgn(rslt, ".dword = ", ilc0);
+               }
+            else if (typcd == stv_typ) {
+               /*
+                * return/suspend substr(<desc-pntr>, <start>, <len>);
+                */
+               cd = alc_ary(9);
+               cd->ElemTyp(0) = A_Str;
+               cd->Str(0) =                  "SubStr(&";
+               cd->ElemTyp(1) = A_ValLoc;
+               cd->ValLoc(1) =               rslt;
+               cd->ElemTyp(2) = A_Str;
+               cd->Str(2) =                  ", ";
+               sub_ilc(ilc0, cd, 3);
+               cd->ElemTyp(4) = A_Str;
+               cd->Str(4) =                  ", ";
+               sub_ilc(ilc->code[2], cd, 5);
+               cd->ElemTyp(6) = A_Str;
+               cd->Str(6) =                  ", ";
+               sub_ilc(ilc->code[1], cd, 7);
+               cd->ElemTyp(8) = A_Str;
+               cd->Str(8) =                  ");";
+               cd_add(cd);
+               chkforblk();    /* make sure the block allocation succeeded */
+               }
+            else {
+               fprintf(stderr,
+                  "compiler error: unknown RLT return in data base\n");
+               exit(1);
+               /* NOTREACHED */
+               }
+            break;
+         default:
+            fprintf(stderr,
+               "compiler error: unknown RLT return in data base\n");
+            exit(1);
+            /* NOTREACHED */
+         }
+      }
+   }
+
+/*
+ * chkforblk - generate code to make sure the allocation of a block
+ *   for the result descriptor was successful.
+ */
+static void chkforblk()
+   {
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl;
+
+   lbl = alc_lbl("got allocation", 0);
+   cd_add(lbl);
+   cur_fnc->cursor = lbl->prev;        /* code goes before label */
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd1 = alc_ary(3);
+   cd1->ElemTyp(0) = A_Str;
+   cd1->Str(0) =                  "(";
+   cd1->ElemTyp(1) = A_ValLoc;
+   cd1->ValLoc(1) =               rslt;
+   cd1->ElemTyp(2) = A_Str;
+   cd1->Str(2) =                  ").vword.bptr != NULL";
+   cd->Cond = cd1;
+   cd->ThenStmt = mk_goto(lbl);
+   cd_add(cd);
+   cd = alc_ary(1);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) =                   "err_msg(307, NULL);";
+   cd_add(cd);
+   if (err_conv)
+      cd_add(sig_cd(on_failure, cur_fnc));
+   cur_fnc->cursor = lbl;
+   }
+
+/*
+ * gen_ilc - generate code for an sequence of in-line C code.
+ */
+static void gen_ilc(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc1;
+   struct code *cd;
+   struct code *cd1;
+   struct code *lbl1;
+   struct code *fail_sav;
+   struct code **lbls;
+   int max_lbl;
+   int i;
+
+   /*
+    * Determine how many labels there are in the code and allocate an
+    *  array to map from label numbers to labels in the code.
+    */
+   max_lbl = -1;
+   for (ilc1 = ilc; ilc1 != NULL; ilc1 = ilc1->next) {
+      switch(ilc1->il_c_type) {
+         case ILC_CGto:
+         case ILC_Goto:
+         case ILC_Lbl:
+            if (ilc1->n > max_lbl)
+               max_lbl = ilc1->n;
+         }
+      }
+   ++max_lbl;    /* adjust for 0 indexing */
+   if (max_lbl > 0) {
+      lbls = (struct code **)alloc((unsigned int) sizeof(struct code *) *
+         max_lbl);
+      for (i = 0; i < max_lbl; ++i)
+         lbls[i] = NULL;
+      }
+
+   while (ilc != NULL) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+         case ILC_Tend:
+         case ILC_SBuf:
+         case ILC_CBuf:
+         case ILC_Str:
+            /*
+             * The beginning of a sequence of code fragments that can be
+             *  place on one line.
+             */
+            ilc = line_ilc(ilc);
+            break;
+
+         case ILC_Fail:
+            /*
+             * fail - perform failure action.
+             */
+            cd_add(sig_cd(on_failure, cur_fnc));
+            break;
+
+         case ILC_EFail:
+            /*
+             * errorfail - same as fail if error conversion is supported.
+             */
+            if (err_conv)
+               cd_add(sig_cd(on_failure, cur_fnc));
+            break;
+
+         case ILC_Ret:
+            /*
+             * return - set result location and jump out of operation.
+             */
+            gen_ilret(ilc);
+            cd_add(mk_goto(*scont_strt));
+            break;
+
+         case ILC_Susp:
+            /*
+             * suspend - set result location. If there is a success
+             *  continuation, call it. Otherwise the "continuation"
+             *  will be generated in-line, so set up a resumption label.
+             */
+            gen_ilret(ilc);
+            if (cont == NULL)
+               *scont_strt = cur_fnc->cursor;
+            lbl1 = oper_lbl("end suspend");
+            cd_add(lbl1);
+            if (cont == NULL)
+               *scont_fail = lbl1;
+            else {
+               cur_fnc->cursor = lbl1->prev; 
+               fail_sav = on_failure;
+               on_failure = lbl1;
+               callc_add(cont);
+               on_failure = fail_sav;
+               cur_fnc->cursor = lbl1;
+               }
+            break;
+
+         case ILC_LBrc:
+            /*
+             * non-deletable '{'
+             */
+            cd = NewCode(0);
+            cd->cd_id = C_LBrack;
+            cd_add(cd);
+            break;
+
+         case ILC_RBrc:
+            /*
+             * non-deletable '}'
+             */
+            cd = NewCode(0);
+            cd->cd_id = C_RBrack;
+            cd_add(cd);
+            break;
+
+         case ILC_CGto:
+            /*
+             * Conditional goto.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd = NewCode(2);
+            cd->cd_id = C_If;
+            cd1 = alc_ary(1);
+            sub_ilc(ilc->code[0], cd1, 0);
+            cd->Cond = cd1;
+            cd->ThenStmt = mk_goto(lbls[i]);
+            cd_add(cd);
+            break;
+
+         case ILC_Goto:
+            /*
+             * Goto.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd_add(mk_goto(lbls[i]));
+            break;
+
+         case ILC_Lbl:
+            /*
+             * Label.
+             */
+            i = ilc->n;
+            if (lbls[i] == NULL)
+               lbls[i] = oper_lbl("within");
+            cd_add(lbls[i]);
+            break;
+
+         default:
+            fprintf(stderr, "compiler error: unknown info in data base\n");
+            exit(1);
+         }
+      ilc = ilc->next;
+      }
+
+   if (max_lbl > 0)
+      free((char *)lbls);
+   }
+
+/*
+ * line_ilc - gather a line of in-line code.
+ */
+static struct il_c *line_ilc(ilc)
+struct il_c *ilc;
+   {
+   struct il_c *ilc1;
+   struct il_c *last;
+   struct code *cd;
+   int n;
+   int i;
+
+   /*
+    * Count the number of pieces in the line. Determine the last
+    *  piece in the sequence; this is returned to the caller.
+    */
+   n = 0;
+   ilc1 = ilc;
+   while (ilc1 != NULL) {
+      switch(ilc1->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+         case ILC_Tend:
+         case ILC_SBuf:
+         case ILC_CBuf:
+         case ILC_Str:
+            ++n;
+            last = ilc1;
+            ilc1 = ilc1->next;
+            break;
+         default: 
+            ilc1 = NULL;
+         }
+      }
+
+   /*
+    * Construct the line.
+    */
+   cd = alc_ary(n);
+   for (i = 0; i < n; ++i) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+         case ILC_Mod:
+            /*
+             * Reference to variable in symbol table.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            if (ilc->n == RsltIndx)
+               cd->ValLoc(i) = rslt;
+            else
+               cd->ValLoc(i) = cur_symtab[ilc->n].loc;
+            break;
+
+         case ILC_Tend:
+            /*
+             * Reference to a tended variable.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            cd->ValLoc(i) = tended[ilc->n];
+            break;
+
+         case ILC_SBuf:
+            /*
+             * String buffer for a conversion.
+             */
+            cd->ElemTyp(i) = A_SBuf;
+            cd->Intgr(i) = alc_sbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_CBuf:
+            /*
+             * Cset buffer for a conversion.
+             */
+            cd->ElemTyp(i) = A_CBuf;
+            cd->Intgr(i) = alc_cbufs(1, intrnl_lftm);
+            break;
+
+         case ILC_Str:
+            /*
+             * String representing C code.
+             */
+            cd->ElemTyp(i) = A_Str;
+            cd->Str(i) = ilc->s;
+            break;
+
+         default:
+            ilc = NULL;  
+         }
+      ilc = ilc->next;
+      }
+
+   cd_add(cd);
+   return last;
+   }
+
+/*
+ * generate code to perform simple type checking.
+ */
+struct code *typ_chk(var, typcd)
+struct il_code *var;
+int typcd;
+   {
+   struct code *cd;
+
+   if (typcd == int_typ && largeints) {
+      /*
+       * Handle large integer support specially.
+       */
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword == D_Integer || (";
+      il_var(var, cd, 3);                    /* value */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                           ").dword == D_Lrgint)";
+      return cd;
+      }
+   else if (typcd < 0) {
+      /*
+       * Not a standard Icon type name.
+       */
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      switch (typcd) {
+         case TypVar:
+            cd->Str(0) =                     "(((";
+            il_var(var, cd, 1);              /* value */
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                     ").dword & D_Var) == D_Var)";
+            break;
+         case TypCInt:
+            cd->Str(0) =                     "((";
+            il_var(var, cd, 1);              /* value */
+            cd->ElemTyp(2) = A_Str;
+            cd->Str(2) =                     ").dword == D_Integer)";
+            break;
+         }
+      }
+   else if (typcd == str_typ) {
+      cd = alc_ary(3);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "(!((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword & F_Nqual))";
+      }
+   else {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                           "((";
+      il_var(var, cd, 1);                    /* value */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                           ").dword == D_";
+      cd->ElemTyp(3) = A_Str;
+      cd->Str(3) = icontypes[typcd].cap_id;  /* type name */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                           ")";
+      }
+
+   return cd;
+   }
+
+/*
+ * oper_lbl - generate a label with an associated comment that includes
+ *   the operation name.
+ */
+static struct code *oper_lbl(s)
+char *s;
+   {
+   char *sbuf;
+
+   sbuf = (char *)alloc((unsigned int)(strlen(s) + strlen(impl->name) + 3));
+   sprintf(sbuf, "%s: %s", s, impl->name);
+   return alc_lbl(sbuf, 0);
+   }
+
+/*
+ * sav_locs - save the current interpretation of symbols that may
+ *  be affected by conversions.
+ */
+static struct val_loc **sav_locs()
+   {
+   struct val_loc **locs;
+   int i;
+
+   if (nsyms == 0)
+      return NULL;
+
+   locs = (struct val_loc **)alloc((unsigned int)(nsyms *
+      sizeof(struct val_loc *)));
+   for (i = 0; i < nsyms; ++i)
+      locs[i] = cur_symtab[i].loc;
+   return locs;
+   }
+
+/*
+ * rstr_locs - restore the interpretation of symbols that may
+ *  have been affected by conversions.
+ */
+static void rstr_locs(locs)
+struct val_loc **locs;
+   {
+   int i;
+
+   for (i = 0; i < nsyms; ++i)
+      cur_symtab[i].loc = locs[i];
+   free((char *)locs);
+   }
+
+/*
+ * mrg_locs - merge the interpretations of symbols along two execution
+ *  paths. Any ambiguity is caught by rtt, so differences only occur
+ *  if one path involves program termination so that the symbols
+ *  no longer have an interpretation along that path.
+ */
+static void mrg_locs(locs)
+struct val_loc **locs;
+   {
+   int i;
+
+   for (i = 0; i < nsyms; ++i)
+      if (cur_symtab[i].loc == NULL)
+         cur_symtab[i].loc = locs[i];
+   free((char *)locs);
+   }
+
+/*
+ * il_cnv - generate code for an in-line conversion.
+ */
+struct code *il_cnv(typcd, src, dflt, dest)
+int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+   {
+   struct code *cd;
+   struct code *cd1;
+   int dflt_to_ptr;
+   int loc;
+   int is_cstr;
+   int sym_indx;
+   int n;
+   int i;
+
+   sym_indx = src->u[0].n;
+
+   /*
+    * Determine whether the address must be taken of a default value and
+    *  whether the interpretation of the symbol in an in-place conversion
+    *  changes.
+    */
+   dflt_to_ptr = 0;
+   loc = PrmTend;
+   is_cstr = 0;
+   switch (typcd) {
+      case TypCInt:
+      case TypECInt:
+         loc = PrmInt;
+         break;
+      case TypCDbl:
+         loc = PrmDbl;
+         break;
+      case TypCStr:
+         is_cstr = 1;
+         break;
+      case TypEInt:
+         break;
+      case TypTStr:
+      case TypTCset:
+         dflt_to_ptr = 1;
+         break;
+      default:
+         /*
+          * Cset, real, integer, or string
+          */
+         if (typcd == cset_typ || typcd == str_typ)
+            dflt_to_ptr = 1;
+         break;
+      }
+
+  if (typcd == TypCDbl && !(eval_is(real_typ, sym_indx) & MaybeFalse)) {
+     /*
+      * Conversion from Icon real to C double. Just copy the C value
+      *  from the block.
+      */
+     cd = alc_ary(5);
+     cd->ElemTyp(0) = A_Str;
+     cd->Str(0) =                "(GetReal(&(";
+     il_var(src, cd, 1);
+     cd->ElemTyp(2) = A_Str;
+     cd->Str(2) =                "), ";
+     cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 3);
+     cd->ElemTyp(4) = A_Str;
+     cd->Str(4) =                "), 1)";
+     }
+  else if (typcd == TypCDbl && !largeints &&
+     !(eval_is(int_typ, sym_indx) & MaybeFalse)) {
+     /*
+      * Conversion from Icon integer (not large integer) to C double.
+      *  Do as a C conversion by an assigment.
+      */
+     cd = alc_ary(5);
+     cd->ElemTyp(0) = A_Str;
+     cd->Str(0) =                "(";
+     cd->ElemTyp(2) = A_Str;
+     cd->Str(2) =                " = IntVal( ";
+     cd->ElemTyp(4) = A_Str;
+     cd->Str(4) =                "), 1)";
+     /*
+      * Note that cnv_dest() must be called after the source is output
+      *  in case it changes the location of the parameter.
+      */
+     il_var(src, cd, 3);
+     cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, 1);
+     }
+   else {
+      /*
+       * Compute the number of code fragments required to construct the
+       *  call to the conversion routine.
+       */
+      n = 7;
+      if (dflt != NULL)
+        n += 2;
+   
+      cd = alc_ary(n);
+   
+      /*
+       * The names of simple conversions are distinguished from defaulting
+       *  conversions by a prefix of "cnv_" or "def_".
+       */
+      cd->ElemTyp(0) = A_Str;
+      if (dflt == NULL)
+         cd->Str(0) = "cnv_";
+      else
+         cd->Str(0) = "def_";
+   
+      /*
+       * Determine the name of the conversion routine.
+       */
+      cd->ElemTyp(1) = A_Str;    /* may be overridden */
+      switch (typcd) {
+         case TypCInt:
+            cd->Str(1) = "c_int(&(";
+            break;
+         case TypCDbl:
+            cd->Str(1) = "c_dbl(&(";
+            break;
+         case TypCStr:
+            cd->Str(1) = "c_str(&(";
+            break;
+         case TypEInt:
+            cd->Str(1) = "eint(&(";
+            break;
+         case TypECInt:
+            cd->Str(1) = "ec_int(&(";
+            break;
+         case TypTStr:
+            /*
+             * Allocate a string buffer.
+             */
+            cd1 = alc_ary(3);
+            cd1->ElemTyp(0) = A_Str;
+            cd1->Str(0) = "tstr(";
+            cd1->ElemTyp(1) = A_SBuf;
+            cd1->Intgr(1) = alc_sbufs(1, intrnl_lftm);
+            cd1->ElemTyp(2) = A_Str;
+            cd1->Str(2) = ", (&";
+            cd->ElemTyp(1) = A_Ary;
+            cd->Array(1) = cd1;
+            break;
+         case TypTCset:
+            /*
+             * Allocate a cset buffer.
+             */
+            cd1 = alc_ary(3);
+            cd1->ElemTyp(0) = A_Str;
+            cd1->Str(0) = "tcset(";
+            cd1->ElemTyp(1) = A_CBuf;
+            cd1->Intgr(1) = alc_cbufs(1, intrnl_lftm);
+            cd1->ElemTyp(2) = A_Str;
+            cd1->Str(2) = ", &(";
+            cd->ElemTyp(1) = A_Ary;
+            cd->Array(1) = cd1;
+            break;
+         default:
+            /*
+             * Cset, real, integer, or string
+             */
+            if (typcd == cset_typ)
+               cd->Str(1) = "cset(&(";
+            else if (typcd == real_typ) 
+               cd->Str(1) = "real(&(";
+            else if (typcd == int_typ) 
+               cd->Str(1) = "int(&(";
+            else if (typcd == str_typ)
+               cd->Str(1) = "str(&(";
+            break;
+         }
+   
+      il_var(src, cd, 2);
+   
+      cd->ElemTyp(3) = A_Str;
+      if (dflt != NULL && dflt_to_ptr)
+         cd->Str(3) = "), &(";
+      else
+         cd->Str(3) = "), ";
+   
+   
+      /*
+       * Determine if this conversion has a default value.
+       */
+      i = 4;
+      if (dflt != NULL) {
+         sub_ilc(dflt, cd, i);
+         ++i;
+         cd->ElemTyp(i) = A_Str;
+         if (dflt_to_ptr)
+            cd->Str(i) = "), ";
+         else
+            cd->Str(i) = ", ";
+         ++i;
+         }
+   
+      cd->ElemTyp(i) = A_Str;
+      cd->Str(i) = "&(";
+      ++i;
+      cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i);
+      ++i;
+      cd->ElemTyp(i) = A_Str;
+      cd->Str(i) = "))";
+      }
+   return cd;
+   }
+
+/*
+ * il_dflt - generate code for a defaulting conversion that always defaults.
+ */
+struct code *il_dflt(typcd, src, dflt, dest)
+int typcd;
+struct il_code *src;
+struct il_c *dflt;
+struct il_c *dest;
+   {
+   struct code *cd;
+   int sym_indx;
+
+   sym_indx = src->u[0].n;
+
+   if (typcd == TypCDbl) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(PrmDbl, 0, src, sym_indx, dest, cd, 1);  /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypCInt || typcd == TypECInt) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(PrmInt, 0, src, sym_indx, dest, cd, 1);  /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypTStr || typcd == str_typ) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      " = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", 1)";
+      }
+   else if (typcd == TypCStr) {
+      cd = alc_ary(5);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(AsgnCStr(";
+      cnv_dest(0, 1, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ", ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      "), 1)";
+      }
+   else if (typcd == TypTCset || typcd == cset_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(BlkLoc(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ") = (union block *)&";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", ";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                      ".dword = D_Cset, 1)";
+      }
+   else if (typcd == TypEInt || typcd == int_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "(IntVal(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                      ") = ";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                                      ", ";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                     ".dword = D_Integer, 1)";
+      }
+   else if (typcd == real_typ) {
+      cd = alc_ary(7);
+      cd->ElemTyp(0) = A_Str;
+      cd->Str(0) =                                      "((BlkLoc(";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 1);       /* variable */
+      cd->ElemTyp(2) = A_Str;
+      cd->Str(2) =                                ") = (union block *)alcreal(";
+      sub_ilc(dflt, cd, 3);                             /* default */
+      cd->ElemTyp(4) = A_Str;
+      cd->Str(4) =                     ")) == NULL ? (fatalerr(0,NULL), 0) : (";
+      cnv_dest(0, 0, src, sym_indx, dest, cd, 5);       /* variable */
+      cd->ElemTyp(6) = A_Str;
+      cd->Str(6) =                                     ".dword = D_Real, 1))";
+      }
+
+   return cd;
+   }
+
+/*
+ * cnv_dest - output the destination of a conversion.
+ */
+static void cnv_dest(loc, is_cstr, src, sym_indx, dest, cd, i)
+int loc;
+int is_cstr;
+struct il_code *src;
+int sym_indx;
+struct il_c *dest;
+struct code *cd;
+int i;
+   {
+   if (dest == NULL) {
+      /*
+       * Convert "in place", changing the location of a parameter if needed.
+       */
+      switch (loc) {
+         case PrmInt:
+            if (cur_symtab[sym_indx].itmp_indx < 0)
+               cur_symtab[sym_indx].itmp_indx = alc_itmp(intrnl_lftm);
+            cur_symtab[sym_indx].loc = itmp_loc(cur_symtab[sym_indx].itmp_indx);
+            break;
+         case PrmDbl:
+            if (cur_symtab[sym_indx].dtmp_indx < 0)
+               cur_symtab[sym_indx].dtmp_indx = alc_dtmp(intrnl_lftm);
+            cur_symtab[sym_indx].loc = dtmp_loc(cur_symtab[sym_indx].dtmp_indx);
+            break;
+         }
+      il_var(src, cd, i);
+      if (is_cstr)
+         cur_symtab[sym_indx].loc = loc_cpy(cur_symtab[sym_indx].loc,M_CharPtr);
+      }
+   else {
+      if (is_cstr && dest->il_c_type == ILC_Mod && dest->next == NULL &&
+         dest->n != RsltIndx && cur_symtab[dest->n].loc->mod_access != M_None) {
+            /*
+             * We are converting to a C string. The destination variable
+             *  is not defined as a simple descriptor, but must be accessed
+             *  as such for this conversion.
+             */
+            cd->ElemTyp(i) = A_ValLoc;
+            cd->ValLoc(i) = loc_cpy(cur_symtab[dest->n].loc, M_None);
+            }
+      else 
+         sub_ilc(dest, cd, i);
+      }
+
+   }
+
+/*
+ * il_copy - produce code for an optimized "conversion" that always succeeds
+ *   and just copies a value from one place to another.
+ */
+struct code *il_copy(dest, src)
+struct il_c *dest;
+struct val_loc *src;
+   {
+   struct code *cd;
+
+   cd = alc_ary(5);
+   cd->ElemTyp(0) = A_Str;
+   cd->Str(0) = "(";
+   sub_ilc(dest, cd, 1);
+   cd->ElemTyp(2) = A_Str;
+   cd->Str(2) = " = ";
+   cd->ElemTyp(3) = A_ValLoc;
+   cd->ValLoc(3) = src;
+   cd->ElemTyp(4) = A_Str;
+   cd->Str(4) = ", 1)";
+   return cd;
+   }
+
+/*
+ * loc_cpy - make a copy of a reference to a value location, but change
+ *  the way the location is accessed.
+ */
+struct val_loc *loc_cpy(loc, mod_access)
+struct val_loc *loc;
+int mod_access;
+   {
+   struct val_loc *new_loc;
+
+   if (loc == NULL)
+      return NULL;
+   new_loc = NewStruct(val_loc);
+   *new_loc = *loc;
+   new_loc->mod_access = mod_access;
+   return new_loc;
+   }
+
+/*
+ * gen_tcase - generate in-line code for a type_case statement.
+ */
+static int gen_tcase(il, has_dflt)
+struct il_code *il;
+int has_dflt;
+   {
+   struct case_anlz case_anlz;
+
+   /*
+    * We can only get here if the type_case statement can be implemented
+    *  with a no more than one type check. Determine how simple the
+    *  code can be.
+    */
+   findcases(il, has_dflt, &case_anlz);
+   if (case_anlz.il_then == NULL) {
+      if (case_anlz.il_else == NULL)
+         return 1;
+      else
+         return gen_il(case_anlz.il_else);
+      }
+   else
+      return gen_if(typ_chk(il->u[0].fld, case_anlz.typcd), case_anlz.il_then,
+         case_anlz.il_else, sav_locs());
+   }
+
+/*
+ * gen_if - generate code to test a condition that might be true
+ *  of false. Determine if execution can continue past this if statement.
+ */
+static int gen_if(cond_cd, il_then, il_else, locs)
+struct code *cond_cd;
+struct il_code *il_then;
+struct il_code *il_else;
+struct val_loc **locs;
+   {
+   struct val_loc **locs1;
+   struct code *lbl_then;
+   struct code *lbl_end;
+   struct code *else_loc;
+   struct code *cd;
+   int fall_thru;
+
+   lbl_then = oper_lbl("then");
+   lbl_end = oper_lbl("end if");
+   cd = NewCode(2);
+   cd->cd_id = C_If;
+   cd->Cond = cond_cd;
+   cd->ThenStmt = mk_goto(lbl_then);
+   cd_add(cd);
+   else_loc = cur_fnc->cursor;
+   cd_add(lbl_then);
+   fall_thru = gen_il(il_then);
+   cd_add(lbl_end);
+   locs1 = sav_locs();
+   rstr_locs(locs);
+   cur_fnc->cursor = else_loc;  /* go back for the else clause */
+   fall_thru |= gen_il(il_else);
+   cd_add(mk_goto(lbl_end));
+   cur_fnc->cursor = lbl_end;
+   mrg_locs(locs1);
+   return fall_thru;
+   }
diff --git a/src/iconc/ivalues.c b/src/iconc/ivalues.c
new file mode 100644
index 0000000..4fbb288
--- /dev/null
+++ b/src/iconc/ivalues.c
@@ -0,0 +1,51 @@
+/*
+ * ivalues.c - routines for manipulating Icon values.
+ */
+#include "../h/gsupport.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ccode.h"
+#include "cproto.h"
+#include "cglobals.h"
+
+
+/*
+ * iconint - convert the string representation of an Icon integer to a C long. 
+ *   Return -1 if the number is too big and large integers are supported.
+ */
+long iconint(image)
+char *image;
+   {
+   register int c;
+   register int r;
+   register char *s;
+   long n, n1;
+   int overflow;
+
+   s = image;
+   overflow = 0;
+   n = 0L;
+   while ((c = *s++) >= '0' && c <= '9') {
+      n1 = n * 10 + (c - '0');
+      if (n != n1 / 10)
+         overflow = 1;
+      n = n1;
+      }
+   if (c == 'r' || c == 'R') {
+      r = n;
+      n = 0L;
+      while ((c = *s++) != '\0') {
+         n1 = n * r + tonum(c);
+         if (n != n1 / r)
+            overflow = 1;
+         n = n1;
+         }
+      }
+   if (overflow)
+      if (largeints)
+         n = -1;
+      else
+         tfatal("large integer option required", image);
+   return n;
+   }
diff --git a/src/iconc/lifetime.c b/src/iconc/lifetime.c
new file mode 100644
index 0000000..9a4a7b5
--- /dev/null
+++ b/src/iconc/lifetime.c
@@ -0,0 +1,496 @@
+/*
+ * lifetime.c - perform liveness analysis to determine lifetime of intermediate
+ *    results.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "cglobals.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "csym.h"
+#include "ccode.h"
+#include "cproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static void arg_life (nodeptr n, long min_result, long max_result,
+                          int resume, int frst_arg, int nargs, nodeptr resumer,
+                          nodeptr *failer, int *gen);
+
+static int postn = -1; /* relative position in execution order (all neg) */
+
+/*
+ * liveness - compute lifetimes of intermediate results.
+ */
+void liveness(n, resumer, failer, gen)
+nodeptr n;
+nodeptr resumer;
+nodeptr *failer;
+int *gen;
+   {
+   struct loop {
+      nodeptr resumer;
+      int gen;
+      nodeptr lifetime;
+      int every_cntrl;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop = NULL;
+   nodeptr failer1;
+   nodeptr failer2;
+   int gen1 = 0;
+   int gen2 = 0;
+   struct node *cases;
+   struct node *clause;
+   long min_result;  /* minimum result sequence length */
+   long max_result;  /* maximum result sequence length */
+   int resume;	     /* flag - resumption possible after last result */
+
+   n->postn = postn--;
+
+   switch (n->n_type) {
+      case N_Activat:
+         /*
+          * Activation can fail or succeed.
+           */
+         arg_life(n, 0L, 1L, 0, 1, 2, resumer, failer, gen);
+         break;
+
+      case N_Alt:
+         Tree1(n)->lifetime = n->lifetime;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, &failer2, &gen2);
+         liveness(Tree0(n), resumer, &failer1, &gen1);
+         *failer = failer2;
+         *gen = 1;
+         break;
+
+      case N_Apply:
+         /* 
+          * Assume operation can suspend or fail.
+          */
+         arg_life(n, 0L, UnbndSeq, 1, 0, 2, resumer, failer, gen);
+         break;
+
+      case N_Augop:
+         /*
+          * Impl0(n) is assignment. Impl1(n) is the augmented operation.
+          */
+         min_result = Impl0(n)->min_result * Impl1(n)->min_result;
+         max_result = Impl0(n)->max_result * Impl1(n)->max_result;
+         resume = Impl0(n)->resume | Impl1(n)->resume;
+         arg_life(n, min_result, max_result, resume, 2, 2, resumer, failer,
+            gen);
+         break;
+
+      case N_Bar:
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree0(n), resumer, failer, &gen1);
+         *gen = 1;
+         break;
+
+      case N_Break:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for break", NULL);
+            return;
+            }
+         Tree0(n)->lifetime = cur_loop->lifetime;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         liveness(Tree0(n), loop_sav->resumer, &failer1, &gen1);
+         cur_loop = loop_sav;
+         cur_loop->gen |= gen1;
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Case:
+         *failer = resumer;
+         *gen = 0;
+
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             *  Body.
+             */
+            Tree1(clause)->lifetime = n->lifetime;
+            liveness(Tree1(clause), resumer, &failer2, &gen2);
+            if (resumer == NULL && failer2 != NULL)
+               *failer = n;
+            *gen |= gen2;
+      
+            /*
+             * The expression being compared can be resumed.
+             */
+            Tree0(clause)->lifetime = clause;
+            liveness(Tree0(clause), clause, &failer1, &gen1);
+            }
+
+         if (Tree2(n) == NULL) {
+            if (resumer == NULL)
+               *failer = n;
+            }
+         else {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);  /* default */
+            if (resumer == NULL && failer2 != NULL)
+               *failer = n;
+            *gen |= gen2;
+            }
+
+         /*
+          * control clause is bounded
+          */
+         Tree0(n)->lifetime = n;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         if (failer1 != NULL && *failer == NULL)
+            *failer = failer1;
+         break;
+
+      case N_Create:
+         Tree0(n)->lifetime = n;
+         loop_sav = cur_loop;
+         cur_loop = NULL;        /* check for invalid break and next */
+         liveness(Tree0(n), n, &failer1, &gen1);
+         cur_loop = loop_sav;
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Cset:
+      case N_Empty:
+      case N_Id: 
+      case N_Int:
+      case N_Real:
+      case N_Str:
+         *failer = resumer;
+         *gen = 0;
+         break;
+
+      case N_Field:
+         Tree0(n)->lifetime = n;
+         liveness(Tree0(n), resumer, failer, gen);
+         break;
+
+      case N_If:
+         Tree1(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, failer, gen);
+         if (Tree2(n)->n_type != N_Empty) {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);
+            if (failer2 != NULL) {
+               if (*failer == NULL)
+                  *failer = failer2;
+               else {
+                 if ((*failer)->postn < failer2->postn)
+                   *failer = failer2;
+                 if ((*failer)->postn < n->postn)
+                   *failer = n;
+                 }
+               }
+            *gen |= gen2;
+            }
+         /*
+          * control clause is bounded
+          */
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         if (Tree2(n)->n_type == N_Empty && failer1 != NULL && *failer == NULL)
+            *failer = failer1;
+         break;
+
+      case N_Invok:
+         /*
+          * Assume operation can suspend and fail.
+          */
+         arg_life(n, 0L, UnbndSeq, 1, 1, Val0(n) + 1, resumer, failer, gen);
+         break;
+
+      case N_InvOp:
+         arg_life(n, Impl1(n)->min_result, Impl1(n)->max_result,
+            Impl1(n)->resume, 2, Val0(n), resumer, failer, gen);
+         break;
+
+      case N_InvProc:
+         if (Proc1(n)->ret_flag & DoesFail)
+             min_result = 0L;
+         else
+             min_result = 1L;
+         if (Proc1(n)->ret_flag & DoesSusp) {
+             max_result = UnbndSeq;
+             resume = 1;
+             }
+         else {
+             max_result = 1L;
+             resume = 0;
+             }
+         arg_life(n, min_result, max_result, resume, 2, Val0(n), resumer,
+            failer, gen);
+         break;
+
+      case N_InvRec:
+         arg_life(n, err_conv ? 0L : 1L, 1L, 1, 2, Val0(n), resumer, failer,
+            gen);
+         break;
+
+      case N_Limit:
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+         Tree0(n)->lifetime = n->lifetime;
+         liveness(Tree0(n), resumer, &failer1, &gen1);
+         Tree1(n)->lifetime = n;
+         liveness(Tree1(n), failer1 == NULL ? n : failer1, &failer2, &gen2);
+         *failer = failer2;
+         *gen = gen1 | gen2;
+         break;
+
+      case N_Loop: {
+         loop_info.prev = cur_loop;
+         loop_info.resumer = resumer;
+         loop_info.gen = 0;
+         loop_info.every_cntrl = 0;
+         loop_info.lifetime = n->lifetime;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+               /*
+                * The body is bounded. The control clause is resumed
+                *  by the control structure.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer2, &gen2);
+               loop_info.every_cntrl = 1;
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), n, &failer1, &gen1);
+               break;
+
+            case REPEAT:
+               /*
+                * The body is bounded.
+                */
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), NULL, &failer1, &gen1);
+               break;
+
+            case SUSPEND:
+               /*
+                * The body is bounded. The control clause is resumed
+                *  by the control structure.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer2, &gen2);
+               loop_info.every_cntrl = 1;
+               Tree1(n)->lifetime = n;
+               liveness(Tree1(n), n, &failer1, &gen1);
+               break;
+
+            case WHILE:
+            case UNTIL:
+               /*
+                * The body and the control clause are each bounded.
+                */
+               Tree2(n)->lifetime = NULL;
+               liveness(Tree2(n), NULL, &failer1, &gen1);
+               Tree1(n)->lifetime = NULL;
+               liveness(Tree1(n), NULL, &failer1, &gen1);
+               break;
+            }
+         *failer = (resumer == NULL ? n : resumer); /* assume a loop can fail */
+         *gen = cur_loop->gen;
+         cur_loop = cur_loop->prev;
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for next", NULL);
+            return;
+            }
+         if (cur_loop->every_cntrl)
+             *failer = n;
+         else
+             *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Not:
+         /*
+          * The expression is bounded.
+          */
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         *failer = (resumer == NULL ? n : resumer);
+         *gen = 0;
+         break;
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)  {
+            /*
+             * The expression is bounded.
+             */
+            Tree1(n)->lifetime = n;
+            liveness(Tree1(n), NULL, &failer1, &gen1);
+            }
+         *failer = NULL;
+         *gen = 0;
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         if (resumer == NULL)
+            n->intrnl_lftm = n;
+         else
+            n->intrnl_lftm = resumer;
+
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            asgn_impl = optab[asgn_loc].binary;
+            arg_life(n, asgn_impl->min_result, asgn_impl->max_result,
+               asgn_impl->resume, 1, 2, resumer, failer, gen);
+            }
+         else {
+            Tree2(n)->lifetime = n->lifetime;
+            liveness(Tree2(n), resumer, &failer2, &gen2);  /* body */
+            Tree1(n)->lifetime = n;
+            liveness(Tree1(n), failer2, &failer1, &gen1);  /* subject */ 
+            *failer = failer1;
+            *gen = gen1 | gen2;
+            }
+         }
+         break;
+
+      case N_Sect:
+         /*
+          * Impl0(n) is sectioning.
+          */
+         min_result = Impl0(n)->min_result;
+         max_result = Impl0(n)->max_result;
+         resume = Impl0(n)->resume;
+         if (Impl1(n) != NULL) {
+            /*
+             * Impl1(n) is plus or minus.
+             */
+            min_result *= Impl1(n)->min_result;
+            max_result *= Impl1(n)->max_result;
+            resume |= Impl1(n)->resume;
+            }
+         arg_life(n, min_result, max_result, resume, 2, 3, resumer, failer,
+            gen);
+         break;
+
+      case N_Slist:
+         /*
+          * expr1 is not bounded, expr0 is bounded.
+          */
+         Tree1(n)->lifetime = n->lifetime;
+         liveness(Tree1(n), resumer, failer, gen);
+         Tree0(n)->lifetime = NULL;
+         liveness(Tree0(n), NULL, &failer1, &gen1);
+         break;
+
+      case N_SmplAsgn:
+         Tree3(n)->lifetime = n;
+         liveness(Tree3(n), resumer, failer, gen);     /* 2nd operand */
+         Tree2(n)->lifetime = n->lifetime;             /* may be result of := */
+         liveness(Tree2(n), *failer, &failer1, &gen1); /* 1st operand */
+         break;
+
+      case N_SmplAug:
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         arg_life(n, Impl1(n)->min_result, Impl1(n)->max_result,
+            Impl1(n)->resume, 2, 2, resumer, failer, gen);
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * arg_life - compute the lifetimes of an argument list.
+ */
+static void arg_life(n, min_result, max_result, resume, frst_arg, nargs,
+   resumer, failer, gen)
+nodeptr n;
+long min_result;  /* minimum result sequence length */
+long max_result;  /* maximum result sequence length */
+int resume;	  /* flag - resumption possible after last result */
+int frst_arg;
+int nargs;
+nodeptr resumer;
+nodeptr *failer;
+int *gen;
+   {
+   nodeptr failer1;
+   nodeptr failer2;
+   nodeptr lifetime;
+   int inv_fail;    /* failure after operation in invoked */
+   int reuse;
+   int gen2;
+   int i;
+
+   /*
+    * Determine what, if anything, can resume the rightmost argument.
+    */
+   if (resumer == NULL && min_result == 0)
+      failer1 = n;
+   else
+      failer1 = resumer;
+   if (failer1 == NULL)
+      inv_fail = 0;
+   else
+      inv_fail = 1;
+
+   /*
+    * If the operation can be resumed, variables internal to the operation
+    *  have and extended lifetime.
+    */
+   if (resumer != NULL && (max_result > 1 || max_result == UnbndSeq || resume))
+      n->intrnl_lftm = resumer;
+   else
+      n->intrnl_lftm = n;
+
+   /*
+    * Go through the parameter list right to left, propagating resumption
+    *  information, computing lifetimes, and determining whether anything
+    *  can generate.
+    */
+   lifetime = n;
+   reuse = 0;
+   *gen = 0;
+   for (i = frst_arg + nargs - 1; i >= frst_arg; --i) {
+      n->n_field[i].n_ptr->lifetime = lifetime;
+      n->n_field[i].n_ptr->reuse = reuse;
+      liveness(n->n_field[i].n_ptr, failer1, &failer2, &gen2);
+      if (resumer != NULL && gen2)
+         lifetime = resumer;
+      if (inv_fail && gen2)
+         reuse = 1;
+      failer1 = failer2;
+      *gen |= gen2;
+      }
+   *failer = failer1;
+   if (max_result > 1 || max_result == UnbndSeq)
+      *gen = 1;
+   }
diff --git a/src/iconc/types.c b/src/iconc/types.c
new file mode 100644
index 0000000..cd3a3ef
--- /dev/null
+++ b/src/iconc/types.c
@@ -0,0 +1,893 @@
+/*
+ * typinfer.c - routines to perform type inference.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+#ifdef TypTrc
+#ifdef HighResTime
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif					/* HighResTime */
+#endif					/* TypTrc */
+
+extern unsigned int null_bit;   /* bit for null type */
+extern unsigned int str_bit;    /* bit for string type */
+extern unsigned int cset_bit;   /* bit for cset type */
+extern unsigned int int_bit;    /* bit for integer type */
+extern unsigned int real_bit;   /* bit for real type */
+extern unsigned int n_icntyp;   /* number of non-variable types */
+extern unsigned int n_intrtyp;  /* number of types in intermediate values */
+extern unsigned int val_mask;   /* mask for non-var types in last int of type*/
+extern struct typ_info *type_array;
+
+/*
+ * free_struct_typinfo - frees a struct typinfo structure by placing
+ *    it one a list of free structures
+ */
+#ifdef OptimizeType
+extern struct typinfo *start_typinfo;
+extern struct typinfo *high_typinfo;
+extern struct typinfo *low_typinfo;
+extern struct typinfo *free_typinfo;
+
+void free_struct_typinfo(struct typinfo *typ)  {
+
+   typ->bits = (unsigned int *)free_typinfo;
+   free_typinfo = typ;
+}
+#endif					/* OptimizeType */
+
+/*
+ * alloc_typ - allocate a compressed type structure and initializes
+ *    the members to zero or NULL.
+ */
+#ifdef OptimizeType
+struct typinfo *alloc_typ(n_types)
+#else					/* OptimizeType */
+unsigned int *alloc_typ(n_types)
+#endif					/* OptimizeType */
+int n_types;
+{
+#ifdef OptimizeType
+   struct typinfo *typ;
+   int i;
+   unsigned int init = 0;
+
+   if ((free_typinfo == NULL) && (high_typinfo == low_typinfo))  {
+      /*
+       * allocate a large block of memory used to parcel out struct typinfo
+       *   structures from
+       */
+      start_typinfo = (struct typinfo *)alloc(sizeof(struct typinfo) * TYPINFO_BLOCK);
+      high_typinfo = start_typinfo;
+      low_typinfo = start_typinfo + TYPINFO_BLOCK;
+      free_typinfo = NULL;
+      typ = start_typinfo;
+      high_typinfo++;
+   }
+   else if (free_typinfo != NULL) {
+      /*
+       * get a typinfo stucture from the list of free structures
+       */
+      typ = free_typinfo;
+      free_typinfo = (struct typinfo *)free_typinfo->bits;
+   }
+   else  {
+      /*
+       * get a typinfo structure from the chunk of memory allocated
+       *   previously
+       */
+      typ = high_typinfo;
+      high_typinfo++;
+   }
+   typ->packed = n_types;
+   if (!do_typinfer)
+      typ->bits = alloc_mem_typ(n_types);
+   else
+      typ->bits= NULL;
+   return typ;
+#else					/* OptimizeType */
+   int n_ints;
+   unsigned int *typ;
+   int i;
+   unsigned int init = 0;
+
+   n_ints = NumInts(n_types);
+   typ = (unsigned int *)alloc((unsigned int)((n_ints)*sizeof(unsigned int)));
+
+   /*
+    * Initialization: if we are doing inference, start out assuming no types.
+    *  If we are not doing inference, assume any type.
+    */
+   if (!do_typinfer)
+      init = ~init;
+   for (i = 0; i < n_ints; ++i)
+     typ[i] = init;
+   return typ;
+#endif					/* OptimizeType */
+}
+
+/*
+ * alloc_mem_typ - actually allocates a full sized bit vector.
+ */
+#ifdef OptimizeType
+unsigned int *alloc_mem_typ(n_types)
+unsigned int n_types;
+{
+   int n_ints;
+   unsigned int *typ;
+   int i;
+   unsigned int init = 0;
+
+   n_ints = NumInts(n_types);
+   typ = (unsigned int *)alloc((unsigned int)((n_ints)*sizeof(unsigned int)));
+   if (!do_typinfer)
+      init = ~init;
+   for(i=0; i < n_ints ;++i)
+      typ[i] = init;
+   return typ;
+}
+#endif					/* OptimizeType */
+
+/*
+ * set_typ - set a particular type bit in a type bit vector.
+ */
+void set_typ(type, bit)
+#ifdef OptimizeType
+struct typinfo *type;
+#else					/* OptimizeType */
+unsigned int *type;
+#endif					/* OptimizeType */
+unsigned int bit;
+{
+   unsigned int indx;
+   unsigned int mask;
+
+#ifdef OptimizeType
+   if (type->bits == NULL)  {
+      if (bit == null_bit)
+         type->packed |= NULL_T; 
+      else if (bit == real_bit)
+         type->packed |= REAL_T; 
+      else if (bit == int_bit)
+         type->packed |= INT_T; 
+      else if (bit == cset_bit)
+         type->packed |= CSET_T; 
+      else if (bit == str_bit)
+         type->packed |= STR_T; 
+      else {
+         /*
+          * if the bit to set is not one of the five builtin types
+          *   then allocate a whole bit vector, copy the packed
+          *   bits over, and set the requested bit
+          */
+         type->bits = alloc_mem_typ(DecodeSize(type->packed));
+         xfer_packed_types(type);
+         indx = bit / IntBits;
+         mask = 1;
+         mask <<= bit % IntBits;
+         type->bits[indx] |= mask;
+      }
+   }
+   else  {
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   type[indx] |= mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * clr_type - clear a particular type bit in a type bit vector.
+ */
+void clr_typ(type, bit)
+#ifdef OptimizeType
+struct typinfo *type;
+#else					/* OptimizeType */
+unsigned int *type;
+#endif					/* OptimizeType */
+unsigned int bit;
+{
+   unsigned int indx;
+   unsigned int mask;
+
+#ifdef OptimizeType
+   if (type->bits == NULL)  {
+      /*
+       * can only clear one of five builtin types
+       */
+      if (bit == null_bit)
+         type->packed &= ~NULL_T;
+      else if (bit == real_bit)
+         type->packed &= ~REAL_T;
+      else if (bit == int_bit)
+         type->packed &= ~INT_T;
+      else if (bit == cset_bit)
+         type->packed &= ~CSET_T;
+      else if (bit == str_bit)
+         type->packed &= ~STR_T;
+   }
+   else  {
+      /*
+       * build bit mask to clear requested type in full bit vector
+       */
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      type->bits[indx] &= ~mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   type[indx] &= ~mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * has_type - determine if a bit vector representing types has any bits
+ *  set that correspond to a specific type code from the data base.  Also,
+ *  if requested, clear any such bits.
+ */
+int has_type(typ, typcd, clear)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int typcd;
+int clear;
+{
+   int frst_bit, last_bit;
+   int i;
+   int found;
+
+   found = 0;
+   bitrange(typcd, &frst_bit, &last_bit);
+   for (i = frst_bit; i < last_bit; ++i) {
+      if (bitset(typ, i)) {
+         found = 1;
+         if (clear)
+            clr_typ(typ, i);
+         }
+      }
+   return found;
+}
+
+/*
+ * other_type - determine if a bit vector representing types has any bits
+ *  set that correspond to a type *other* than specific type code from the
+ *  data base.
+ */
+int other_type(typ, typcd)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int typcd;
+   {
+   int frst_bit, last_bit;
+   int i;
+
+   bitrange(typcd, &frst_bit, &last_bit);
+   for (i = 0; i < frst_bit; ++i)
+      if (bitset(typ, i))
+         return 1;
+   for (i = last_bit; i < n_intrtyp; ++i)
+      if (bitset(typ, i))
+         return 1;
+   return 0;
+   }
+
+/*
+ * bitrange - determine the range of bit positions in a type bit vector
+ *  that correspond to a type code from the data base.
+ */
+void bitrange(typcd, frst_bit, last_bit)
+int typcd;
+int *frst_bit;
+int *last_bit;
+   {
+   if (typcd == TypVar) {
+      /*
+       * All variable types.
+       */
+      *frst_bit = n_icntyp;
+      *last_bit = n_intrtyp;
+      }
+   else {
+      *frst_bit = type_array[typcd].frst_bit;
+      *last_bit = *frst_bit + type_array[typcd].num_bits;
+      }
+   }
+
+/*
+ * typcd_bits - set the bits of a bit vector corresponding to a type
+ *  code from the data base.
+ */
+void typcd_bits(typcd, typ)
+int typcd;
+struct type *typ;
+   {
+   int frst_bit;
+   int last_bit;
+   int i;
+
+   if (typcd == TypEmpty)
+      return;  /* Do nothing.  */
+
+   if (typcd == TypAny) {
+      /*
+       * Set bits corresponding to first-class types.
+       */
+#ifdef OptimizeType
+      /*
+       * allocate a full bit vector and copy over packed types first
+       */
+      if (typ->bits->bits == NULL)   {
+          typ->bits->bits = alloc_mem_typ(DecodeSize(typ->bits->packed));
+          xfer_packed_types(typ->bits);
+      }
+      for (i = 0; i < NumInts(n_icntyp) - 1; ++i)
+         typ->bits->bits[i] |= ~(unsigned int)0;
+      typ->bits->bits[i] |= val_mask;
+#else					/* OptimizeType */
+      for (i = 0; i < NumInts(n_icntyp) - 1; ++i)
+         typ->bits[i] |= ~(unsigned int)0;
+      typ->bits[i] |= val_mask;
+#endif					/* OptimizeType */
+      return;
+      }
+
+   bitrange(typcd, &frst_bit, &last_bit);
+#ifdef OptimizeType
+   if (last_bit > DecodeSize(typ->bits->packed)) /* bad abstract type computation */
+      return;
+#endif					/* OptimizeType */
+   for (i = frst_bit; i < last_bit; ++i)
+      set_typ(typ->bits, i);
+   }
+
+/*
+ * bitset - determine if a specific bit in a bit vector is set.
+ */
+int bitset(typ, bit)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int bit;
+{
+   int mask;
+   int indx;
+
+#ifdef OptimizeType
+   if (typ->bits == NULL)  {
+      /*
+       * check to see if the requested bit is set in the packed representation
+       *   if the requested bit is not one of the five builtins then the
+       *   lookup fails no matter what
+       */
+      if (bit == null_bit)
+         return (typ->packed & NULL_T);
+      else if (bit == real_bit)
+         return (typ->packed & REAL_T);
+      else if (bit == int_bit)
+         return (typ->packed & INT_T);
+      else if (bit == cset_bit)
+         return (typ->packed & CSET_T);
+      else if (bit == str_bit)
+         return (typ->packed & STR_T);
+      else 
+         return 0;
+   }
+   else  {
+      /*
+       * create a mask to check to see if the requested type bit is
+       *   set on
+       */
+      indx = bit / IntBits;
+      mask = 1;
+      mask <<= bit % IntBits;
+      return typ->bits[indx] & mask;
+   }
+#else					/* OptimizeType */
+   indx = bit / IntBits;
+   mask = 1;
+   mask <<= bit % IntBits;
+   return typ[indx] & mask;
+#endif					/* OptimizeType */
+}
+
+/*
+ * is_empty - determine if a type bit vector is empty.
+ */
+int is_empty(typ)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+{
+   int i;
+
+#ifdef OptimizeType
+   if (typ->bits == NULL)  {
+      /*
+       * if any bits are set on then the vector is not empty
+       */
+      if (DecodePacked(typ->packed))
+         return 0;
+      else
+         return 1;
+   }
+   else  {
+      for (i = 0; i < NumInts(n_intrtyp); ++i) {
+          if (typ->bits[i] != 0)
+             return 0;
+          }
+      return 1;
+   }
+#else					/* OptimizeType */
+   for (i = 0; i < NumInts(n_intrtyp); ++i) {
+       if (typ[i] != 0)
+          return 0;
+       }
+   return 1;
+#endif					/* OptimizeType */
+}
+
+/*
+ * xfer_packed_types - transfers the packed type representation
+ *   to a full length bit vector representation in the same
+ *   struct typinfo structure.
+ */
+#ifdef OptimizeType
+void xfer_packed_types(type)
+struct typinfo *type;
+{
+   unsigned int indx, mask;
+
+   /*
+    * for each IF statement built a mask to set each of the five builtins
+    *   if they are present in the packed representation
+    */
+   if (type->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      mask = 1;
+      mask <<= null_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      mask = 1;
+      mask <<= real_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      mask = 1;
+      mask <<= int_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      mask = 1;
+      mask <<= cset_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+   if (type->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      mask = 1;
+      mask <<= str_bit % IntBits;
+      type->bits[indx] |= mask;
+   }
+}
+
+/*
+ * xfer_packed_to_bits - sets those type bits from the src typinfo structure
+ *     to the dest typinfo structure AND the src is a packed representation
+ *     while the dest is a bit vector. Returns the number of new bits that
+ *     were set in the destination.
+ */
+int xfer_packed_to_bits(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, mask, old, rnsize;
+   int changes[5] = {-1,-1,-1,-1,-1};
+   int ix, membr = 0, i;
+
+   ix = 0;
+   rnsize = NumInts(nsize);
+   /*
+    * for each possible type set in the packed vector, create a mask
+    *   and apply it to the dest.  check to see if there was actually
+    *   a change in the dest vector.
+    */
+   if (src->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= null_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               /*
+                * checks to see if the bit just set happens to be in the
+                *   same word as any other of the five builtins. if they
+                *   are then we only want to count this as one change 
+                */
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= real_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= int_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= cset_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   if (src->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)  {
+         mask = 1;
+         mask <<= str_bit % IntBits;
+         old = dest->bits[indx];
+         dest->bits[indx] |= mask;
+         if (old != dest->bits[indx])  {
+            membr = 0;
+            for (i=0; i < 5 ;i++)
+               if (indx == changes[i]) {
+                  membr = 1; break;
+               }
+            if (!membr)
+               changes[ix++] = indx;
+         }
+      }
+   }
+   return ix;
+}
+
+/*
+ * and_bits_to_packed - performs a bitwise AND of two typinfo structures
+ *    taking into account of packed or full bit representation.
+ */
+void and_bits_to_packed(src, dest, size)
+struct typinfo *src;
+struct typinfo *dest;
+int size;
+{
+   unsigned int indx, mask, val, destsz;
+   int  i;
+
+   if ((src->bits == NULL) && (dest->bits == NULL)) 
+      /* Both are packed */
+      dest->packed &= (0xFF000000 | src->packed);
+   else if ((src->bits == NULL) && (dest->bits != NULL))  {
+      /*
+       * built a bit mask for each type in the src and AND it too
+       *  the bit vector in dest
+       */
+      for (i=0; i < NumInts(size) ;i++) {
+         val = get_bit_vector(src,i);
+         dest->bits[i] &= val; 
+      }
+   }
+   else if ((src->bits != NULL) && (dest->bits == NULL))  {
+      /*
+       * because an AND is being performed only those bits in the dest
+       *  have the possibility of remaining set (i.e. five builtins)
+       *  therefore if the bit is set in the packed check to see if 
+       *  it is also set in the full vector, if so then set it in the
+       *  resulting vector, otherwise don't
+       */
+      destsz = DecodeSize(dest->packed);
+      mask = 1; val = 0;
+      if (dest->packed & NULL_T) { 
+         mask <<= (null_bit % IntBits);
+         if (src->bits[(null_bit/IntBits)] & mask)
+            val |= NULL_T;
+      }
+      mask = 1;
+      if (dest->packed & REAL_T) { 
+         mask <<= (real_bit % IntBits);
+         if (src->bits[(real_bit/IntBits)] & mask)
+            val |= REAL_T;
+      }
+      mask = 1;
+      if (dest->packed & INT_T) {
+         mask <<= (int_bit % IntBits);
+         if (src->bits[(int_bit/IntBits)] & mask)
+            val |= INT_T;
+      }
+      mask = 1;
+      if (dest->packed & CSET_T) {
+         mask <<= (cset_bit % IntBits);
+         if (src->bits[(cset_bit/IntBits)] & mask)
+            val |= CSET_T;
+      }
+      mask = 1;
+      if (dest->packed & STR_T) { 
+         mask <<= (str_bit % IntBits);
+         if (src->bits[(str_bit/IntBits)] & mask)
+            val |= STR_T;
+      }
+      dest->packed = val | destsz;
+   }
+   else
+      for (i=0; i < NumInts(size) ;i++)
+         dest->bits[i] &= src->bits[i];
+}
+
+
+/*
+ * get_bit_vector - returns a bit mask from the selected word of a bit
+ *    vector.  e.g. if pos == 2, then check to see if any of the five
+ *    builtins fall in the second word of a normal bit vector, if so
+ *    create a bit mask with those types that fall in that word.
+ */
+
+unsigned int get_bit_vector(src, pos)
+struct typinfo *src;
+int pos;
+{
+   unsigned int val = 0, mask;
+
+   val = 0;
+   if ((src->packed & NULL_T) && ((null_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= null_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & REAL_T) && ((real_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= real_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & INT_T) && ((int_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= int_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & CSET_T) && ((cset_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= cset_bit % IntBits;
+      val |= mask; 
+   }
+   if ((src->packed & STR_T) && ((str_bit / IntBits) == pos))  {
+      mask = 1;
+      mask <<= str_bit % IntBits;
+      val |= mask; 
+   }
+   return val;
+}
+
+
+/*
+ * clr_packed - clears all bits within the nsize-th word for a packed
+ *     representation.
+ */
+
+void clr_packed(src, nsize)
+struct typinfo *src;
+int nsize;
+{
+   unsigned int rnsize;
+
+   rnsize = NumInts(nsize);
+   if ((null_bit / IntBits) < rnsize)
+      src->packed &= ~NULL_T;
+   if ((real_bit / IntBits) < rnsize)
+      src->packed &= ~REAL_T;
+   if ((int_bit / IntBits) < rnsize)
+      src->packed &= ~INT_T;
+   if ((cset_bit / IntBits) < rnsize)
+      src->packed &= ~CSET_T;
+   if ((str_bit / IntBits) < rnsize)
+      src->packed &= ~STR_T;
+}
+
+/*
+ * cpy_packed_to_packed - copies the packed bits from one bit vector
+ *     to another.
+ */
+
+void cpy_packed_to_packed(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, rnsize;
+
+   rnsize = NumInts(nsize);
+   /*
+    * for each of the possible builtin types, check to see if the bit is
+    *  set in the src and if present set it in the dest.
+    */
+   dest->packed = DecodeSize(dest->packed);
+   if (src->packed & NULL_T)  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= NULL_T; 
+   }
+   if (src->packed & REAL_T)  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= REAL_T; 
+   }
+   if (src->packed & INT_T)  {
+      indx = int_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= INT_T; 
+   }
+   if (src->packed & CSET_T)  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= CSET_T; 
+   }
+   if (src->packed & STR_T)  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)
+          dest->packed |= STR_T; 
+   }
+}
+
+
+/*
+ * mrg_packed_to_packed - merges the packed type bits of a src and dest
+ *     bit vector.
+ */
+int mrg_packed_to_packed(src, dest, nsize)
+struct typinfo *src;
+struct typinfo *dest;
+int nsize;
+{
+   unsigned int indx, rnsize;
+   int changes[5] = {-1,-1,-1,-1,-1};
+   int ix = 0, membr = 0, i;
+
+   rnsize = NumInts(nsize);
+   /*
+    * for each of the five possible types in the src, check to see if it
+    *  is set in the src and not set in the dest.  if so then set it in
+    *  the dest vector.
+    */
+   if ((src->packed & NULL_T) && !(dest->packed & NULL_T))  {
+      indx = null_bit / IntBits;
+      if (indx < rnsize) {
+         dest->packed |= NULL_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & REAL_T) && !(dest->packed & REAL_T))  {
+      indx = real_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= REAL_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & INT_T) && !(dest->packed & INT_T)){
+      indx = int_bit / IntBits;
+      if (indx < rnsize) {
+         dest->packed |= INT_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & CSET_T) && !(dest->packed & CSET_T))  {
+      indx = cset_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= CSET_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   if ((src->packed & STR_T) && !(dest->packed & STR_T))  {
+      indx = str_bit / IntBits;
+      if (indx < rnsize)  {
+         dest->packed |= STR_T;
+         for(i=0; i<5 ;i++)  {
+            if (indx == changes[i])  {
+               membr = 1; break;
+            }
+         }
+         if (!membr)
+            changes[ix++] = indx;
+      }
+   }
+   return ix;
+}
+#endif					/* OptimizeType */
diff --git a/src/iconc/typinfer.c b/src/iconc/typinfer.c
new file mode 100644
index 0000000..8a96e23
--- /dev/null
+++ b/src/iconc/typinfer.c
@@ -0,0 +1,5189 @@
+/*
+ * typinfer.c - routines to perform type inference.
+ */
+#include "../h/gsupport.h"
+#include "../h/lexdef.h"
+#include "ctrans.h"
+#include "csym.h"
+#include "ctree.h"
+#include "ctoken.h"
+#include "cglobals.h"
+#include "ccode.h"
+#include "cproto.h"
+#ifdef TypTrc
+#ifdef HighResTime
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif					/* HighResTime */
+#endif					/* TypTrc */
+
+/*
+ * Information about co-expressions is keep on a list.
+ */
+struct t_coexpr {
+   nodeptr n;               /* code for co-expression */
+   int typ_indx;            /* relative type number (index) */
+   struct store *in_store;  /* store entry into co-expression via activation */
+   struct store *out_store; /* store at end of co-expression */
+#ifdef OptimizeType
+   struct typinfo *act_typ;   /* types passed via co-expression activation */
+   struct typinfo *rslt_typ;  /* types resulting from "co-expression return" */
+#else					/* OptimizeType */
+   unsigned int *act_typ;   /* types passed via co-expression activation */
+   unsigned int *rslt_typ;  /* types resulting from "co-expression return" */
+#endif					/* OptimizeType */
+   int iteration;
+   struct t_coexpr *next;
+   };
+
+struct t_coexpr *coexp_lst;
+
+#ifdef TypTrc
+extern int typealloc;		/* flag to account for allocation */
+extern long typespace;		/* amount of space for type inference */
+#endif					/* TypTrc */
+
+struct symtyps *cur_symtyps; /* maps run-time routine symbols to types */
+
+/*
+ * argtyps is the an array of types large enough to accommodate the argument
+ *  list of any operation.
+ */
+struct argtyps {
+   struct argtyps *next;
+#ifdef OptimizeType
+   struct typinfo *types[1];  /* actual size is max_prm */
+#else					/* OptimizeType */
+   unsigned int *types[1];  /* actual size is max_prm */
+#endif					/* OptimizeType */
+   };
+
+/*
+ * prototypes for static functions.
+ */
+#ifdef OptimizeType
+void         and_bits_to_packed (struct typinfo *src, 
+                                     struct typinfo *dest, int size);
+struct typinfo *alloc_typ   (int n_types);
+unsigned int   *alloc_mem_typ   (unsigned int n_types);
+int             bitset      (struct typinfo *typ, int bit);
+void         clr_typ     (struct typinfo *type, unsigned int bit);
+void         clr_packed   (struct typinfo *src, int nsize);
+void         cpy_packed_to_packed (struct typinfo *src,
+				     struct typinfo *dest, int nsize);
+static void         deref_lcl   (struct typinfo *src,
+                                     struct typinfo *dest);
+static int             findloops   ( struct node *n, int resume,
+                                     struct typinfo *rslt_type);
+static void         gen_inv     (struct typinfo *prc_typ, nodeptr n);
+int             has_type    (struct typinfo *typ, int typcd, int clear);
+static void         infer_impl  (struct implement *impl,
+                                     nodeptr n, struct symtyps *symtyps,
+                                     struct typinfo *rslt_typ);
+int             is_empty    (struct typinfo *typ);
+int             mrg_packed_to_packed (struct typinfo *src,
+				     struct typinfo *dest, int nsize);
+int             other_type  (struct typinfo *typ, int typcd);
+static void         set_ret     (struct typinfo *typ);
+void         set_typ     (struct typinfo *type, unsigned int bit);
+void         typcd_bits  (int typcd, struct type *typ);
+static void         typ_deref   (struct typinfo *src,
+                                     struct typinfo *dest, int chk);
+int             xfer_packed_to_bits (struct typinfo *src,
+                                     struct typinfo *dest, int nsize);
+#else					/* OptimizeType */
+unsigned int   *alloc_typ   (int n_types);
+int             bitset      (unsigned int *typ, int bit);
+void         clr_typ     (unsigned int *type, unsigned int bit);
+static void         deref_lcl   (unsigned int *src, unsigned int *dest);
+static int             findloops   ( struct node *n, int resume,
+                                     unsigned int *rslt_type);
+static void         gen_inv     (unsigned int *prc_typ, nodeptr n);
+int             has_type    (unsigned int *typ, int typcd, int clear);
+static void         infer_impl  (struct implement *impl,
+                                     nodeptr n, struct symtyps *symtyps,
+                                     unsigned int *rslt_typ);
+int             is_empty    (unsigned int *typ);
+int             other_type  (unsigned int *typ, int typcd);
+static void         set_ret     (unsigned int *typ);
+void         set_typ     (unsigned int *type, unsigned int bit);
+void         typcd_bits  (int typcd, struct type *typ);
+static void         typ_deref (unsigned int *src, unsigned int *dest, int chk);
+#endif					/* OptimizeType */
+
+static void         abstr_new   (struct node *n, struct il_code *il);
+static void         abstr_typ   (struct il_code *il, struct type *typ);
+static struct store   *alloc_stor  (int stor_sz, int n_types);
+static void         chk_succ    (int ret_flag, struct store *susp_stor);
+static struct store   *cpy_store   (struct store *source);
+static int             eval_cond   (struct il_code *il);
+static void         free_argtyp (struct argtyps *argtyps);
+static void         free_store  (struct store *store);
+static void         free_wktyp  (struct type *typ);
+static void         find_new    (struct node *n);
+static struct argtyps *get_argtyp  (void);
+static struct store   *get_store   (int clear);
+static struct type    *get_wktyp   (void);
+static void         infer_act   (nodeptr n);
+static void         infer_con   (struct rentry *rec, nodeptr n);
+static int             infer_il    (struct il_code *il);
+static void         infer_nd    (nodeptr n);
+static void         infer_prc   (struct pentry *proc, nodeptr n);
+static void         mrg_act     (struct t_coexpr *coexp,
+                                     struct store *e_store,
+                                     struct type *rslt_typ);
+static void         mrg_store   (struct store *source, struct store *dest);
+static void         side_effect (struct il_code *il);
+static struct symtyps *symtyps     (int nsyms);
+
+#ifdef TypTrc
+static void         prt_d_typ   (FILE *file, struct typinfo *typ);
+static void         prt_typ     (FILE *file, struct typinfo *typ);
+#endif					/* TypTrc */
+
+#define CanFail   1
+
+/*
+ * cur_coexp is non-null while performing type inference on code from a
+ *  create expression. If it is null, the possible current co-expressions
+ *  must be found from cur_proc.
+ */
+struct t_coexpr *cur_coexp = NULL;
+
+struct gentry **proc_map;    /* map procedure types to symbol table entries */
+struct rentry **rec_map;     /* map record types to record information */
+struct t_coexpr **coexp_map; /* map co-expression types to information */
+
+struct typ_info *type_array;
+
+static int num_new;   /* number of types supporting "new" abstract type comp */
+
+/*
+ * Data base component codes are mapped to type inferencing information 
+ *  using an array.
+ */
+struct compnt_info {
+   int frst_bit;        /* first bit in bit vector allocated to component */
+   int num_bits;        /* number of bits allocated to this component */
+   struct store *store; /* maps component "reference" to the type it holds */ 
+   };
+static struct compnt_info *compnt_array;
+
+static unsigned int frst_fld;   /* bit number of 1st record field */
+static unsigned int n_fld;      /* number of record fields */
+static unsigned int frst_gbl;   /* bit number of 1st global reference type */
+static unsigned int n_gbl;      /* number of global variables */
+static unsigned int n_nmgbl;    /* number of named global variables */
+static unsigned int frst_loc;   /* bit number of 1st local reference type */
+static unsigned int n_loc;      /* maximum number of locals in any procedure */
+
+static unsigned int nxt_bit;    /* next unassigned bit in bit vector */
+unsigned int n_icntyp;   /* number of non-variable types */
+unsigned int n_intrtyp;  /* number of types in intermediate values */
+static unsigned int n_rttyp;    /* number of types in runtime computations */
+unsigned int val_mask;   /* mask for non-var types in last int of type */
+
+unsigned int null_bit;   /* bit for null type */
+unsigned int str_bit;    /* bit for string type */
+unsigned int cset_bit;   /* bit for cset type */
+unsigned int int_bit;    /* bit for integer type */
+unsigned int real_bit;   /* bit for real type */
+
+static struct store *fld_stor;   /* record fields */
+
+static int *cur_new;      /* allocated types for current operation */
+
+static struct store *succ_store = NULL; /* current success store */
+static struct store *fail_store = NULL; /* current failure store */
+
+static struct store *dummy_stor;
+static struct store *store_pool = NULL; /* free list of store structs */
+
+static struct type *type_pool = NULL;          /* free list of type structs */
+static struct type cur_rslt = {0, NULL, NULL}; /* result type of operation */
+
+static struct argtyps *argtyp_pool = NULL; /* free list of arg type arrays */
+static struct argtyps *arg_typs = NULL;    /* current arg type array */
+
+static int num_args; /* number of arguments for current operation */
+static int n_vararg; /* size of variable part of arg list to run-time routine */
+
+#ifdef OptimizeType
+static struct typinfo *any_typ; /* type bit vector with all bits on */
+struct typinfo *free_typinfo = NULL;
+struct typinfo *start_typinfo = NULL;
+struct typinfo *high_typinfo = NULL;
+struct typinfo *low_typinfo = NULL;
+#else					/* OptimizeType */
+static unsigned int *any_typ; /* type bit vector with all bits on */
+#endif					/* OptimizeType */
+
+long changed;  /* number of changes to type information in this iteration */
+int iteration; /* iteration number for type inferencing */
+
+#ifdef TypTrc
+static FILE *trcfile = NULL;	/* output file pointer for tracing */
+static char *trcname = NULL;	/* output file name for tracing */
+static char *trc_indent = "";
+#endif					/* TypTrc */
+
+
+/*
+ * typeinfer - infer types of operands. If "do_typinfer" is set, actually
+ *   do abstract interpretation, otherwise assume any type for all operands.
+ */
+void typeinfer()
+   {
+   struct gentry *gptr;
+   struct lentry *lptr;
+   nodeptr call_main;
+   struct pentry *p;
+   struct rentry *rec;
+   struct t_coexpr *coexp;
+   struct store *init_store;
+   struct store *f_store;
+#ifdef OptimizeType
+   struct typinfo *type;
+#else					/* OptimizeType */
+   unsigned int *type;
+#endif					/* OptimizeType */
+   struct implement *ip;
+   struct lentry **lhash;
+   struct lentry **vartypmap;
+   int i, j, k;
+   int size;
+   int flag;
+
+#ifdef TypTrc
+   /*
+    * Set up for type tracing.
+    */
+   long start_infer, end_infer;
+
+#ifdef HighResTime
+   struct rusage rusage;
+
+   getrusage(RUSAGE_SELF, &rusage);
+   start_infer = rusage.ru_utime.tv_sec*1000 + rusage.ru_utime.tv_usec/1000;
+#else					/* HighResTime */
+   start_infer = millisec();
+#endif					/* HighResTime */
+
+   typealloc = 1;		/* note allocation in this phase */
+
+   trcname = getenv("TYPTRC");
+
+   if (trcname != NULL && strlen(trcname) != 0) {
+
+      if (trcname[0] == '|') {
+         FILE *popen();
+
+         trcfile = popen(trcname+1, "w");
+         }
+      else
+
+      trcfile = fopen(trcname, "w");
+
+      if (trcfile == NULL) {
+         fprintf(stderr, "TYPTRC: cannot open %s\n", trcname);
+         fflush(stderr);
+         exit(EXIT_FAILURE);
+         }
+      }
+#endif					/* TypTrc */
+
+   /*
+    * Make sure max_prm is large enough for any run-time routine.
+    */
+   for (i = 0; i < IHSize; ++i)
+      for (ip = bhash[i]; ip != NULL; ip = ip->blink)
+         if (ip->nargs > max_prm)
+           max_prm = ip->nargs;
+   for (i = 0; i < IHSize; ++i)
+      for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+         if (ip->nargs > max_prm)
+           max_prm = ip->nargs;
+
+   /*
+    * Allocate an arrays to map data base type codes and component codes 
+    *  to type inferencing information.
+    */
+   type_array = (struct typ_info *)alloc((unsigned int)(num_typs *
+      sizeof(struct typ_info)));
+   compnt_array = (struct compnt_info *)alloc((unsigned int)(num_cmpnts *
+      sizeof(struct compnt_info)));
+
+   /*
+    * Find those types that support the "new" abstract type computation
+    *  assign to them locations in the arrays of allocated types associated
+    *  with operation invocations. Also initialize the number of type bits.
+    *  Types with no subtypes have one bit. Types allocated with the the "new"
+    *  abstract have a default sub-type that is allocated here. Procedures
+    *  have a subtype to for string invocable operators. Co-expressions
+    *  have a subtype for &main. Records are handled below.
+    */
+   num_new = 0;
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].support_new)
+         type_array[i].new_indx = num_new++;
+      type_array[i].num_bits = 1;   /* reserve one type bit */
+      }
+   type_array[list_typ].num_bits = 2;  /* default & list for arg to main() */
+
+   cur_coexp = NewStruct(t_coexpr);
+   cur_coexp->n = NULL;
+   cur_coexp->next = NULL;
+   coexp_lst = cur_coexp;
+
+   if (do_typinfer) {
+      /*
+       * Go through the  syntax tree for each procedure locating program
+       *  points that may create structures at run time. Allocate the
+       *  appropriate structure type(s) to each such point.
+       */
+      for (p = proc_lst; p != NULL; p = p->next) {
+         if (p->nargs < 0)
+            p->arg_lst = type_array[list_typ].num_bits++; /* list for varargs */
+         find_new(Tree1(p->tree));  /* initial clause */
+         find_new(Tree2(p->tree));  /* body of procedure */
+         }
+      }
+
+   /*
+    * Allocate a type number for each record type (use record number for
+    *  offset) and a variable type number for each field.
+    */
+   n_fld = 0;
+   if (rec_lst == NULL) {
+      type_array[rec_typ].num_bits = 0;
+      rec_map = NULL;
+      }
+   else {
+      type_array[rec_typ].num_bits = rec_lst->rec_num + 1;
+      rec_map = (struct rentry **)alloc(
+         (unsigned int)((rec_lst->rec_num + 1)*sizeof(struct rentry *)));
+      for (rec = rec_lst; rec != NULL; rec = rec->next) {
+         rec->frst_fld = n_fld;
+         n_fld += rec->nfields;
+         rec_map[rec->rec_num] = rec;
+         }
+      }
+
+   /*
+    * Allocate type numbers to global variables. Don't count those procedure
+    *  variables that are no longer referenced in the syntax tree. Do count
+    *  static variables. Also allocate types to procedures, built-in functions,
+    *  record constructors.
+    */
+   n_gbl = 0; 
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (flag & F_SmplInv)
+            gptr->index = -1;   /* unused: set to something not a valid type */
+         else {
+            gptr->index = n_gbl++;
+            if (flag & (F_Proc | F_Record | F_Builtin))
+               gptr->init_type = type_array[proc_typ].num_bits++;
+            }
+         if (flag & F_Proc) {
+            for (lptr = gptr->val.proc->statics; lptr != NULL;lptr = lptr->next)
+               lptr->val.index = n_gbl++;
+            }
+         }
+   n_nmgbl = n_gbl;
+
+   /*
+    * Determine relative bit numbers for predefined variable types that
+    *  are treated as sets of global variables.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfGlbl)
+         type_array[i].frst_bit = n_gbl++; /* converted to absolute later */
+
+   proc_map = (struct gentry **)alloc(
+      (unsigned int)((type_array[proc_typ].num_bits)*sizeof(struct gentry *)));
+   proc_map[0] = NULL; /* proc type for string invocable operators */
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (!(flag & F_SmplInv) && (flag & (F_Proc | F_Record | F_Builtin)))
+            proc_map[gptr->init_type] = gptr;
+         }
+
+   /*
+    * Allocate type numbers to local variables. The same numbers are reused
+    *  in different procedures.
+    */
+   n_loc = 0;
+   for (p = proc_lst; p != NULL; p = p->next) {
+      i = Abs(p->nargs);
+      for (lptr = p->args; lptr != NULL; lptr = lptr->next)
+         lptr->val.index = --i;
+      i = Abs(p->nargs);
+      for (lptr = p->dynams; lptr != NULL; lptr = lptr->next)
+         lptr->val.index = i++;
+      n_loc = Max(n_loc, i);
+
+      /*
+       * produce a mapping from the variable types used in this procedure
+       *  to the corresponding symbol table entries.
+       */
+      if (n_gbl + n_loc == 0)
+         vartypmap = NULL;
+      else
+         vartypmap = (struct lentry **)alloc(
+            (unsigned int)((n_gbl + n_loc)*sizeof(struct lentry *)));
+      for (i = 0; i < n_gbl + n_loc; ++i)
+          vartypmap[i] = NULL; /* no entries for foreign statics */
+      p->vartypmap = vartypmap;
+      lhash = p->lhash;
+      for (i = 0; i < LHSize; ++i) {
+         for (lptr = lhash[i]; lptr != NULL; lptr = lptr->blink) {
+            switch (lptr->flag) {
+               case F_Global:
+                  gptr = lptr->val.global;
+                  if (!(gptr->flag & F_SmplInv))
+                     vartypmap[gptr->index] = lptr;
+                  break;
+               case F_Static:
+                  vartypmap[lptr->val.index] = lptr;
+                  break;
+               case F_Dynamic:
+               case F_Argument:
+                  vartypmap[n_gbl + lptr->val.index] = lptr;
+                  }
+            }
+         }
+      }
+
+   /*
+    * There is a component reference subtype for every subtype of the
+    *  associated aggregate type.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      compnt_array[i].num_bits = type_array[typecompnt[i].aggregate].num_bits;
+
+   /*
+    * Assign bits for non-variable (first-class) types.
+    */
+   nxt_bit = 0;
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfNone) {
+         type_array[i].frst_bit = nxt_bit;
+         nxt_bit += type_array[i].num_bits;
+         }
+
+   n_icntyp = nxt_bit; /* number of first-class types */
+
+   /*
+    * Load some commonly needed bit numbers into global variable.
+    */
+   null_bit = type_array[null_typ].frst_bit;
+   str_bit = type_array[str_typ].frst_bit;
+   cset_bit = type_array[cset_typ].frst_bit;
+   int_bit = type_array[int_typ].frst_bit;
+   real_bit = type_array[real_typ].frst_bit;
+
+   /*
+    * Assign bits for predefined variable types that are not treated as
+    *   sets of globals.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfCnst || icontypes[i].deref == DrfSpcl) {
+         type_array[i].frst_bit = nxt_bit;
+         nxt_bit += type_array[i].num_bits;
+         }
+
+   /*
+    * Assign bits to aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      if (typecompnt[i].var) {
+         compnt_array[i].frst_bit = nxt_bit;
+         nxt_bit += compnt_array[i].num_bits;
+         }
+
+   /*
+    * Assign bits to record fields and named variables.
+    */
+   frst_fld = nxt_bit;
+   nxt_bit += n_fld;
+   frst_gbl = nxt_bit;
+   nxt_bit += n_gbl;
+   frst_loc = nxt_bit;
+   nxt_bit += n_loc;
+
+   /*
+    * Convert from relative to ablsolute bit numbers for predefined variable
+    *  types that are treated as sets of global variables.
+    */
+   for (i = 0; i < num_typs; ++i)
+      if (icontypes[i].deref == DrfGlbl)
+         type_array[i].frst_bit += frst_gbl;
+
+   n_intrtyp = nxt_bit; /* number of types for intermediate values */
+
+   /*
+    * Assign bits to aggregate compontents that are not variables. These
+    *  are the runtime system's internal descriptor reference types.
+    */
+   for (i = 0; i < num_cmpnts; ++i)
+      if (!typecompnt[i].var) {
+         compnt_array[i].frst_bit = nxt_bit;
+         nxt_bit += compnt_array[i].num_bits;
+         }
+
+   n_rttyp = nxt_bit; /* total size of type system */
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      /*
+       * Output a summary of the type system.
+       */
+      for (i = 0; i < num_typs; ++i) {
+         fprintf(trcfile, "%s", icontypes[i].id);
+         if (strcmp(icontypes[i].id, icontypes[i].abrv) != 0)
+            fprintf(trcfile, "(%s)", icontypes[i].abrv);
+         fprintf(trcfile, " sub-types: %d\n", type_array[i].num_bits);
+         }
+      }
+#endif					/* TypTrc */
+
+   /*
+    * The division between bits for first-class types and variables types
+    *  generally occurs in the middle of a word. Set up a mask for extracting
+    *  the first-class types from this word.
+    */
+   val_mask = 0;
+   i = n_icntyp - (NumInts(n_icntyp) - 1) * IntBits;
+   while (i--)
+      val_mask = (val_mask << 1) | 1;
+
+   if (do_typinfer) {
+      /*
+       * Create stores large enough for the component references. These
+       *  are global to the entire program, rather than being propagated
+       *  from node to node in the syntax tree.
+       */
+      for (i = 0; i < num_cmpnts; ++i) {
+         if (i == str_var)
+            size = n_intrtyp;
+         else
+            size = n_icntyp;
+         compnt_array[i].store = alloc_stor(compnt_array[i].num_bits, size);
+         }
+      fld_stor = alloc_stor(n_fld, n_icntyp);
+
+      dummy_stor = get_store(0);
+
+      /*
+       * First list is arg to main: a list of strings.
+       */
+      set_typ(compnt_array[lst_elem].store->types[1], str_typ);
+      }
+
+   /*
+    * Set up a type bit vector with all bits on.
+    */
+#ifdef OptimizeType
+   any_typ = alloc_typ(n_rttyp);
+   any_typ->bits = alloc_mem_typ(DecodeSize(any_typ->packed));
+   for (i = 0; i < NumInts(n_rttyp); ++i)
+      any_typ->bits[i] = ~(unsigned int)0;
+#else					/* OptimizeType */
+   any_typ = alloc_typ(n_rttyp);
+   for (i = 0; i < NumInts(n_rttyp); ++i)
+      any_typ[i] = ~(unsigned int)0;
+#endif					/* OptimizeType */
+
+   /*
+    *  Initialize stores and return values for procedures. Also initialize
+    *   flag indicating whether the procedure can be executed.
+    */
+   call_main = NULL;
+   for (p = proc_lst; p != NULL; p = p->next) {
+      if (do_typinfer) {
+         p->iteration = 0;
+         p->ret_typ = alloc_typ(n_intrtyp);
+         p->coexprs = alloc_typ(n_icntyp);
+         p->in_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (p->ret_flag & DoesSusp)
+            p->susp_store = alloc_stor(n_gbl, n_icntyp);
+         else
+            p->susp_store = NULL;
+         for (i = Abs(p->nargs); i < n_loc; ++i)
+            set_typ(p->in_store->types[n_gbl + i], null_bit);
+         if (p->nargs < 0)
+            set_typ(p->in_store->types[n_gbl + Abs(p->nargs) - 1],
+               type_array[list_typ].frst_bit + p->arg_lst);
+         if (strcmp(p->name, "main") == 0) {
+            /*
+             * create a the initial call to main with one list argument.
+             */
+            call_main = invk_main(p);
+            call_main->type = alloc_typ(n_intrtyp);
+            Tree2(call_main)->type = alloc_typ(n_intrtyp);
+            set_typ(Tree2(call_main)->type, type_array[list_typ].frst_bit + 1);
+            call_main->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            }
+         p->out_store = alloc_stor(n_gbl, n_icntyp);
+         p->reachable = 0;
+         }
+      else
+         p->reachable = 1;
+      /*
+       * Analyze the code of the procedure to determine where to place stores
+       *  that survive iterations of type inferencing. Note, both the initial
+       *  clause and the body of the procedure are bounded.
+       */
+      findloops(Tree1(p->tree), 0, NULL);
+      findloops(Tree2(p->tree), 0, NULL);
+      }
+
+   /*
+    * If type inferencing is suppressed, we have set up very conservative
+    *   type information and will do no inferencing.
+    */
+   if (!do_typinfer)
+      return;
+
+   if (call_main == NULL)
+      return;         /* no main procedure, cannot continue */
+   if (tfatals > 0)
+      return;         /* don't do inference if there are fatal errors */
+
+   /*
+    * Construct mapping from co-expression types to information
+    *  about the co-expressions and finish initializing the information.
+    */
+   i = type_array[coexp_typ].num_bits;
+   coexp_map = (struct t_coexpr **)alloc(
+      (unsigned int)(i * sizeof(struct t_coexpr *)));
+   for (coexp = coexp_lst; coexp != NULL; coexp = coexp->next) {
+       coexp_map[--i] = coexp;
+       coexp->typ_indx = i;
+       coexp->in_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+       coexp->out_store = alloc_stor(n_gbl + n_loc, n_icntyp);
+       coexp->act_typ = alloc_typ(n_intrtyp);
+       coexp->rslt_typ = alloc_typ(n_intrtyp);
+       coexp->iteration = 0;
+       }
+
+   /*
+    * initialize globals
+    */
+   init_store = get_store(1);
+   for (i = 0; i < GHSize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->blink) {
+         flag = gptr->flag;
+         if (!(flag & F_SmplInv)) {
+            type = init_store->types[gptr->index];
+            if (flag & (F_Proc | F_Record | F_Builtin))
+               set_typ(type, type_array[proc_typ].frst_bit + gptr->init_type);
+            else
+               set_typ(type, null_bit);
+            }
+         }
+
+   /*
+    * Initialize types for predefined variable types.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      type = NULL;
+      switch (icontypes[i].deref) {
+         case DrfGlbl:
+            /*
+             * Treated as a global variable.
+             */
+            type = init_store->types[type_array[i].frst_bit - frst_gbl];
+            break;
+         case DrfCnst:
+            /*
+             * Type doesn't change so keep one copy.
+             */
+            type = alloc_typ(n_intrtyp);
+            type_array[i].typ = type;
+            break;
+         }
+      if (type != NULL) {
+          /*
+           * Determine which types are in the initial type for this variable.
+           */
+          for (j = 0; j < num_typs; ++j) {
+             if (icontypes[i].typ[j] != '.') {
+                for (k = 0; k < type_array[j].num_bits; ++k)
+                   set_typ(type, type_array[j].frst_bit + k);
+                }
+             }
+          }
+      }
+
+   f_store = get_store(1);
+
+   /*
+    * Type inferencing iterates over the program until a fixed point is
+    *  reached.
+    */
+   changed = 1L;    /* force first iteration */
+   iteration = 0;
+   if (verbose > 1)
+      fprintf(stderr, "type inferencing: ");
+
+   while (changed > 0L) {
+     changed = 0L;
+     ++iteration;
+
+#ifdef TypTrc
+     if (trcfile != NULL)
+        fprintf(trcfile, "**** iteration %d ****\n", iteration);
+#endif					/* TypTrc */
+
+     /*
+      * Start at the implicit initial call to the main procedure. Inferencing
+      *  walks the call graph from here.
+      */
+     succ_store = cpy_store(init_store);
+     fail_store = f_store;
+     infer_nd(call_main);
+
+     /*
+      * If requested, monitor the progress of inferencing.
+      */
+     switch (verbose) {
+        case 0:
+        case 1:
+           break;
+        case 2:
+           fprintf(stderr, ".");
+           break;
+        default: /* > 2 */
+           if (iteration != 1)
+              fprintf(stderr, ", ");
+           fprintf(stderr, "%ld", changed);
+        }
+     }
+
+   /*
+    * Type inferencing is finished, complete any diagnostic output.
+    */
+   if (verbose > 1)
+      fprintf(stderr, "\n");
+
+#ifdef TypTrc
+     if (trcfile != NULL) {
+
+#ifdef HighResTime
+        getrusage(RUSAGE_SELF, &rusage);
+        end_infer = rusage.ru_utime.tv_sec*1000 + rusage.ru_utime.tv_usec/1000;
+#else					/* HighResTime */
+        end_infer = millisec();
+#endif					/* HighResTime */
+        fprintf(trcfile, "\n**** inferencing time: %ld milliseconds\n", 
+           end_infer - start_infer);
+        fprintf(trcfile, "\n**** inferencing space: %ld bytes\n",typespace);
+        fclose(trcfile);
+        }
+   typealloc = 0;
+#endif					/* TypTrc */
+   }
+
+/*
+ * find_new - walk the syntax tree allocating structure types where
+ *  operations create new structures.
+ */
+static void find_new(n)
+struct node *n;
+   {
+   struct t_coexpr *coexp;
+   struct node *cases;
+   struct node *clause;
+   int nargs;
+   int i;
+
+   n->new_types = NULL;
+   switch (n->n_type) {
+      case N_Cset:
+      case N_Empty:
+      case N_Id:
+      case N_Int:
+      case N_Next:
+      case N_Real:
+      case N_Str:
+         break;
+
+      case N_Bar:
+      case N_Break:
+      case N_Field:
+      case N_Not:
+         find_new(Tree0(n));
+         break;
+
+      case N_Alt:
+      case N_Apply:
+      case N_Limit:
+      case N_Slist:
+         find_new(Tree0(n));
+         find_new(Tree1(n));
+         break;
+
+      case N_Activat:
+         find_new(Tree1(n));
+         find_new(Tree2(n));
+         break;
+
+      case N_If:
+         find_new(Tree0(n));  /* control clause */
+         find_new(Tree1(n));  /* then clause */
+         find_new(Tree2(n));  /* else clause, may be N_Empty */
+         break;
+
+      case N_Create:
+         /*
+          * Allocate a sub-type for the co-expressions created here.
+          */
+         n->new_types = (int *)alloc((unsigned int)(sizeof(int)));
+         n->new_types[0] = type_array[coexp_typ].num_bits++;
+         coexp = NewStruct(t_coexpr);
+         coexp->n = Tree0(n);
+         coexp->next = coexp_lst;
+         coexp_lst = coexp;
+         find_new(Tree0(n));
+         break;
+
+      case N_Augop:
+         abstr_new(n, Impl0(n)->in_line);  /* assignment */
+         abstr_new(n, Impl1(n)->in_line);  /* the operation */
+         find_new(Tree2(n));              /* 1st operand */
+         find_new(Tree3(n));              /* 2nd operand */
+         break;
+
+      case N_Case:
+         find_new(Tree0(n));  /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            find_new(Tree0(clause));   /* value of clause */
+            find_new(Tree1(clause));   /* body of clause */
+            }
+         if (Tree2(n) != NULL)
+            find_new(Tree2(n));  /* deflt */
+         break;
+
+      case N_Invok:
+         nargs = Val0(n);                  /* number of arguments */
+         find_new(Tree1(n));               /* thing being invoked */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_InvOp:
+         /*
+          * This is a call to an operation, this is what we must
+          *  check for "new" abstract type computation.
+          */
+         nargs = Val0(n);                    /* number of arguments */
+         abstr_new(n, Impl1(n)->in_line);     /* operation */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_InvProc:
+      case N_InvRec:
+         nargs = Val0(n);                    /* number of arguments */
+         for (i = 1; i <= nargs; ++i)
+            find_new(n->n_field[i+1].n_ptr); /* arg i */
+         break;
+
+      case N_Loop:
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+            case WHILE:
+            case UNTIL:
+               find_new(Tree1(n));   /* control clause */
+               find_new(Tree2(n));   /* do clause - may be N_Empty*/
+               break;
+
+            case REPEAT:
+               find_new(Tree1(n));   /* clause */
+               break;
+            }
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN)
+            find_new(Tree1(n));    /* value - may be N_Empty */
+         break;
+
+      case N_Scan:
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK)
+            abstr_new(n, optab[asgn_loc].binary->in_line);
+         find_new(Tree1(n));   /* subject */ 
+         find_new(Tree2(n));   /* body */
+         break;
+
+      case N_Sect:
+         abstr_new(n, Impl0(n)->in_line);     /* sectioning */
+         if (Impl1(n) != NULL)
+            abstr_new(n, Impl1(n)->in_line);  /* plus, minus, or nothing */
+         find_new(Tree2(n));                 /* 1st operand */
+         find_new(Tree3(n));                 /* 2nd operand */
+         find_new(Tree4(n));                 /* 3rd operand */
+         break;
+
+      case N_SmplAsgn:
+      case N_SmplAug:
+         find_new(Tree3(n));
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * abstr_new - find the abstract clauses in the implementation of an operation.
+ *  If they indicate that the operations creates structures, allocate a
+ *  type for the structures and associate it with the node in the syntax tree.
+ */
+static void abstr_new(n, il)
+struct node *n;
+struct il_code *il;
+   {
+   int i;
+   int num_cases, indx;
+   struct typ_info *t_info;
+
+   if (il == NULL)
+      return;
+
+   switch (il->il_type) {
+      case IL_New:
+         /*
+          * We have found a "new" construct in an abstract type computation.
+          *  Make sure an array has been created to hold the types allocated
+          *  to this call, then allocate the indicated type if one has not
+          *  already been allocated.
+          */
+         if (n->new_types == NULL) {
+            n->new_types = (int *)alloc((unsigned int)(num_new * sizeof(int)));
+            for (i = 0; i < num_new; ++i)
+               n->new_types[i] = -1;
+            }
+         t_info = &type_array[il->u[0].n];     /* index by type code */
+         if (n->new_types[t_info->new_indx] < 0) {
+             n->new_types[t_info->new_indx] = t_info->num_bits++;
+#ifdef TypTrc
+             if (trcfile != NULL)
+                fprintf(trcfile, "%s (%d,%d) %s\n", n->n_file, n->n_line,
+                   n->n_col, icontypes[il->u[0].n].id);
+#endif					/* TypTrc */
+             }
+         i = il->u[1].n;            /* num args */
+         indx = 2;
+         while (i--)
+            abstr_new(n, il->u[indx++].fld);
+         break;
+
+      case IL_If1:
+         abstr_new(n, il->u[1].fld);
+         break;
+
+      case IL_If2:
+         abstr_new(n, il->u[1].fld);
+         abstr_new(n, il->u[2].fld);
+         break;
+
+      case IL_Tcase1:
+         num_cases = il->u[1].n;
+         indx = 2;
+         for (i = 0; i < num_cases; ++i) {
+            indx += 2;                        /* skip type info */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         break;
+
+      case IL_Tcase2:
+         num_cases = il->u[1].n;
+         indx = 2;
+         for (i = 0; i < num_cases; ++i) {
+            indx += 2;                        /* skip type info */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         abstr_new(n, il->u[indx].fld);       /* default */
+         break;
+
+      case IL_Lcase:
+         num_cases = il->u[0].n;
+         indx = 1;
+         for (i = 0; i < num_cases; ++i) {
+            ++indx;		              /* skip selection num */
+            abstr_new(n, il->u[indx++].fld);  /* action */
+            }
+         abstr_new(n, il->u[indx].fld);       /* default */
+         break;
+
+      case IL_Acase:
+         abstr_new(n, il->u[2].fld);          /* C_integer action */
+         if (largeints) 
+            abstr_new(n, il->u[3].fld);       /* integer action */
+         abstr_new(n, il->u[4].fld);          /* C_double action */
+         break;
+
+      case IL_Abstr:
+      case IL_Inter:
+      case IL_Lst:
+      case IL_TpAsgn:
+      case IL_Union:
+         abstr_new(n, il->u[0].fld);
+         abstr_new(n, il->u[1].fld);
+         break;
+
+      case IL_Compnt:
+      case IL_Store:
+      case IL_VarTyp:
+         abstr_new(n, il->u[0].fld);
+         break;
+
+      case IL_Block:
+      case IL_Call:
+      case IL_Const:  /* should have been replaced by literal node */
+      case IL_Err1:
+      case IL_Err2:
+      case IL_IcnTyp:
+      case IL_Subscr:
+      case IL_Var:
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * alloc_stor - allocate a store with empty types.
+ */
+static struct store *alloc_stor(stor_sz, n_types)
+int stor_sz;
+int n_types;
+   {
+   struct store *stor;
+   int i;
+
+   /*
+    * If type inferencing is disabled, we don't actually make use of
+    *  any stores, but the initialization code asks for them anyway.
+    */
+   if (!do_typinfer)
+      return NULL;
+
+#ifdef OptimizeType
+   stor = (struct store *)alloc((unsigned int)(sizeof(struct store) +
+      ((stor_sz - 1) * sizeof(struct typinfo *))));
+   stor->next = NULL;
+   stor->perm = 1;
+   for (i = 0; i < stor_sz; ++i) {
+      stor->types[i] = (struct typinfo *)alloc_typ(n_types);
+      }
+#else					/* OptimizeType */
+   stor = (struct store *)alloc((unsigned int)(sizeof(struct store) +
+      ((stor_sz - 1) * sizeof(unsigned int *))));
+   stor->next = NULL;
+   stor->perm = 1;
+   for (i = 0; i < stor_sz; ++i) {
+      stor->types[i] = (unsigned int *)alloc_typ(n_types);
+      }
+#endif					/* OptimizeType */
+
+   return stor;
+   }
+
+/*
+ * findloops - find both explicit loops and implicit loops caused by
+ *  goal-directed evaluation. Allocate stores for them. Determine which
+ *  expressions cannot fail (used to eliminate dynamic store allocation
+ *  for some bounded expressions). Allocate stores for 'if' and 'case'
+ *  expressions that can be resumed. Initialize expression types.
+ *  The syntax tree is walked in reverse execution order looking for
+ *  failure and for generators.
+ */
+static int findloops(n, resume, rslt_type)
+struct node *n;
+int resume;
+#ifdef OptimizeType
+struct typinfo *rslt_type;
+#else					/* OptimizeType */
+unsigned int *rslt_type;
+#endif					/* OptimizeType */
+   {
+   struct loop {
+      int resume;
+      int can_fail;
+      int every_cntrl;
+#ifdef OptimizeType
+      struct typinfo *type;
+#else					/* OptimizeType */
+      unsigned int *type;
+#endif					/* OptimizeType */
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop = NULL;
+   struct node *cases;
+   struct node *clause;
+   int can_fail;
+   int nargs, i;
+
+   n->store = NULL;
+   if (!do_typinfer)
+      rslt_type = any_typ;
+
+   switch (n->n_type) {
+      case N_Activat:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+         /*
+          * Assume activation can fail.
+          */
+         can_fail = findloops(Tree2(n), 1, NULL);
+         can_fail = findloops(Tree1(n), can_fail, NULL);
+         n->symtyps = symtyps(2);
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGAT)
+            n->symtyps->next = symtyps(2);
+         break;
+
+      case N_Alt:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = findloops(Tree0(n), resume, rslt_type) |
+            findloops(Tree1(n), resume, rslt_type);
+         break;
+
+      case N_Apply:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         /* 
+          * Assume operation can suspend or fail.
+          */
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = findloops(Tree1(n), 1, NULL);
+         can_fail = findloops(Tree0(n), can_fail, NULL);
+         n->symtyps = symtyps(max_sym);
+         break;
+
+      case N_Augop:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+         can_fail = resume;
+         /*
+          * Impl0(n) is assignment.
+          */
+         if (resume && Impl0(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl0(n)->ret_flag))
+            can_fail = 1;
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         if (can_fail && Impl1(n)->ret_flag & DoesSusp && n->store == NULL)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         can_fail = findloops(Tree3(n), can_fail, NULL);  /* operand 2 */
+         can_fail = findloops(Tree2(n), can_fail, NULL);  /* operand 1 */
+         n->type = Tree2(n)->type;
+         Typ4(n) = alloc_typ(n_intrtyp);
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         n->symtyps->next = symtyps(n_arg_sym(Impl0(n)));
+         break;
+
+      case N_Bar:
+         can_fail = findloops(Tree0(n), resume, rslt_type);
+         n->type = Tree0(n)->type;
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         break;
+
+      case N_Break:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for break", NULL);
+            return 0;
+            }
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         loop_sav->can_fail |= findloops(Tree0(n), loop_sav->resume,
+            loop_sav->type);
+         cur_loop = loop_sav;
+         can_fail = 0;
+         break;
+
+      case N_Case:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+
+         /*
+          * control clause is bounded
+          */
+         can_fail = findloops(Tree0(n), 0, NULL);
+
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             * The expression being compared can be resumed.
+             */
+            findloops(Tree0(clause), 1, NULL);
+
+            /*
+             *  Body.
+             */
+            can_fail |= findloops(Tree1(clause), resume, rslt_type);
+            }
+
+         if (Tree2(n) == NULL)
+            can_fail = 1;
+         else
+            can_fail |= findloops(Tree2(n), resume, rslt_type);  /* default */
+         break;
+
+      case N_Create:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         findloops(Tree0(n), 1, NULL);                  /* co-expression code */
+        /*
+         * precompute type
+         */
+        i= type_array[coexp_typ].frst_bit;
+        if (do_typinfer)
+            i += n->new_types[0];
+         set_typ(n->type, i);
+         can_fail = resume;
+         break;
+
+      case N_Cset:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, type_array[cset_typ].frst_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Empty:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, null_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Id: {
+         struct lentry *var;
+
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         /*
+          * Precompute type
+          */
+         var = LSym0(n);
+         if (var->flag & F_Global)
+            set_typ(n->type, frst_gbl + var->val.global->index);
+         else if (var->flag & F_Static)
+            set_typ(n->type, frst_gbl + var->val.index);
+         else
+            set_typ(n->type, frst_loc + var->val.index);
+         can_fail = resume;
+         }
+         break;
+
+      case N_Field:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = findloops(Tree0(n), resume, NULL);
+         n->symtyps = symtyps(1);
+         break;
+
+      case N_If:
+         if (rslt_type == NULL)
+            rslt_type = alloc_typ(n_intrtyp);
+         n->type = rslt_type;
+
+#ifdef TypTrc
+         rslt_type = NULL;    /* don't share result loc with subexpressions*/
+#endif					/* TypTrc */
+         /*
+          * control clause is bounded
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = findloops(Tree1(n), resume, rslt_type);
+         if (Tree2(n)->n_type == N_Empty)
+            can_fail = 1;
+         else {
+            if (resume)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            can_fail |= findloops(Tree2(n), resume, rslt_type);
+            }
+         break;
+
+      case N_Int:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, int_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Invok:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                    /* number of arguments */
+         /*
+          * Assume operation can suspend and fail.
+          */
+         if (resume)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail = 1;
+         for (i = nargs; i >= 0; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         n->symtyps = symtyps(max_sym);
+         break;
+
+      case N_InvOp:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                           /* number of arguments */
+         if (resume && Impl1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         break;
+
+      case N_InvProc:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);             /* number of arguments */
+         if (resume && Proc1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (Proc1(n)->ret_flag & DoesFail)
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         break;
+
+      case N_InvRec:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         nargs = Val0(n);                               /* number of args */
+         if (err_conv)
+            can_fail = 1;
+         else
+            can_fail = resume;
+         for (i = nargs; i >= 1; --i)
+            can_fail = findloops(n->n_field[i+1].n_ptr, can_fail, NULL);
+         break;
+
+      case N_Limit:
+         findloops(Tree0(n), resume, rslt_type);
+         can_fail = findloops(Tree1(n), 1, NULL);
+         n->type = Tree0(n)->type;
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         n->symtyps = symtyps(1);
+         break;
+
+      case N_Loop: {
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         loop_info.prev = cur_loop;
+         loop_info.resume = resume;
+         loop_info.can_fail = 0;
+         loop_info.every_cntrl = 0;
+         loop_info.type = n->type;
+         cur_loop = &loop_info;
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+            case SUSPEND:
+               /*
+                * The control clause can be resumed. The body is bounded.
+                */
+               loop_info.every_cntrl = 1;
+               can_fail = findloops(Tree1(n), 1, NULL);
+               loop_info.every_cntrl = 0;
+               findloops(Tree2(n), 0, NULL);
+               break;
+
+            case REPEAT:
+               /*
+                * The loop needs a saved store. The body is bounded.
+                */
+               findloops(Tree1(n), 0, NULL);
+               can_fail = 0;
+               break;
+
+            case WHILE:
+               /*
+                * The loop needs a saved store. The control
+                *  clause and the body are each bounded.
+                */
+               can_fail = findloops(Tree1(n), 0, NULL);
+               findloops(Tree2(n), 0, NULL);
+               break;
+
+            case UNTIL:
+               /*
+                * The loop needs a saved store. The control
+                *  clause and the body are each bounded.
+                */
+               findloops(Tree1(n), 0, NULL);
+               findloops(Tree2(n), 0, NULL);
+               can_fail = 1;
+               break;
+            }
+         n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (do_typinfer && resume)
+            n->store->next = alloc_stor(n_gbl + n_loc, n_icntyp);
+         can_fail |= cur_loop->can_fail;
+         cur_loop = cur_loop->prev;
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop == NULL) {
+            nfatal(n, "invalid context for next", NULL);
+            return 1;
+            }
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = cur_loop->every_cntrl;
+         break;
+
+      case N_Not:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, null_bit); /* precompute type */
+         /*
+          * The expression is bounded.
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = 1;
+         break;
+
+      case N_Real:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, real_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      case N_Ret:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         if (Val0(Tree0(n)) == RETURN)  {
+            /*
+             * The expression is bounded.
+             */
+            findloops(Tree1(n), 0, NULL);
+            }
+         can_fail = 0;
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         n->symtyps = symtyps(1);
+         can_fail = resume;
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            asgn_impl = optab[asgn_loc].binary;
+            if (resume && asgn_impl->ret_flag & DoesSusp)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            if (MightFail(asgn_impl->ret_flag))
+               can_fail = 1;
+            n->symtyps->next = symtyps(n_arg_sym(asgn_impl));
+            }
+         can_fail = findloops(Tree2(n), can_fail, NULL);  /* body */
+         can_fail = findloops(Tree1(n), can_fail, NULL);  /* subject */ 
+         }
+         break;
+
+      case N_Sect:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         can_fail = resume;
+         /*
+          * Impl0(n) is sectioning.
+          */
+         if (resume && Impl0(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl0(n)->ret_flag))
+            can_fail = 1;
+         n->symtyps = symtyps(n_arg_sym(Impl0(n)));
+         if (Impl1(n) != NULL) {
+            /*
+             * Impl1(n) is plus or minus
+             */
+            if (can_fail && Impl1(n)->ret_flag & DoesSusp && n->store == NULL)
+               n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+            if (MightFail(Impl1(n)->ret_flag))
+               can_fail = 1;
+            n->symtyps->next = symtyps(n_arg_sym(Impl1(n)));
+            }
+         can_fail = findloops(Tree4(n), can_fail, NULL); /* operand 3 */
+         can_fail = findloops(Tree3(n), can_fail, NULL); /* operand 2 */
+         can_fail = findloops(Tree2(n), can_fail, NULL); /* operand 1 */
+         break;
+
+      case N_Slist:
+         /*
+          * 1st expression is bounded.
+          */
+         findloops(Tree0(n), 0, NULL);
+         can_fail = findloops(Tree1(n), resume, rslt_type);
+         n->type = Tree1(n)->type;
+         break;
+
+      case N_SmplAsgn:
+         can_fail = findloops(Tree3(n), resume, NULL);  /* 2nd operand */
+         findloops(Tree2(n), can_fail, rslt_type);      /* variable */
+         n->type = Tree2(n)->type;
+         break;
+
+      case N_SmplAug:
+         can_fail = resume;
+         /*
+          * Impl1(n) is the augmented operation.
+          */
+         if (resume && Impl1(n)->ret_flag & DoesSusp)
+            n->store = alloc_stor(n_gbl + n_loc, n_icntyp);
+         if (MightFail(Impl1(n)->ret_flag))
+            can_fail = 1;
+         can_fail = findloops(Tree3(n), can_fail, NULL); /* 2nd operand */
+         findloops(Tree2(n), can_fail, rslt_type);       /* variable */
+         n->symtyps = symtyps(n_arg_sym(Impl1(n)));
+         n->type = Tree2(n)->type;
+         Typ4(n) = alloc_typ(n_intrtyp);
+         break;
+
+      case N_Str:
+         if (rslt_type == NULL)
+            n->type = alloc_typ(n_intrtyp);
+         else
+            n->type = rslt_type;
+         set_typ(n->type, str_bit); /* precompute type */
+         can_fail = resume;
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   if (can_fail)
+      n->flag = CanFail;
+   else
+      n->flag = 0;
+   return can_fail;
+   }
+
+/*
+ * symtyps - determine the number of entries needed for a symbol table
+ *  that maps argument indexes to types for an operation in the
+ *  data base. Allocate the symbol table.
+ */
+static struct symtyps *symtyps(nsyms)
+int nsyms;
+   {
+   struct symtyps *tab;
+
+   if (nsyms == 0)
+      return NULL;
+
+#ifdef OptimizeType
+   tab = (struct symtyps *)alloc((unsigned int)(sizeof(struct symtyps) +
+      (nsyms - 1) * sizeof(struct typinfo *)));
+#else					/* OptimizeType */
+   tab = (struct symtyps *)alloc((unsigned int)(sizeof(struct symtyps) +
+      (nsyms - 1) * sizeof(int *)));
+#endif					/* OptimizeType */
+   tab->nsyms = nsyms;
+   tab->next = NULL;
+   while (nsyms)
+      tab->types[--nsyms] = alloc_typ(n_intrtyp);
+   return tab;
+   }
+
+/*
+ * infer_proc - perform type inference on a call to an Icon procedure.
+ */
+static void infer_prc(proc, n)
+struct pentry *proc;
+nodeptr n;
+   {
+   struct store *s_store;
+   struct store *f_store;
+   struct store *store;
+   struct pentry *sv_proc;
+   struct t_coexpr *sv_coexp;
+   struct lentry *lptr;
+   nodeptr n1;
+   int i;
+   int nparams;
+   int coexp_bit;
+
+   /*
+    * Determine what co-expressions the procedure might be called from.
+    */
+   if (cur_coexp == NULL)
+      ChkMrgTyp(n_icntyp, cur_proc->coexprs, proc->coexprs)
+   else {
+      coexp_bit = type_array[coexp_typ].frst_bit + cur_coexp->typ_indx;
+      if (!bitset(proc->coexprs, coexp_bit)) {
+         ++changed;
+         set_typ(proc->coexprs, coexp_bit);
+         }
+      }
+
+   proc->reachable = 1; /* this procedure can be called */
+
+   /*
+    * If this procedure can suspend, there may be backtracking paths
+    *  to this invocation. If so, propagate types of globals from the
+    *  backtracking paths to the suspends of the procedure and propagate
+    *  types of locals to the success store of the call.
+    */
+   if (proc->ret_flag & DoesSusp && n->store != NULL) {
+      for (i = 0; i < n_gbl; ++i)
+         ChkMrgTyp(n_icntyp, n->store->types[i], proc->susp_store->types[i])
+      for (i = 0; i < n_loc; ++i)
+         MrgTyp(n_icntyp, n->store->types[n_gbl + i], succ_store->types[n_gbl +
+            i])
+      }
+
+   /*
+    * Merge the types of global variables into the "in store" of the
+    *  procedure. Because the body of the procedure may already have
+    *  been processed for this pass, the "changed" flag must be set if
+    *  there is a change of type in the store. This will insure that
+    *  there will be another iteration in which to propagate the change
+    *  into the body.
+    */
+   store = proc->in_store;
+   for (i = 0; i < n_gbl; ++i)
+      ChkMrgTyp(n_icntyp, succ_store->types[i], store->types[i])
+
+#ifdef TypTrc
+   /*
+    * Trace the call.
+    */
+   if (trcfile != NULL)
+      fprintf(trcfile, "%s (%d,%d) %s%s(", n->n_file, n->n_line, n->n_col,
+         trc_indent, proc->name);
+#endif					/* TypTrc */
+
+   /*
+    * Get the types of the arguments, starting with the non-varargs part.
+    */
+   nparams = proc->nargs;               /* number of parameters */
+   if (nparams < 0)
+      nparams = -nparams - 1;
+   for (i = 0; i < num_args && i < nparams; ++i) {
+      typ_deref(arg_typs->types[i], store->types[n_gbl + i], 1);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         /*
+          * Trace the argument type to the call.
+          */
+         if (i > 0)
+            fprintf(trcfile, ", ");
+         prt_d_typ(trcfile, arg_typs->types[i]);
+         }
+#endif					/* TypTrc */
+
+      }
+
+   /*
+    * Get the type of the varargs part of the argument list.
+    */
+   if (proc->nargs < 0)
+      while (i < num_args) {
+         typ_deref(arg_typs->types[i],
+            compnt_array[lst_elem].store->types[proc->arg_lst], 1);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            /*
+             * Trace the argument type to the call.
+             */
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_d_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++i;
+         }
+
+   /*
+    * Missing arguments have the null type.
+    */
+   while (i < nparams) {
+      set_typ(store->types[n_gbl + i], null_bit);
+      ++i;
+      }
+
+#ifdef TypTrc
+   if (trcfile != NULL)
+      fprintf(trcfile, ")\n");
+   {
+      char *trc_ind_sav = trc_indent;
+      trc_indent = "";  /* staring a new procedure, don't indent tracing */
+#endif					/* TypTrc */
+
+   /*
+    * only perform type inference on the body of a procedure
+    *  once per iteration
+    */
+   if (proc->iteration < iteration) {
+      proc->iteration = iteration;
+      s_store = succ_store;
+      f_store = fail_store;
+      sv_proc = cur_proc;
+      succ_store = cpy_store(proc->in_store);
+      cur_proc = proc;
+      sv_coexp = cur_coexp;
+      cur_coexp = NULL;     /* we are not in a create expression */
+      /*
+       * Perform type inference on the initial clause. Static variables
+       *  are initialized to null on this path.
+       */
+      for (lptr = proc->statics; lptr != NULL; lptr = lptr->next)
+         set_typ(succ_store->types[lptr->val.index], null_bit);
+      n1 = Tree1(proc->tree);
+      if (n1->flag & CanFail) {
+         /*
+          * The initial clause can fail. Because it is bounded, we need
+          *  a new failure store that we can merge into the success store
+          *  at the end of the clause.
+          */
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(n1);
+         mrg_store(store, succ_store);
+         free_store(store);
+         }
+      else
+         infer_nd(n1);
+      /*
+       * Perform type inference on the body of procedure. Execution may
+       *  pass directly to it without executing initial clause.
+       */
+      mrg_store(proc->in_store, succ_store);
+      n1 = Tree2(proc->tree);
+      if (n1->flag & CanFail) {
+         /*
+          * The body can fail. Because it is bounded, we need a new failure
+          *  store that we can merge into the success store at the end of
+          *  the procedure.
+          */
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(n1);
+         mrg_store(store, succ_store);
+         free_store(store);
+         }
+      else
+         infer_nd(n1);
+      set_ret(NULL);  /* implicit fail */
+      free_store(succ_store);
+      succ_store = s_store;
+      fail_store = f_store;
+      cur_proc = sv_proc;
+      cur_coexp = sv_coexp;
+      }
+
+#ifdef TypTrc
+      trc_indent = trc_ind_sav;
+   }
+#endif					/* TypTrc */
+
+   /*
+    * Get updated types for global variables at the end of the call.
+    */
+   store = proc->out_store;
+   for (i = 0; i < n_gbl; ++i)
+      CpyTyp(n_icntyp, store->types[i], succ_store->types[i]);
+
+   /*
+    * If the procedure can fail, merge variable types into the failure
+    *  store.
+    */
+   if (proc->ret_flag & DoesFail)
+      mrg_store(succ_store, fail_store);
+
+   /*
+    * The return type of the procedure is the result type of the call.
+    */
+   MrgTyp(n_intrtyp, proc->ret_typ, n->type);
+   }
+
+/*
+ * cpy_store - make a copy of a store.
+ */
+static struct store *cpy_store(source)
+struct store *source;
+   {
+   struct store *dest;
+   int stor_sz;
+   int i;
+
+   if (source == NULL) 
+      dest = get_store(1);
+   else {
+      stor_sz = n_gbl + n_loc;
+      dest = get_store(0);
+      for (i = 0; i < stor_sz; ++i)
+         CpyTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   return dest;
+   }
+
+/*
+ * mrg_store - merge the source store into the destination store.
+ */
+static void mrg_store(source, dest)
+struct store *source;
+struct store *dest;
+   {
+   int i;
+
+   if (source == NULL)
+      return;
+
+   /*
+    * Is this store included in the state that must be checked for a fixed
+    *  point?
+    */
+   if (dest->perm) {
+      for (i = 0; i < n_gbl + n_loc; ++i)
+         ChkMrgTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   else {
+      for (i = 0; i < n_gbl + n_loc; ++i)
+         MrgTyp(n_icntyp, source->types[i], dest->types[i])
+      }
+   }
+
+/*
+ * set_ret - Save return type and the store for global variables.
+ */
+static void set_ret(typ)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+   {
+   int i;
+
+   /*
+    * Merge the return type into the type of the procedure, dereferencing
+    *  locals in the process.
+    */
+   if (typ != NULL)
+      deref_lcl(typ, cur_proc->ret_typ);
+
+   /*
+    * Update the types that variables may have upon exit of the procedure.
+    */
+   for (i = 0; i < n_gbl; ++i)
+      MrgTyp(n_icntyp, succ_store->types[i], cur_proc->out_store->types[i]);
+   }
+
+/*
+ * deref_lcl - dereference local variable sub-types.
+ */
+static void deref_lcl(src, dest)
+#ifdef OptimizeType
+struct typinfo *src;
+struct typinfo *dest;
+#else					/* OptimizeType */
+unsigned int *src;
+unsigned int *dest;
+#endif					/* OptimizeType */
+   {
+   int i, j;
+   int ref_gbl;
+   int frst_stv;
+   int num_stv;
+   struct store *stv_stor;
+   struct type *wktyp;
+
+   /*
+    * Make a copy of the type to be dereferenced.
+    */
+   wktyp = get_wktyp();
+   CpyTyp(n_intrtyp, src, wktyp->bits);
+
+   /*
+    * Determine which variable types must be dereferenced.  Merge the
+    *  dereferenced type into the return type and delete the variable
+    *  type. Start with simple local variables.
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(wktyp->bits, frst_loc + i)) {
+         MrgTyp(n_icntyp, succ_store->types[n_gbl + i], wktyp->bits)
+         clr_typ(wktyp->bits, frst_loc + i);
+         }
+
+   /*
+    * Check for substring trapped variables. If a sub-string trapped
+    *  variable references a local, add "string" to the return type.
+    *  If a sub-string trapped variable references a global, leave the
+    *  trapped variable in the return type.
+    * It is theoretically possible for a sub-string trapped variable type to
+    *  reference both a local and a global. When the trapped variable type
+    *  is returned to the calling procedure, the local is re-interpreted
+    *  as a local of that procedure. This is a "valid" overestimate of
+    *  of the semantics of the return. Because this is unlikely to occur
+    *  in real programs, the overestimate is of no practical consequence.
+    */
+   num_stv = type_array[stv_typ].num_bits;
+   frst_stv = type_array[stv_typ].frst_bit;
+   stv_stor = compnt_array[str_var].store;
+   for (i = 0; i < num_stv; ++i) {
+      if (bitset(wktyp->bits, frst_stv + i)) {
+         /*
+          * We have found substring trapped variable i, see whether it
+          *  references locals or globals. Globals include structure
+          *  element references.
+          */
+         for (j = 0; j < n_loc; ++j)
+            if (bitset(stv_stor->types[i], frst_loc + j)) {
+               set_typ(wktyp->bits, str_bit);
+               break;
+               }
+         ref_gbl = 0;
+         for (j = n_icntyp; j < frst_loc; ++j)
+            if (bitset(stv_stor->types[i], j)) {
+               ref_gbl = 1;
+               break;
+               }
+         /*
+          * Keep the trapped variable only if it references globals.
+          */
+         if (!ref_gbl)
+            clr_typ(wktyp->bits, frst_stv + i);
+         }
+      }
+
+   /*
+    * Merge the types into the destination.
+    */
+   MrgTyp(n_intrtyp, wktyp->bits, dest);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      prt_typ(trcfile, wktyp->bits);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+
+   free_wktyp(wktyp);
+   }
+
+/*
+ * get_store - get a store large enough to hold globals and locals.
+ */
+static struct store *get_store(clear)
+int clear;
+   {
+   struct store *store;
+   int store_sz;
+   int i;
+
+   /*
+    * Warning, stores for all procedures must be the same size. In some
+    *  situations involving sub-string trapped variables (for example
+    *  when using the "default" trapped variable) a referenced local variable
+    *  type may be interpreted in a procedure to which it does not belong.
+    *  This represents an impossible execution and type inference may
+    *  "legally" produce any results for this part of the abstract
+    *  interpretation. As long as the store is large enough to include any
+    *  such "impossible" variables, type inference will do something legal.
+    *  Note that n_loc is the maximum number of locals in any procedure,
+    *  so store_sz is large enough.
+    */
+   store_sz = n_gbl + n_loc;
+   if ((store = store_pool) == NULL) {
+     store = alloc_stor(store_sz, n_icntyp);
+     store->perm = 0;
+     }
+   else {
+      store_pool = store_pool->next;
+      /*
+       * See if the variables in the store should be initialized to the
+       *  empty type.
+       */
+      if (clear)
+         for (i = 0; i < store_sz; ++i)
+            ClrTyp(n_icntyp, store->types[i]);
+      }
+   return store;
+   }
+
+static void free_store(store)
+struct store *store;
+   {
+   store->next = store_pool;
+   store_pool = store;
+   }
+
+/*
+ * infer_nd - perform type inference on a subtree of the syntax tree.
+ */
+static void infer_nd(n)
+nodeptr n;
+   {
+   struct node *cases;
+   struct node *clause;
+   struct store *s_store;
+   struct store *f_store;
+   struct store *store;
+   struct loop {
+      struct store *succ_store;
+      struct store *fail_store;
+      struct store *next_store;
+      struct store *susp_store;
+      struct loop *prev;
+      } loop_info;
+   struct loop *loop_sav;
+   static struct loop *cur_loop;
+   struct argtyps *sav_argtyp;
+   int sav_nargs;
+   struct type *wktyp;
+   int i;
+
+   switch (n->n_type) {
+      case N_Activat:
+         infer_act(n);
+         break;
+
+      case N_Alt:
+         f_store = fail_store;
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(Tree0(n));              /* 1st alternative */
+
+         /*
+          * "Correct" type inferencing of alternation has a performance
+          *  problem. Propagating stores through nested alternation
+          *  requires as many iterations as the depth of the nesting.
+          *  This is solved by adding two edges to the flow graph. These
+          *  represent impossible execution paths but this does not
+          *  affect the soundness of type inferencing and, in "real"
+          *  programs, does not affect the preciseness of its inference.
+          *  One edge is directly from the 1st alternative to the 2nd.
+          *  The other is a backtracking edge immediately back into
+          *  the alternation from the 1st alternative.
+          */
+         mrg_store(succ_store, store); /* imaginary edge to 2nd alternative */
+
+         if (n->store != NULL) {
+            mrg_store(succ_store, n->store); /* imaginary backtracking edge */
+            mrg_store(n->store, fail_store);
+            }
+         s_store = succ_store;
+         succ_store = store;
+         fail_store = f_store;
+         infer_nd(Tree1(n));              /* 2nd alternative */
+         mrg_store(s_store, succ_store);
+         free_store(s_store);
+         if (n->store != NULL)
+            mrg_store(n->store, fail_store);
+         fail_store = n->store;
+#ifdef TypTrc
+         MrgTyp(n_intrtyp, Tree0(n)->type, n->type);
+         MrgTyp(n_intrtyp, Tree1(n)->type, n->type);
+#else					/* TypTrc */
+         /*
+          * Type is computed by sub-expressions directly into n->type.
+          */
+#endif					/* TypTrc */
+         break;
+
+      case N_Apply: {
+         struct type *lst_types;
+         int frst_lst;
+         int num_lst;
+         struct store *lstel_stor;
+
+         infer_nd(Tree0(n));          /* thing being invoked */
+         infer_nd(Tree1(n));          /* list */
+
+         frst_lst = type_array[list_typ].frst_bit;
+         num_lst = type_array[list_typ].num_bits;
+         lstel_stor = compnt_array[lst_elem].store;
+
+         /*
+          * All that is available is a "summary" of the types of the
+          *  elements of the list. Each argument to the invocation
+          *  could be any type in the summary. Set up a maximum length
+          *  argument list.
+          */
+         lst_types = get_wktyp();
+         typ_deref(Tree1(n)->type, lst_types->bits, 0);
+         wktyp = get_wktyp();
+         for (i = 0; i < num_lst; ++i)
+            if (bitset(lst_types->bits, frst_lst + i))
+               MrgTyp(n_icntyp, lstel_stor->types[i], wktyp->bits);
+         bitset(wktyp->bits, null_bit); /* arg list extension might be done */
+
+         sav_nargs = num_args;
+         sav_argtyp = arg_typs;
+         num_args = max_prm;
+         arg_typs = get_argtyp();
+         for (i = 0; i < max_prm; ++i)
+            arg_typs->types[i] = wktyp->bits;
+         gen_inv(Tree0(n)->type, n);   /* inference on general invocation */
+
+         free_wktyp(wktyp);
+         free_wktyp(lst_types);
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         }
+         break;
+
+      case N_Augop:
+         infer_nd(Tree2(n));   /* 1st operand */
+         infer_nd(Tree3(n));   /* 2nd operand */
+         /*
+          * Perform type inference on the operation.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = 2;
+         arg_typs->types[0] = Tree2(n)->type;
+         arg_typs->types[1] = Tree3(n)->type;
+         infer_impl(Impl1(n), n, n->symtyps, Typ4(n));
+         chk_succ(Impl1(n)->ret_flag, n->store);
+         /*
+          * Perform type inference on the assignment.
+          */
+         arg_typs->types[1] = Typ4(n);
+         infer_impl(Impl0(n), n, n->symtyps->next, n->type);
+         chk_succ(Impl0(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Bar:
+         /*
+          * This operation intercepts failure and has an associated
+          *  resumption store.  If backtracking reaches this operation
+          *  execution may either continue backward or proceed forward
+          *  again.
+          */ 
+         mrg_store(n->store, fail_store);
+         mrg_store(n->store, succ_store);
+         fail_store = n->store;
+         infer_nd(Tree0(n));
+         /*
+          * Type is computed by operand.
+          */
+        break;
+
+      case N_Break:
+         /*
+          * The success and failure stores for the operand of break are
+          *  those associated with the enclosing loop.
+          */
+         fail_store = cur_loop->fail_store;
+         loop_sav = cur_loop;
+         cur_loop = cur_loop->prev;
+         infer_nd(Tree0(n));
+         cur_loop = loop_sav;
+         mrg_store(succ_store, cur_loop->succ_store);
+         if (cur_loop->susp_store != NULL)
+            mrg_store(cur_loop->susp_store, fail_store);
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Result of break is empty type. Result type of expression
+          *  is computed directly into result type of loop.
+          */
+         break;
+
+      case N_Case:
+         f_store = fail_store;
+         s_store = get_store(1);
+         infer_nd(Tree0(n));     /* control clause */
+         cases = Tree1(n);
+         while (cases != NULL) {
+            if (cases->n_type == N_Ccls) {
+               clause = cases;
+               cases = NULL;
+               }
+            else {
+               clause = Tree1(cases);
+               cases = Tree0(cases);
+               }
+
+            /*
+             * Set up a failure store to capture the effects of failure
+             *  of the selection clause.
+             */
+            store = get_store(1);
+            fail_store = store;
+            infer_nd(Tree0(clause));             /* value of clause */
+
+            /*
+             * Create the effect of the possible failure of the comparison
+             *  of the selection value to the control value.
+             */
+            mrg_store(succ_store, fail_store);
+
+            /*
+             * The success and failure stores and the result of the body
+             *  of the clause are those of the whole case expression.
+             */
+            fail_store = f_store;
+            infer_nd(Tree1(clause));             /* body of clause */
+            mrg_store(succ_store, s_store);
+            free_store(succ_store);
+            succ_store = store;
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store);  /* 'case' can be resumed */
+#ifdef TypTrc
+            MrgTyp(n_intrtyp, Tree1(clause)->type, n->type);
+#else					/* TypTrc */
+            /*
+             * Type is computed by case clause directly into n->type.
+            */
+#endif					/* TypTrc */
+            }
+
+         /*
+          * Check for default clause.
+          */
+         if (Tree2(n) == NULL)
+            mrg_store(succ_store, f_store);
+         else {
+            fail_store = f_store;
+            infer_nd(Tree2(n));                  /* default */
+            mrg_store(succ_store, s_store);
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store);  /* 'case' can be resumed */
+#ifdef TypTrc
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+#else					/* TypTrc */
+            /*
+             * Type is computed by default clause directly into n->type.
+             */
+#endif					/* TypTrc */
+            }
+         free_store(succ_store);
+         succ_store = s_store;
+         if (n->store != NULL)
+            fail_store = n->store;
+         break;
+
+      case N_Create:
+         /*
+          * Record initial values of local variables for coexpression.
+          */
+         store = coexp_map[n->new_types[0]]->in_store;
+         for (i = 0; i < n_loc; ++i)
+            ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+               store->types[n_gbl + i])
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Cset:
+      case N_Empty:
+      case N_Id:
+      case N_Int:
+      case N_Real:
+      case N_Str:
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Field: {
+         struct fentry *fp;
+         struct par_rec *rp;
+         int frst_rec;
+
+         if ((fp = flookup(Str0(Tree1(n)))) == NULL) {
+            break;  /* error message printed elsewhere */
+            }
+
+         /*
+          * Determine the record types.
+          */
+         infer_nd(Tree0(n));
+         typ_deref(Tree0(n)->type, n->symtyps->types[0], 0);
+
+         /*
+          * For each record containing this field, get the tupe of
+          *  the field in that record.
+          */
+         frst_rec = type_array[rec_typ].frst_bit;
+         for (rp = fp->rlist; rp != NULL; rp = rp->next) {
+            if (bitset(n->symtyps->types[0], frst_rec + rp->rec->rec_num))
+               set_typ(n->type, frst_fld + rp->rec->frst_fld + rp->offset);
+            }
+         }
+         break;
+
+      case N_If:
+         f_store = fail_store;
+         if (Tree2(n)->n_type != N_Empty) {
+            /*
+             * If there is an else clause, we must set up a failure store
+             *  to capture the effects of failure of the control clause.
+             */
+            store = get_store(1);
+            fail_store = store;
+            }
+
+         infer_nd(Tree0(n));           /* control clause */
+
+         /*
+          * If the control clause succeeds, execution passes into the
+          *  then clause with the failure store for the entire if expression.
+          */
+         fail_store = f_store;
+         infer_nd(Tree1(n));           /* then clause */
+
+         if (Tree2(n)->n_type != N_Empty) {
+            if (n->store != NULL)
+               mrg_store(n->store, fail_store); /* 'if' expr can be resumed */
+            s_store = succ_store;
+
+            /*
+             * The entering success store of the else clause is the failure
+             *  store of the control clause. The failure store is that of
+             *  the entire if expression.
+             */
+            succ_store = store;
+            fail_store = f_store;
+            infer_nd(Tree2(n));        /* else clause */
+
+            if (n->store != NULL) {
+               mrg_store(n->store, fail_store); /* 'if' expr can be resumed */
+               fail_store = n->store;
+               }
+
+            /*
+             * Join the exiting success stores of the then and else clauses.
+             */
+            mrg_store(s_store, succ_store);
+            free_store(s_store);
+            }
+
+#ifdef TypTrc
+         MrgTyp(n_intrtyp, Tree1(n)->type, n->type);
+         if (Tree2(n)->n_type != N_Empty)
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+#else					/* TypTrc */
+         /*
+          * Type computed by 'then' and 'else' clauses directly into n->type.
+          */
+#endif					/* TypTrc */
+         break;
+
+      case N_Invok:
+         /*
+          * General invocation.
+          */
+         infer_nd(Tree1(n));          /* thing being invoked */
+
+         /*
+          * Perform type inference on all the arguments and copy the
+          *  results into the argument type array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * If this is mutual evaluation, get the type of the last argument,
+          *  otherwise do inference on general invocation.
+          */
+         if (Tree1(n)->n_type == N_Empty) {
+            MrgTyp(n_intrtyp, arg_typs->types[num_args - 1], n->type);
+            }
+         else
+            gen_inv(Tree1(n)->type, n);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvOp:
+         /*
+          * Invocation of a run-time operation. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * Perform inference on operation invocation.
+          */
+         infer_impl(Impl1(n), n, n->symtyps, n->type);
+         chk_succ(Impl1(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvProc:
+         /*
+          * Invocation of a procedure. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         /*
+          * Perform inference on the procedure invocation.
+          */
+         infer_prc(Proc1(n), n);
+         chk_succ(Proc1(n)->ret_flag, n->store);
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_InvRec:
+         /*
+          * Invocation of a record constructor. Perform inference on all
+          *  the arguments, copying the results into the argument type
+          *  array.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = Val0(n);                          /* number of arguments */
+         for (i = 0; i < num_args; ++i) {
+            infer_nd(n->n_field[i+2].n_ptr);           /* arg i */
+            arg_typs->types[i] = n->n_field[i+2].n_ptr->type;
+            }
+
+         infer_con(Rec1(n), n); /* inference on constructor invocation */
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Limit:
+         infer_nd(Tree1(n));                 /* limit */
+         typ_deref(Tree1(n)->type, n->symtyps->types[0], 0);
+         mrg_store(succ_store, fail_store);  /* limit might be 0 */
+         mrg_store(n->store, fail_store);    /* resumption may bypass expr */
+         infer_nd(Tree0(n));                 /* expression */
+         if (fail_store != NULL)
+            mrg_store(n->store, fail_store); /* expression may be resumed */
+         fail_store = n->store;
+         /*
+          * Type is computed by expression being limited.
+          */
+         break;
+
+      case N_Loop: {
+         /*
+          * Establish stores used by break and next.
+          */
+         loop_info.prev = cur_loop;
+         loop_info.succ_store = get_store(1);
+         loop_info.fail_store = fail_store;
+         loop_info.next_store = NULL;
+         loop_info.susp_store = n->store->next;
+         cur_loop = &loop_info;
+
+         switch ((int)Val0(Tree0(n))) {
+            case EVERY:
+               infer_nd(Tree1(n));              /* control clause */
+               f_store = fail_store;
+
+               /*
+                * Next in the do clause resumes the control clause as
+                *  does success of the do clause.
+                */
+               loop_info.next_store = fail_store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, f_store);
+               break;
+
+            case REPEAT:
+               /*
+                * The body of the loop can be entered by entering the
+                *  loop, by executing a next in the body, or by having
+                *  the loop succeed or fail. n->store captures all but
+                *  the first case, which is covered by the initial success
+                *  store.
+                */
+               fail_store = n->store;
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               infer_nd(Tree1(n));
+               mrg_store(succ_store, n->store);
+               break;
+
+            case SUSPEND:
+               infer_nd(Tree1(n));              /* value */
+#ifdef TypTrc
+              if (trcfile != NULL)
+                  fprintf(trcfile, "%s (%d,%d) suspend ", n->n_file, n->n_line,
+                     n->n_col);
+#endif					/* TypTrc */
+
+               set_ret(Tree1(n)->type); /* set return type of procedure */
+
+               /*
+                * Get changes to types of global variables from
+                *  resumption.
+                */
+               store = cur_proc->susp_store;
+               for (i = 0; i < n_gbl; ++i)
+                  CpyTyp(n_icntyp, store->types[i], succ_store->types[i]);
+
+               /*
+                * Next in the do clause resumes the control clause as
+                *  does success of the do clause.
+                */
+               f_store = fail_store;
+               loop_info.next_store = fail_store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, f_store);
+               break;
+
+            case WHILE:
+               /*
+                * The control clause can be entered by entering the loop,
+                *  executing a next expression, or by having the do clause
+                *  succeed or fail. n->store captures all but the first case,
+                *  which is covered by the initial success store.
+                */
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               infer_nd(Tree1(n));              /* control clause */
+               fail_store = n->store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, n->store);
+               break;
+
+            case UNTIL:
+               /*
+                * The control clause can be entered by entering the loop,
+                *  executing a next expression, or by having the do clause
+                *  succeed or fail. n->store captures all but the first case,
+                *  which is covered by the initial success store.
+                */
+               mrg_store(n->store, succ_store);
+               loop_info.next_store = n->store;
+               f_store = fail_store;
+               /*
+                * Set up a failure store to capture the effects of failure
+                *  of the control clause.
+                */
+               store = get_store(1);
+               fail_store = store;
+               infer_nd(Tree1(n));              /* control clause */
+               mrg_store(succ_store, f_store);
+               free_store(succ_store);
+               succ_store = store;
+               fail_store = n->store;
+               infer_nd(Tree2(n));              /* do clause  */
+               mrg_store(succ_store, n->store);
+               break;
+            }
+         free_store(succ_store);
+         succ_store = loop_info.succ_store;
+         if (n->store->next != NULL)
+             fail_store = n->store->next;
+         cur_loop = cur_loop->prev;
+         /*
+          * Type is computed by break expressions.
+          */
+         }
+         break;
+
+      case N_Next:
+         if (cur_loop->next_store == NULL)
+            mrg_store(succ_store, fail_store);   /* control clause of every */
+         else
+            mrg_store(succ_store, cur_loop->next_store);
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Result is empty type.
+          */
+         break;
+
+      case N_Not:
+         /*
+          * Set up a failure store to capture the effects of failure
+          *  of the negated expression, it becomes the success store
+          *  of the entire expression.
+          */
+         f_store = fail_store;
+         store = get_store(1);
+         fail_store = store;
+         infer_nd(Tree0(n));
+         mrg_store(succ_store, f_store); /* if success, then fail */
+         free_store(succ_store);
+         succ_store = store;
+         fail_store = f_store;
+         /*
+          * Type is precomputed.
+          */
+         break;
+
+      case N_Ret:
+         if (Val0(Tree0(n)) == RETURN) {
+            if (Tree1(n)->flag & CanFail) {
+               /*
+                * Set up a failure store to capture the effects of failure
+                *  of the returned expression and the corresponding procedure
+                *  failure.
+                */
+               store = get_store(1);
+               fail_store = store;
+               infer_nd(Tree1(n));    /* return value */
+               mrg_store(store, succ_store);
+               free_store(store);
+               }
+            else
+               infer_nd(Tree1(n));    /* return value */
+
+#ifdef TypTrc
+           if (trcfile != NULL)
+               fprintf(trcfile, "%s (%d,%d) return ", n->n_file, n->n_line,
+               n->n_col);
+#endif					/* TypTrc */
+
+            set_ret(Tree1(n)->type);
+            }
+         else {  /* fail */
+            set_ret(NULL);
+
+#ifdef TypTrc
+           if (trcfile != NULL) 
+               fprintf(trcfile, "%s (%d,%d) fail\n", n->n_file, n->n_line,
+               n->n_col);
+#endif					/* TypTrc */
+
+            }
+         free_store(succ_store);
+         succ_store = get_store(1);  /* empty store says: can't get past here */
+         fail_store = dummy_stor;    /* shouldn't be used */
+         /*
+          * Empty type.
+          */
+         break;
+
+      case N_Scan: {
+         struct implement *asgn_impl;
+
+         infer_nd(Tree1(n));   /* subject */ 
+         typ_deref(Tree1(n)->type, n->symtyps->types[0], 0);
+         infer_nd(Tree2(n));   /* body */
+
+         if (optab[Val0(Tree0(n))].tok.t_type == AUGQMARK) {
+            /*
+             * Perform type inference on the assignment.
+             */
+            asgn_impl = optab[asgn_loc].binary;
+            sav_argtyp = arg_typs;
+            sav_nargs = num_args;
+            arg_typs = get_argtyp();
+            num_args = 2;
+            arg_typs->types[0] = Tree1(n)->type;
+            arg_typs->types[1] = Tree2(n)->type;
+            infer_impl(asgn_impl, n, n->symtyps->next, n->type);
+            chk_succ(asgn_impl->ret_flag, n->store);
+            free_argtyp(arg_typs);
+            arg_typs = sav_argtyp;
+            num_args = sav_nargs;
+            }
+         else
+            MrgTyp(n_intrtyp, Tree2(n)->type, n->type);
+         }
+         break;
+
+      case N_Sect:
+         infer_nd(Tree2(n));     /* 1st operand */
+         infer_nd(Tree3(n));     /* 2nd operand */
+         infer_nd(Tree4(n));     /* 3rd operand */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         if (Impl1(n) != NULL) {
+            /*
+             * plus or minus.
+             */
+            num_args = 2;
+            arg_typs->types[0] = Tree3(n)->type;
+            arg_typs->types[1] = Tree4(n)->type;
+            wktyp = get_wktyp();
+            infer_impl(Impl1(n), n, n->symtyps->next, wktyp->bits);
+            chk_succ(Impl1(n)->ret_flag, n->store);
+            arg_typs->types[2] = wktyp->bits;
+            }
+         else
+            arg_typs->types[2] = Tree4(n)->type;
+         num_args = 3;
+         arg_typs->types[0] = Tree2(n)->type;
+         arg_typs->types[1] = Tree3(n)->type;
+         /*
+          * sectioning 
+          */
+         infer_impl(Impl0(n), n, n->symtyps, n->type);
+         chk_succ(Impl0(n)->ret_flag, n->store);
+         if (Impl1(n) != NULL)
+           free_wktyp(wktyp);
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+         break;
+
+      case N_Slist:
+         f_store = fail_store;
+         if (Tree0(n)->flag & CanFail) {
+            /*
+             * Set up a failure store to capture the effects of failure
+             *  of the first operand; this is merged into the
+             *  incoming success store of the second operand.
+             */
+            store = get_store(1);
+            fail_store = store;
+            infer_nd(Tree0(n));
+            mrg_store(store, succ_store);
+            free_store(store);
+            }
+         else
+            infer_nd(Tree0(n));
+         fail_store = f_store;
+         infer_nd(Tree1(n));
+         /*
+          * Type is computed by second operand.
+          */
+         break;
+
+      case N_SmplAsgn: {
+         /*
+          * Optimized assignment to a named variable.
+          */
+         struct lentry *var;
+         int indx;
+
+         infer_nd(Tree3(n));
+         var = LSym0(Tree2(n));
+         if (var->flag & F_Global)
+            indx = var->val.global->index;
+         else if (var->flag & F_Static)
+            indx = var->val.index;
+         else
+            indx = n_gbl + var->val.index;
+         ClrTyp(n_icntyp, succ_store->types[indx]);
+         typ_deref(Tree3(n)->type, succ_store->types[indx], 0);
+
+#ifdef TypTrc
+         /*
+          * Trace assignment.
+          */
+         if (trcfile != NULL) {
+            fprintf(trcfile, "%s (%d,%d) %s%s := ", n->n_file, n->n_line,
+               n->n_col, trc_indent, var->name);
+            prt_d_typ(trcfile, Tree3(n)->type);
+            fprintf(trcfile, "\n");
+            }
+#endif					/* TypTrc */
+         /*
+          * Type is precomputed.
+          */
+         }
+         break;
+
+      case N_SmplAug: {
+         /*
+          * Optimized augmented assignment to a named variable.
+          */
+         struct lentry *var;
+         int indx;
+
+         /*
+          * Perform type inference on the operation.
+          */
+         infer_nd(Tree3(n));            /* 2nd operand */
+
+         /*
+          * Set up type array for arguments of operation.
+          */
+         sav_argtyp = arg_typs;
+         sav_nargs = num_args;
+         arg_typs = get_argtyp();
+         num_args = 2;
+         arg_typs->types[0] = Tree2(n)->type;  /* type was precomputed */
+         arg_typs->types[1] = Tree3(n)->type;
+
+         /*
+          * Perform inference on the operation.
+          */
+         infer_impl(Impl1(n), n, n->symtyps, Typ4(n));
+         chk_succ(Impl1(n)->ret_flag, n->store);
+
+         /*
+          * Perform assignment to the variable.
+          */
+         var = LSym0(Tree2(n));
+         if (var->flag & F_Global)
+            indx = var->val.global->index;
+         else if (var->flag & F_Static)
+            indx = var->val.index;
+         else
+            indx = n_gbl + var->val.index;
+         ClrTyp(n_icntyp, succ_store->types[indx]);
+         typ_deref(Typ4(n), succ_store->types[indx], 0);
+
+#ifdef TypTrc
+         /*
+          * Trace assignment.
+          */
+         if (trcfile != NULL) {
+            fprintf(trcfile, "%s (%d,%d) %s%s := ", n->n_file, n->n_line,
+               n->n_col, trc_indent, var->name);
+            prt_d_typ(trcfile, Typ4(n));
+            fprintf(trcfile, "\n");
+            }
+#endif					/* TypTrc */
+
+         free_argtyp(arg_typs);
+         arg_typs = sav_argtyp;
+         num_args = sav_nargs;
+
+         /*
+          * Type is precomputed.
+          */
+         }
+         break;
+
+      default:
+         fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
+         exit(EXIT_FAILURE);
+      }
+   }
+
+/*
+ * infer_con - perform type inference for the invocation of a record
+ *  constructor.
+ */
+static void infer_con(rec, n)
+struct rentry *rec;
+nodeptr n;
+   {
+   int fld_indx;
+   int nfields;
+   int i;
+
+#ifdef TypTrc
+   if (trcfile != NULL)
+      fprintf(trcfile, "%s (%d,%d) %s%s(", n->n_file, n->n_line, n->n_col,
+         trc_indent, rec->name);
+#endif					/* TypTrc */
+
+   /*
+    * Dereference argument types into appropriate entries of field store.
+    */
+   fld_indx = rec->frst_fld;
+   nfields = rec->nfields;
+   for (i = 0; i < num_args && i < nfields; ++i) {
+      typ_deref(arg_typs->types[i], fld_stor->types[fld_indx++], 1);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         if (i > 0)
+            fprintf(trcfile, ", ");
+         prt_d_typ(trcfile, arg_typs->types[i]);
+         }
+#endif					/* TypTrc */
+
+      }
+
+   /*
+    * If there are too few arguments, add null type to appropriate entries
+    *  of field store.
+    */
+   while (i < nfields) {
+      if (!bitset(fld_stor->types[fld_indx], null_bit)) {
+         ++changed;
+         set_typ(fld_stor->types[fld_indx], null_bit);
+         }
+      ++fld_indx;
+      ++i;
+      }
+
+   /*
+    * return record type
+    */
+   set_typ(n->type, type_array[rec_typ].frst_bit + rec->rec_num);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, ")  =>>  ");
+      prt_typ(trcfile, n->type);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * infer_act - perform type inference on coexpression activation.
+ */
+static void infer_act(n)
+nodeptr n;
+   {
+   struct implement *asgn_impl;
+   struct store *s_store;
+   struct store *f_store;
+   struct store *e_store;
+   struct store *store;
+   struct t_coexpr *sv_coexp;
+   struct t_coexpr *coexp;
+   struct type *rslt_typ;
+   struct argtyps *sav_argtyp;
+   int frst_coexp;
+   int num_coexp;
+   int sav_nargs;
+   int i;
+   int j;
+
+#ifdef TypTrc
+   FILE *trc_save;
+#endif					/* TypTrc */
+
+   num_coexp = type_array[coexp_typ].num_bits;
+   frst_coexp = type_array[coexp_typ].frst_bit;
+
+   infer_nd(Tree1(n));   /* value to transmit */ 
+   infer_nd(Tree2(n));   /* coexpression */
+
+   /*
+    * Dereference the two arguments. Note that only locals in the
+    *  transmitted value are dereferenced.
+    */
+
+#ifdef TypTrc
+   trc_save = trcfile;
+   trcfile = NULL;  /* don't trace value during dereferencing */
+#endif					/* TypTrc */
+
+   deref_lcl(Tree1(n)->type, n->symtyps->types[0]);
+
+#ifdef TypTrc
+   trcfile = trc_save;
+#endif					/* TypTrc */
+
+   typ_deref(Tree2(n)->type, n->symtyps->types[1], 0);
+
+   rslt_typ = get_wktyp();
+
+   /*
+    * Set up a store for the end of the activation and propagate local
+    *  variables across the activation; the activation may succeed or
+    *  fail.
+    */
+   e_store = get_store(1);
+   for (i = 0; i < n_loc; ++i)
+      CpyTyp(n_icntyp, succ_store->types[n_gbl + i], e_store->types[n_gbl + i])
+   if (fail_store->perm) {
+      for (i = 0; i < n_loc; ++i)
+         ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+            fail_store->types[n_gbl + i])
+         }
+    else {
+      for (i = 0; i < n_loc; ++i)
+         MrgTyp(n_icntyp, succ_store->types[n_gbl + i],
+            fail_store->types[n_gbl + i])
+      }
+
+
+   /*
+    * Go through all the co-expressions that might be activated,
+    *  perform type inference on them, and transmit stores along
+    *  the execution paths induced by the activation.
+    */
+   s_store = succ_store;
+   f_store = fail_store;
+   for (j = 0; j < num_coexp; ++j) {
+      if (bitset(n->symtyps->types[1], frst_coexp + j)) {
+         coexp = coexp_map[j];
+         /*
+          * Merge the types of global variables into the "in store" of the
+          *  co-expression. Because the body of the co-expression may already
+          *  have been processed for this pass, the "changed" flag must be
+          *  set if there is a change of type in the store. This will insure
+          *  that there will be another iteration in which to propagate the
+          *  change into the body.
+          */
+         store = coexp->in_store;
+         for (i = 0; i < n_gbl; ++i)
+            ChkMrgTyp(n_icntyp, s_store->types[i], store->types[i])
+
+         ChkMrgTyp(n_intrtyp, n->symtyps->types[0], coexp->act_typ)
+
+         /*
+          * Only perform type inference on the body of a co-expression
+          *  once per iteration. The main co-expression has no body.
+          */
+         if (coexp->iteration < iteration & coexp->n != NULL) {
+            coexp->iteration = iteration;
+            succ_store = cpy_store(coexp->in_store);
+            fail_store = coexp->out_store;
+            sv_coexp = cur_coexp;
+            cur_coexp = coexp;
+            infer_nd(coexp->n);
+
+            /*
+             * Dereference the locals in the value resulting from
+             *  the execution of the co-expression body.
+             */
+
+#ifdef TypTrc
+            if (trcfile != NULL)
+               fprintf(trcfile, "%s (%d,%d) %sC%d  =>>  ", coexp->n->n_file,
+                  coexp->n->n_line, coexp->n->n_col, trc_indent, j);
+#endif					/* TypTrc */
+
+            deref_lcl(coexp->n->type, coexp->rslt_typ);
+
+            mrg_store(succ_store, coexp->out_store);
+            free_store(succ_store);
+            cur_coexp = sv_coexp;
+            }
+
+         /*
+          * Get updated types for global variables, assuming the co-expression
+          *  fails or returns by completing.
+          */
+         store = coexp->out_store;
+         for (i = 0; i < n_gbl; ++i)
+            MrgTyp(n_icntyp, store->types[i], e_store->types[i]);
+         if (f_store->perm) {
+            for (i = 0; i < n_gbl; ++i)
+               ChkMrgTyp(n_icntyp, store->types[i], f_store->types[i]);
+            }
+          else {
+            for (i = 0; i < n_gbl; ++i)
+               MrgTyp(n_icntyp, store->types[i], f_store->types[i]);
+            }
+         MrgTyp(n_intrtyp, coexp->rslt_typ, rslt_typ->bits)
+         }
+      }
+
+   /*
+    * Control may return from the activation if another co-expression
+    *  activates the current one. If we are in a create expression,
+    *  cur_coexp is the current co-expression, otherwise the current
+    *  procedure may be called within several co-expressions.
+    */
+   if (cur_coexp == NULL) {
+      for (j = 0; j < num_coexp; ++j)
+         if (bitset(cur_proc->coexprs, frst_coexp + j))
+            mrg_act(coexp_map[j], e_store, rslt_typ);
+      }
+   else
+      mrg_act(cur_coexp, e_store, rslt_typ);
+
+   free_store(s_store);
+   succ_store = e_store;
+   fail_store = f_store;
+
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) %s", n->n_file, n->n_line, n->n_col,
+         trc_indent);
+      prt_typ(trcfile, n->symtyps->types[0]);
+      fprintf(trcfile, " @ ");
+      prt_typ(trcfile, n->symtyps->types[1]);
+      fprintf(trcfile, "  =>>  ");
+      prt_typ(trcfile, rslt_typ->bits);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+
+   if (optab[Val0(Tree0(n))].tok.t_type == AUGAT) {
+      /*
+       * Perform type inference on the assignment.
+       */
+      asgn_impl = optab[asgn_loc].binary;
+      sav_argtyp = arg_typs;
+      sav_nargs = num_args;
+      arg_typs = get_argtyp();
+      num_args = 2;
+      arg_typs->types[0] = Tree1(n)->type;
+      arg_typs->types[1] = rslt_typ->bits;
+      infer_impl(asgn_impl, n, n->symtyps->next, n->type);
+      chk_succ(asgn_impl->ret_flag, n->store);
+      free_argtyp(arg_typs);
+      arg_typs = sav_argtyp;
+      num_args = sav_nargs;
+      }
+   else
+      ChkMrgTyp(n_intrtyp, rslt_typ->bits, n->type)
+
+   free_wktyp(rslt_typ);
+   }
+
+/*
+ * mrg_act - merge entry information for the co-expression to the
+ *  the ending store and result type for the activation being
+ *  analyzed.
+ */
+static void mrg_act(coexp, e_store, rslt_typ)
+struct t_coexpr *coexp;
+struct store *e_store;
+struct type *rslt_typ;
+   {
+   struct store *store;
+   int i;
+
+   store = coexp->in_store;
+   for (i = 0; i < n_gbl; ++i)
+      MrgTyp(n_icntyp, store->types[i], e_store->types[i]);
+
+   MrgTyp(n_intrtyp, coexp->act_typ, rslt_typ->bits)
+   }
+
+/*
+ * typ_deref - perform dereferencing in the abstract type realm.
+ */
+static void typ_deref(src, dest, chk)
+#ifdef OptimizeType
+struct typinfo *src;
+struct typinfo *dest;
+#else					/* OptimizeType */
+unsigned int *src;
+unsigned int *dest;
+#endif					/* OptimizeType */
+int chk;
+   {
+   struct store *tblel_stor;
+   struct store *tbldf_stor;
+   struct store *ttv_stor;
+   struct store *store;
+   unsigned int old;
+   int num_tbl;
+   int frst_tbl;
+   int num_bits;
+   int frst_bit;
+   int i;
+   int j;
+   int ret;
+/*
+   if (src->bits == NULL) {
+      src->bits = alloc_mem_typ(src->size);
+      xfer_packed_types(src);
+   }
+   if (dest->bits == NULL) {
+      dest->bits = alloc_mem_typ(dest->size);
+      xfer_packed_types(dest);
+   }
+*/
+   /*
+    * copy values to destination
+    */
+#ifdef OptimizeType
+   if ((src->bits != NULL) && (dest->bits != NULL))  {
+       for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+          old = dest->bits[i];
+          dest->bits[i] |= src->bits[i];
+          if (chk && (old != dest->bits[i]))
+             ++changed;
+       }
+       old = dest->bits[i];
+       dest->bits[i] |= src->bits[i] & val_mask;  /* mask out variables */
+       if (chk && (old != dest->bits[i]))
+          ++changed;
+    }
+    else if ((src->bits != NULL) && (dest->bits == NULL)) {
+       dest->bits = alloc_mem_typ(DecodeSize(dest->packed));
+       xfer_packed_types(dest);
+       for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+          old = dest->bits[i];
+          dest->bits[i] |= src->bits[i];
+          if (chk && (old != dest->bits[i]))
+             ++changed;
+          }
+       old = dest->bits[i];
+       dest->bits[i] |= src->bits[i] & val_mask;  /* mask out variables */
+       if (chk && (old != dest->bits[i]))
+          ++changed;
+    }  
+    else if ((src->bits == NULL) && (dest->bits != NULL))  {
+       ret = xfer_packed_to_bits(src, dest, n_icntyp);       
+       if (chk)
+          changed += ret;
+    }
+    else {
+       ret = mrg_packed_to_packed(src, dest, n_icntyp);
+       if (chk)
+          changed += ret;
+    }
+#else					/* OptimizeType */
+   for (i = 0; i < NumInts(n_icntyp) - 1; ++i) {
+      old = dest[i];
+      dest[i] |= src[i];
+      if (chk && (old != dest[i]))
+         ++changed;
+      }
+   old = dest[i];
+   dest[i] |= src[i] & val_mask;  /* mask out variables */
+   if (chk && (old != dest[i]))
+      ++changed;
+#endif					/* OptimizeType */
+
+   /* 
+    * predefined variables whose types do not change.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].deref == DrfCnst) {
+         if (bitset(src, type_array[i].frst_bit))
+            if (chk)
+               ChkMrgTyp(n_icntyp, type_array[i].typ, dest)
+            else
+               MrgTyp(n_icntyp, type_array[i].typ, dest)
+         }
+      }
+
+
+   /*
+    * substring trapped variables
+    */
+   num_bits = type_array[stv_typ].num_bits;
+   frst_bit = type_array[stv_typ].frst_bit;
+   for (i = 0; i < num_bits; ++i)
+      if (bitset(src, frst_bit + i))
+         if (!bitset(dest, str_bit)) {
+            if (chk)
+               ++changed;
+            set_typ(dest, str_bit);
+            }
+
+   /*
+    * table element trapped variables
+    */
+   num_bits = type_array[ttv_typ].num_bits;
+   frst_bit = type_array[ttv_typ].frst_bit;
+   num_tbl = type_array[tbl_typ].num_bits;
+   frst_tbl = type_array[tbl_typ].frst_bit;
+   tblel_stor = compnt_array[tbl_val].store;
+   tbldf_stor = compnt_array[tbl_dflt].store;
+   ttv_stor = compnt_array[trpd_tbl].store;
+   for (i = 0; i < num_bits; ++i)
+      if (bitset(src, frst_bit + i))
+         for (j = 0; j < num_tbl; ++j)
+             if (bitset(ttv_stor->types[i], frst_tbl + j)) {
+                if (chk) {
+                   ChkMrgTyp(n_icntyp, tblel_stor->types[j], dest)
+                   ChkMrgTyp(n_icntyp, tbldf_stor->types[j], dest)
+                   }
+                else {
+                   MrgTyp(n_icntyp, tblel_stor->types[j], dest)
+                   MrgTyp(n_icntyp, tbldf_stor->types[j], dest)
+                   }
+                }
+
+   /*
+    * Aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      if (typecompnt[i].var) {
+         frst_bit = compnt_array[i].frst_bit;
+         num_bits = compnt_array[i].num_bits;
+         store = compnt_array[i].store;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(src, frst_bit + j))
+               if (chk)
+                  ChkMrgTyp(n_icntyp, store->types[j], dest)
+               else
+                  MrgTyp(n_icntyp, store->types[j], dest)
+            }
+         }
+      }
+
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(src, frst_fld + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, fld_stor->types[i], dest)
+         else
+            MrgTyp(n_icntyp, fld_stor->types[i], dest)
+      }
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_gbl; ++i)
+      if (bitset(src, frst_gbl + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, succ_store->types[i], dest)
+         else
+            MrgTyp(n_icntyp, succ_store->types[i], dest)
+      }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(src, frst_loc + i)) {
+         if (chk)
+            ChkMrgTyp(n_icntyp, succ_store->types[n_gbl + i], dest)
+         else
+            MrgTyp(n_icntyp, succ_store->types[n_gbl + i], dest)
+      }
+}
+
+/*
+ * infer_impl - perform type inference on a call to built-in operation
+ *   using the implementation entry from the data base.
+ */
+static void infer_impl(impl, n, symtyps, rslt_typ)
+struct implement *impl;
+nodeptr n;
+struct symtyps *symtyps;
+#ifdef OptimizeType
+struct typinfo *rslt_typ;
+#else					/* OptimizeType */
+unsigned int *rslt_typ;
+#endif					/* OptimizeType */
+   {
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int flag;
+   int nparms;
+   int i;
+   int j; 
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) %s", n->n_file, n->n_line, n->n_col,
+         trc_indent);
+      if (impl->oper_typ == 'K')
+         fprintf(trcfile, "&%s", impl->name);
+      else
+         fprintf(trcfile, "%s(", impl->name);
+      }
+#endif					/* TypTrc */
+   /*
+    * Set up the "symbol table" of dereferenced and undereferenced
+    *  argument types as needed by the operation.
+    */
+   nparms = impl->nargs;
+   j = 0;
+   for (i = 0; i < num_args && i < nparms; ++i) {
+      if (impl->arg_flgs[i] & RtParm) {
+         CpyTyp(n_intrtyp, arg_typs->types[i], symtyps->types[j]);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++j;
+         }
+      if (impl->arg_flgs[i] & DrfPrm) {
+         typ_deref(arg_typs->types[i], symtyps->types[j], 0);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (impl->arg_flgs[i] & RtParm)
+               fprintf(trcfile, "->");
+            else if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_d_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         ++j;
+         }
+      }
+   if (nparms > 0) {
+      /*
+       * Check for varargs. Merge remaining arguments into the
+       *  type of the variable part of the parameter list.
+       */
+      flag = impl->arg_flgs[nparms - 1];
+      if (flag & VarPrm) {
+         n_vararg = num_args - nparms + 1;
+         if (n_vararg < 0)
+            n_vararg = 0;
+         typ = symtyps->types[j - 1];
+         while (i < num_args) {
+            if (flag & RtParm) {
+               MrgTyp(n_intrtyp, arg_typs->types[i], typ)
+
+#ifdef TypTrc
+               if (trcfile != NULL) {
+                  if (i > 0)
+                     fprintf(trcfile, ", ");
+                  prt_typ(trcfile, arg_typs->types[i]);
+                  }
+#endif					/* TypTrc */
+
+              }
+            else {
+               typ_deref(arg_typs->types[i], typ, 0);
+
+#ifdef TypTrc
+               if (trcfile != NULL) {
+                  if (i > 0)
+                     fprintf(trcfile, ", ");
+                  prt_d_typ(trcfile, arg_typs->types[i]);
+                  }
+#endif					/* TypTrc */
+
+              }
+            ++i;
+            }
+         nparms -= 1; /* Don't extend with nulls into variable part */
+         }
+      }
+   while (i < nparms) {
+      if (impl->arg_flgs[i] & RtParm)
+         set_typ(symtyps->types[j++], null_bit); /* Extend args with nulls */
+      if (impl->arg_flgs[i] & DrfPrm)
+         set_typ(symtyps->types[j++], null_bit); /* Extend args with nulls */
+      ++i;
+      }
+
+   /*
+    * If this operation can suspend, there may be backtracking paths
+    *  to this invocation. Merge type information from those paths
+    *  into the current store.
+    */
+   if (impl->ret_flag & DoesSusp)
+      mrg_store(n->store, succ_store);
+
+   cur_symtyps = symtyps;
+   cur_rslt.bits = rslt_typ;
+   cur_rslt.size = n_intrtyp;
+   cur_new = n->new_types;
+   infer_il(impl->in_line); /* perform inference on operation */
+
+   if (MightFail(impl->ret_flag))
+      mrg_store(succ_store, fail_store);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      if (impl->oper_typ != 'K')
+         fprintf(trcfile, ")");
+      fprintf(trcfile, "  =>>  ");
+      prt_typ(trcfile, rslt_typ);
+      fprintf(trcfile, "\n");
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * chk_succ - check to see if the operation can succeed. In particular,
+ *   see if it can suspend. Change the succ_store and failure store
+ *   appropriately.
+ */
+static void chk_succ(ret_flag, susp_stor)
+int ret_flag;
+struct store *susp_stor;
+   {
+   if (ret_flag & DoesSusp) {
+       if (susp_stor != NULL && (ret_flag & DoesRet))
+          mrg_store(susp_stor, fail_store); /* "pass along" failure */
+       fail_store = susp_stor;
+       }
+   else if (!(ret_flag & DoesRet)) {
+      free_store(succ_store);
+      succ_store = get_store(1);
+      fail_store = dummy_stor;    /* shouldn't be used */
+      }
+   }
+
+/*
+ * infer_il - perform type inference on a piece of code within built-in
+ *   operation and determine whether execution can get past it.
+ */
+static int infer_il(il)
+struct il_code *il;
+   {
+   struct il_code *il1;
+   int condition;
+   int case_fnd;
+   int ncases;
+   int may_fallthru;
+   int indx;
+   int i;
+
+   if (il == NULL)
+      return 1;
+
+   switch (il->il_type) {
+      case IL_Const:  /* should have been replaced by literal node */
+         return 0;
+
+      case IL_If1:
+         condition = eval_cond(il->u[0].fld);
+         may_fallthru = (condition & MaybeFalse);
+         if (condition & MaybeTrue)
+            may_fallthru |= infer_il(il->u[1].fld);
+         return may_fallthru;
+
+      case IL_If2:
+         condition = eval_cond(il->u[0].fld);
+         may_fallthru = 0;
+         if (condition & MaybeTrue)
+            may_fallthru |= infer_il(il->u[1].fld);
+         if (condition & MaybeFalse)
+            may_fallthru |= infer_il(il->u[2].fld);
+         return may_fallthru;
+
+      case IL_Tcase1:
+         type_case(il, infer_il, NULL);
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Tcase2:
+         indx = type_case(il, infer_il, NULL);
+         if (indx != -1)
+            infer_il(il->u[indx].fld);         /* default */
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Lcase:
+         ncases = il->u[0].n;
+         indx = 1;
+         case_fnd = 0;
+         for (i = 0; i < ncases && !case_fnd; ++i) {
+            if (il->u[indx++].n == n_vararg) {   /* selection number */
+               infer_il(il->u[indx].fld);        /* action */
+               case_fnd = 1;
+               }
+            ++indx;
+            }
+         if (!case_fnd)
+            infer_il(il->u[indx].fld);        /* default */
+         return 1;      /* no point in trying very hard here */
+
+      case IL_Acase: {
+         int maybe_int;
+         int maybe_dbl;
+
+         eval_arith((int)il->u[0].fld->u[0].n, (int)il->u[1].fld->u[0].n,
+             &maybe_int, &maybe_dbl);
+         if (maybe_int) {
+            infer_il(il->u[2].fld);          /* C_integer action */
+            if (largeints) 
+               infer_il(il->u[3].fld);       /* integer action */
+            }
+         if (maybe_dbl)
+            infer_il(il->u[4].fld);          /* C_double action */
+         return 1;      /* no point in trying very hard here */
+         }
+
+      case IL_Err1:
+      case IL_Err2:
+         return 0;
+
+      case IL_Block:
+         return il->u[0].n;
+
+      case IL_Call:
+         return ((il->u[3].n & DoesFThru) != 0);
+
+      case IL_Lst:
+         if (infer_il(il->u[0].fld))
+             return infer_il(il->u[1].fld);
+         else
+             return 0;
+
+      case IL_Abstr:
+         /*
+          * Handle side effects.
+          */
+         il1 = il->u[0].fld;
+         if (il1 != NULL) {
+             while (il1->il_type == IL_Lst) {
+                side_effect(il1->u[1].fld);
+                il1 = il1->u[0].fld;
+                }
+             side_effect(il1);
+             }
+
+         /*
+          * Set return type.
+          */
+         abstr_typ(il->u[1].fld, &cur_rslt);
+         return 1;
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * side_effect - perform a side effect from an abstract clause of a
+ *  built-in operation.
+ */
+static void side_effect(il)
+struct il_code *il;
+   {
+   struct type *var_typ;
+   struct type *val_typ;
+   struct store *store;
+   int num_bits;
+   int frst_bit;
+   int i, j;
+
+   /*
+    * il is IL_TpAsgn, get the variable type and value type, and perform
+    *  the side effect.
+    */
+   var_typ = get_wktyp();
+   val_typ = get_wktyp();
+   abstr_typ(il->u[0].fld, var_typ);    /* variable type */
+   abstr_typ(il->u[1].fld, val_typ);    /* value type */
+
+   /*
+    * Determine which types that can be assigned to are in the variable
+    *  type.
+    *
+    * Aggregate compontents.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      frst_bit = compnt_array[i].frst_bit;
+      num_bits = compnt_array[i].num_bits;
+      store = compnt_array[i].store;
+      for (j = 0; j < num_bits; ++j) {
+         if (bitset(var_typ->bits, frst_bit + j))
+            ChkMrgTyp(n_icntyp, val_typ->bits, store->types[j])
+         }
+      }
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(var_typ->bits, frst_fld + i))
+         ChkMrgTyp(n_icntyp, val_typ->bits, fld_stor->types[i]);
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_gbl; ++i)
+      if (bitset(var_typ->bits, frst_gbl + i))
+          MrgTyp(n_icntyp, val_typ->bits, succ_store->types[i]);
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(var_typ->bits, frst_loc + i))
+          MrgTyp(n_icntyp, val_typ->bits, succ_store->types[n_gbl + i]);
+
+
+   free_wktyp(var_typ);
+   free_wktyp(val_typ);
+   }
+
+/*
+ * abstr_typ - compute the type bits corresponding to an abstract type
+ *  from an abstract clause of a built-in operation.
+ */
+static void abstr_typ(il, typ)
+struct il_code *il;
+struct type *typ;
+   {
+   struct type *typ1;
+   struct type *typ2;
+   struct rentry *rec;
+   struct store *store;
+   struct compnt_info *compnts;
+   int num_bits;
+   int frst_bit;
+   int frst_cmpnt;
+   int num_comps;
+   int typcd;
+   int new_indx;
+   int i;
+   int j;
+   int indx;
+   int size;
+   int t_indx;
+#ifdef OptimizeType
+   struct typinfo *prmtyp;
+#else					/* OptimizeType */
+   unsigned int *prmtyp;
+#endif					/* OptimizeType */
+
+   if (il == NULL)
+       return;
+
+   switch (il->il_type) {
+      case IL_VarTyp:
+         /*
+          * type(<parameter>)
+          */
+         indx = il->u[0].fld->u[0].n; /* symbol table index of variable */
+         if (indx >= cur_symtyps->nsyms) {
+            prmtyp = any_typ;
+            size = n_rttyp;
+            }
+         else {
+            prmtyp = cur_symtyps->types[indx];
+            size = n_intrtyp;
+            }
+         if (typ->size < size)
+            size = typ->size;
+         MrgTyp(size, prmtyp, typ->bits);
+         break;
+
+      case IL_Store:
+         /*
+          * store[<type>]
+          */
+         typ1 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1); /* type to be "dereferenced" */
+
+         /*
+          * Dereference types that are Icon varaibles.
+          */
+         typ_deref(typ1->bits, typ->bits, 0);
+
+         /*
+          * "Dereference" aggregate compontents that are not Icon variables.
+          */
+         for (i = 0; i < num_cmpnts; ++i) {
+            if (!typecompnt[i].var) {
+               if (i == stv_typ) {
+                  /*
+                   * Substring trapped variable stores contain variable
+                   *  references, so the types are larger, but we cannot
+                   *  copy more than the destination holds.
+                   */
+                  size = n_intrtyp;
+                  if (typ->size < size)
+                    size = typ->size;
+                  }
+               else
+                  size = n_icntyp;
+               frst_bit = compnt_array[i].frst_bit;
+               num_bits = compnt_array[i].num_bits;
+               store = compnt_array[i].store;
+               for (j = 0; j < num_bits; ++j) {
+                  if (bitset(typ1->bits, frst_bit + j))
+                     MrgTyp(size, store->types[j], typ->bits);
+                  }
+               }
+            }
+
+         free_wktyp(typ1);
+         break;
+
+      case IL_Compnt:
+         /*
+          * <type>.<component>
+          */
+         typ1 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1); /* type */
+         i = il->u[1].n;
+         if (i == CM_Fields) {
+            /*
+             * The all_fields component must be handled differently
+             *  from the others.
+             */
+            frst_bit = type_array[rec_typ].frst_bit;
+            num_bits = type_array[rec_typ].num_bits;
+            for (i = 0; i < num_bits; ++i)
+               if (bitset(typ1->bits, frst_bit + i)) {
+                  rec = rec_map[i];
+                  for (j = 0; j < rec->nfields; ++j)
+                     set_typ(typ->bits, frst_fld + rec->frst_fld + j);
+                  }
+            }
+         else {
+            /*
+             * Use component information arrays to transform type bits to
+             *  the corresponding component bits.
+             */
+            frst_bit = type_array[typecompnt[i].aggregate].frst_bit;
+            num_bits = type_array[typecompnt[i].aggregate].num_bits;
+            frst_cmpnt = compnt_array[i].frst_bit;
+            if (!typecompnt[i].var && typ->size < n_rttyp)
+               break;   /* bad abstract type computation */ 
+            for (i = 0; i < num_bits; ++i)
+               if (bitset(typ1->bits, frst_bit + i))
+                  set_typ(typ->bits, frst_cmpnt + i);
+            free_wktyp(typ1);
+            }
+         break;
+
+      case IL_Union:
+         /*
+          * <type 1> ++ <type 2>
+          */
+         abstr_typ(il->u[0].fld, typ);
+         abstr_typ(il->u[1].fld, typ);
+         break;
+
+      case IL_Inter:
+         /*
+          * <type 1> ** <type 2>
+          */
+         typ1 = get_wktyp();
+         typ2 = get_wktyp();
+         abstr_typ(il->u[0].fld, typ1);
+         abstr_typ(il->u[1].fld, typ2);
+         size = n_rttyp;
+#ifdef OptimizeType
+         and_bits_to_packed(typ2->bits, typ1->bits, size);
+#else					/* OptimizeType */
+         for (i = 0; i < NumInts(size); ++i)
+            typ1->bits[i] &= typ2->bits[i];
+#endif					/* OptimizeType */
+         if (typ->size < size)
+            size = typ->size;
+         MrgTyp(size, typ1->bits, typ->bits);
+         free_wktyp(typ1);
+         free_wktyp(typ2);
+         break;
+
+      case IL_New:
+         /*
+          * new <type-name>(<type 1> , ...)
+          *
+          * If a type was not allocated for this node, use the default
+          *   one.
+          */
+         typ1 = get_wktyp();
+         typcd = il->u[0].n;      /* type code */
+         new_indx = type_array[typcd].new_indx;
+         t_indx = 0;                     /* default is first index of type */
+         if (cur_new != NULL && cur_new[new_indx] > 0)
+            t_indx = cur_new[new_indx];
+
+         /*
+          * This RTL expression evaluates to the "new" sub-type.
+          */
+         set_typ(typ->bits, type_array[typcd].frst_bit + t_indx);
+
+         /*
+          * Update stores for components based on argument types in the
+          *  "new" expression.
+          */
+         num_comps = icontypes[typcd].num_comps;
+         j = icontypes[typcd].compnts;
+         compnts = &compnt_array[j];
+         if (typcd == stv_typ) {
+            size = n_intrtyp;
+            }
+         else
+            size = n_icntyp;
+         for (i = 0; i < num_comps; ++i) {
+            ClrTyp(n_rttyp, typ1->bits);
+            abstr_typ(il->u[2 + i].fld, typ1);
+            ChkMrgTyp(size, typ1->bits, compnts[i].store->types[t_indx]);
+            }
+
+         free_wktyp(typ1);
+         break;
+
+      case IL_IcnTyp:
+         typcd_bits((int)il->u[0].n, typ);      /* type code */
+         break;
+      }
+   }
+
+/*
+ * eval_cond - evaluate the condition of in 'if' statement from a
+ *  built-in operation. The result can be both true and false because
+ *  of uncertainty and because more than one execution path may be
+ *  involved.
+ */
+static int eval_cond(il)
+struct il_code *il;
+   {
+   int cond1;
+   int cond2;
+
+   switch (il->il_type) {
+      case IL_Bang:
+         cond1 = eval_cond(il->u[0].fld);
+         cond2 = 0;
+         if (cond1 & MaybeTrue)
+            cond2 = MaybeFalse;
+         if (cond1 & MaybeFalse)
+            cond2 |= MaybeTrue;
+         return cond2;
+
+      case IL_And:
+         cond1 = eval_cond(il->u[0].fld);
+         cond2 = eval_cond(il->u[1].fld);
+         return (cond1 & cond2 & MaybeTrue) | ((cond1 | cond2) & MaybeFalse);
+
+      case IL_Cnv1:
+      case IL_Cnv2:
+         return eval_cnv((int)il->u[0].n, (int)il->u[1].fld->u[0].n,
+            0, NULL);
+
+      case IL_Def1:
+      case IL_Def2:
+         return eval_cnv((int)il->u[0].n, (int)il->u[1].fld->u[0].n,
+            1, NULL);
+
+      case IL_Is:
+         return eval_is((int)il->u[0].n, il->u[1].fld->u[0].n);
+
+      default:
+         fprintf(stderr, "compiler error: unknown info in data base\n");
+         exit(EXIT_FAILURE);
+         /* NOTREACHED */
+      }
+   }
+
+/*
+ * eval_cnv - evaluate the conversion of a variable to a specific type
+ *  to see if it may succeed or fail.
+ */
+int eval_cnv(typcd, indx, def, cnv_flags)
+int typcd;       /* type to convert to */
+int indx;        /* index into symbol table of variable */
+int def;         /* flag: conversion has a default value */
+int *cnv_flags;  /* return flag for detailed conversion information */
+   {
+   struct type *may_succeed;  /* types where conversion sometimes succeed */
+   struct type *must_succeed; /* types where conversion always succeeds */
+   struct type *must_cnv;     /* types where actual conversion is performed */
+   struct type *as_is;        /* types where value already has correct type */
+#ifdef OptimizeType
+   struct typinfo *typ;         /* possible types of the variable */
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int cond;
+   int i;
+#ifdef OptimizeType
+   unsigned int val1, val2;
+#endif					/* OptimizeType */
+
+   /*
+    * Conversions may succeed for strings, integers, csets, and reals.
+    *  Conversions may fail for any other types. In addition,
+    *  conversions to integer or real may fail for specific values.
+    */
+   if (indx >= cur_symtyps->nsyms)
+      return MaybeTrue | MaybeFalse;
+   typ = cur_symtyps->types[indx];
+
+   may_succeed = get_wktyp();
+   must_succeed = get_wktyp();
+   must_cnv = get_wktyp();
+   as_is = get_wktyp();
+
+   if (typcd == cset_typ || typcd == TypTCset) {
+      set_typ(as_is->bits, cset_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == str_typ || typcd == TypTStr) {
+      set_typ(as_is->bits, str_bit);
+
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == TypCStr) {
+      /*
+       * as_is is empty.
+       */
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, str_bit);
+      set_typ(must_succeed->bits, cset_bit);
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == real_typ) {
+      set_typ(as_is->bits, real_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == TypCDbl) {
+      /*
+       * as_is is empty.
+       */
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, int_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      set_typ(must_succeed->bits, real_bit);
+      }
+   else if (typcd == int_typ) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypCInt) {
+      /*
+       * Note that conversion from an integer to a C integer can be
+       *  done by changing the way the descriptor is accessed. It
+       *  is not considered a real conversion. Conversion may fail
+       *  even for integers if large integers are supported.
+       */
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+      set_typ(must_cnv->bits, real_bit);
+
+      if (!largeints)
+         set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypEInt) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+
+      set_typ(must_succeed->bits, int_bit);
+      }
+   else if (typcd == TypECInt) {
+      set_typ(as_is->bits, int_bit);
+
+      set_typ(must_cnv->bits, str_bit);
+      set_typ(must_cnv->bits, cset_bit);
+
+      if (!largeints)
+         set_typ(must_succeed->bits, int_bit);
+      }
+
+   MrgTyp(n_icntyp, as_is->bits, may_succeed->bits);
+   MrgTyp(n_icntyp, must_cnv->bits, may_succeed->bits);
+   if (def) {
+      set_typ(may_succeed->bits, null_bit);
+      set_typ(must_succeed->bits, null_bit);
+      }
+
+   /*
+    * Determine if the conversion expression may evaluate to true or false.
+    */
+   cond = 0;
+
+/*
+   if (typ->bits == NULL) {
+      typ->bits = alloc_mem_typ(typ->size);
+      xfer_packed_types(typ);
+   }
+   if (may_succeed->bits->bits == NULL) {
+      may_succeed->bits->bits = alloc_mem_typ(may_succeed->bits->size);
+      xfer_packed_types(may_succeed->bits);
+   }
+   if (must_succeed->bits->bits == NULL) {
+      must_succeed->bits->bits = alloc_mem_typ(must_succeed->bits->size);
+      xfer_packed_types(must_succeed->bits);
+   }
+*/
+   for (i = 0; i < NumInts(n_intrtyp); ++i) {
+#ifdef OptimizeType
+      if ((typ->bits != NULL) && (may_succeed->bits->bits != NULL))  {
+         if (typ->bits[i] & may_succeed->bits->bits[i]) 
+            cond = MaybeTrue;
+      }
+      else if ((typ->bits == NULL) && (may_succeed->bits->bits != NULL)) {
+         val1 = get_bit_vector(typ, i);
+         if (val1 & may_succeed->bits->bits[i])
+            cond = MaybeTrue;
+      }
+      else if ((typ->bits != NULL) && (may_succeed->bits->bits == NULL)) {
+         val2 = get_bit_vector(may_succeed->bits, i);
+         if (typ->bits[i] & val2)
+            cond = MaybeTrue;
+      }
+      else {
+         val1 = get_bit_vector(typ, i);
+         val2 = get_bit_vector(may_succeed->bits, i);
+         if (val1 & val2)
+            cond = MaybeTrue;
+      }
+      if ((typ->bits != NULL) && (must_succeed->bits->bits != NULL))  {
+         if (typ->bits[i] & ~must_succeed->bits->bits[i]) 
+            cond |= MaybeFalse;
+      }
+      else if ((typ->bits == NULL) && (must_succeed->bits->bits != NULL)) {
+         val1 = get_bit_vector(typ, i);
+         if (val1 & ~must_succeed->bits->bits[i])
+            cond |= MaybeFalse;
+      }
+      else if ((typ->bits != NULL) && (must_succeed->bits->bits == NULL)) {
+         val2 = get_bit_vector(must_succeed->bits, i);
+         if (typ->bits[i] & ~val2) 
+            cond |= MaybeFalse;       
+      }
+      else { 
+         val1 = get_bit_vector(typ, i);
+         val2 = get_bit_vector(must_succeed->bits, i);
+         if (val1 & ~val2) 
+            cond |= MaybeFalse;       
+      }
+#else					/* OptimizeType */
+      if (typ[i] & may_succeed->bits[i])
+         cond = MaybeTrue;
+      if (typ[i] & ~must_succeed->bits[i])
+         cond |= MaybeFalse;
+#endif					/* OptimizeType */
+   }
+
+   /*
+    * See if more detailed information about the conversion is needed.
+    */
+   if (cnv_flags != NULL) {
+      *cnv_flags = 0;
+/*
+      if (as_is->bits == NULL) {
+         as_is->bits->bits = alloc_mem_typ(as_is->bits->size);
+         xfer_packed_types(as_is->bits);
+      }
+      if (must_cnv->bits->bits == NULL) {
+         must_cnv->bits->bits = alloc_mem_typ(must_cnv->bits->size);
+         xfer_packed_types(must_cnv->bits);
+      }
+*/
+      for (i = 0; i < NumInts(n_intrtyp); ++i) {
+#ifdef OptimizeType
+         if ((typ->bits != NULL) && (as_is->bits->bits != NULL)) {
+            if (typ->bits[i] & as_is->bits->bits[i]) 
+               *cnv_flags |= MayKeep;
+         }
+         else if ((typ->bits == NULL) && (as_is->bits->bits != NULL)) {
+            val1 = get_bit_vector(typ, i);
+            if (val1 & as_is->bits->bits[i])
+               *cnv_flags |= MayKeep;
+         }
+         else if ((typ->bits != NULL) && (as_is->bits->bits == NULL)) {
+            val2 = get_bit_vector(as_is->bits, i);
+            if (typ->bits[i] & val2)
+               *cnv_flags |= MayKeep;
+         }
+         else  {
+            val1 = get_bit_vector(typ, i);
+            val2 = get_bit_vector(as_is->bits, i);
+            if (val1 & val2)
+               *cnv_flags |= MayKeep;
+         }
+         if ((typ->bits != NULL) && (must_cnv->bits->bits != NULL))  {
+            if (typ->bits[i] & must_cnv->bits->bits[i]) 
+               *cnv_flags |= MayConvert;
+         }
+         else if ((typ->bits == NULL) && (must_cnv->bits->bits != NULL)) {
+            val1 = get_bit_vector(typ, i);
+            if (val1 & must_cnv->bits->bits[i])
+               *cnv_flags |= MayConvert;
+         }
+         else if ((typ->bits != NULL) && (must_cnv->bits->bits == NULL)) {
+            val2 = get_bit_vector(must_cnv->bits, i);
+            if (typ->bits[i] & val2)
+               *cnv_flags |= MayConvert;
+         }
+         else  {
+            val1 = get_bit_vector(typ, i);
+            val2 = get_bit_vector(must_cnv->bits, i);
+            if (val1 & val2)
+               *cnv_flags |= MayConvert;
+         }
+#else					/* OptimizeType */
+         if (typ[i] & as_is->bits[i])
+            *cnv_flags |= MayKeep;
+         if (typ[i] & must_cnv->bits[i])
+            *cnv_flags |= MayConvert;
+#endif					/* OptimizeType */
+         }
+      if (def && bitset(typ, null_bit))
+         *cnv_flags |= MayDefault;
+      }
+
+   free_wktyp(may_succeed);
+   free_wktyp(must_succeed);
+   free_wktyp(must_cnv);
+   free_wktyp(as_is);
+
+   return cond;
+   }
+
+/*
+ * eval_is - evaluate the result of an 'is' expression within a built-in
+ *  operation.
+ */
+int eval_is(typcd, indx)
+int typcd;
+int indx;
+   {
+   int cond;
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+
+   if (indx >= cur_symtyps->nsyms)
+      return MaybeTrue | MaybeFalse;
+   typ = cur_symtyps->types[indx];
+   if (has_type(typ, typcd, 0))
+      cond = MaybeTrue;
+   else
+      cond = 0;
+   if (other_type(typ, typcd))
+      cond |= MaybeFalse;
+   return cond;
+   }
+
+/*
+ * eval_arith - determine which cases of an arith_case may be taken based
+ *   on the types of its arguments.
+ */
+void eval_arith(indx1, indx2, maybe_int, maybe_dbl)
+int indx1;
+int indx2;
+int *maybe_int;
+int *maybe_dbl;
+   {
+#ifdef OptimizeType
+   struct typinfo *typ1;         /* possible types of first variable */
+   struct typinfo *typ2;         /* possible types of second variable */
+#else					/* OptimizeType */
+   unsigned int *typ1;         /* possible types of first variable */
+   unsigned int *typ2;         /* possible types of second variable */
+#endif					/* OptimizeType */
+   int int1 = 0;
+   int int2 = 0;
+   int dbl1 = 0;
+   int dbl2 = 0;
+
+   typ1 = cur_symtyps->types[indx1];
+   typ2 = cur_symtyps->types[indx2];
+
+   /*
+    * First see what might result if you do a convert to numeric on each
+    *  variable.
+    */
+   if (bitset(typ1, int_bit))
+      int1 = 1;
+   if (bitset(typ1, real_bit))
+      dbl1 = 1;
+   if (bitset(typ1, str_bit) || bitset(typ1, cset_bit)) {
+      int1 = 1;
+      dbl1 = 1;
+      }
+   if (bitset(typ2, int_bit))
+      int2 = 1;
+   if (bitset(typ2, real_bit))
+      dbl2 = 1;
+   if (bitset(typ2, str_bit) || bitset(typ2, cset_bit)) {
+      int2 = 1;
+      dbl2 = 1;
+      }
+
+   /*
+    * Use the conversion information to figure out what type of arithmetic
+    *  might be done.
+    */
+   if (int1 && int2)
+      *maybe_int = 1;
+   else
+      *maybe_int = 0;
+
+   *maybe_dbl = 0;
+   if (dbl1 && dbl2)
+      *maybe_dbl = 1;
+   else if (dbl1 && int2)
+      *maybe_dbl = 1;
+   else if (int1 && dbl2)
+      *maybe_dbl = 1;
+   }
+
+/*
+ * type_case - Determine which cases are selected in a type_case
+ *  statement. This routine is used by both type inference and
+ *  the code generator: a different fnc is passed in each case.
+ *  In addition, the code generator passes a case_anlz structure.
+ */
+int type_case(il, fnc, case_anlz)
+struct il_code *il;
+int (*fnc)();
+struct case_anlz *case_anlz;
+   {
+   int *typ_vect;
+   int i, j;
+   int num_cases;
+   int num_types;
+   int indx;
+   int sym_indx;
+   int typcd;
+   int use_dflt;
+#ifdef OptimizeType
+   struct typinfo *typ;
+#else					/* OptimizeType */
+   unsigned int *typ;
+#endif					/* OptimizeType */
+   int select;
+   struct type *wktyp;
+
+   /*
+    * Make a copy of the type of the variable the type case is
+    *  working on.
+    */
+   sym_indx = il->u[0].fld->u[0].n; /* symbol table index */
+   if (sym_indx >= cur_symtyps->nsyms)
+     typ = any_typ;  /* variable is not a parameter, don't know type */
+   else
+     typ = cur_symtyps->types[sym_indx];
+   wktyp = get_wktyp();
+   CpyTyp(n_intrtyp, typ, wktyp->bits);
+   typ = wktyp->bits;
+
+   /*
+    * Loop through all the case clauses.
+    */
+   num_cases = il->u[1].n;
+   indx = 2;
+   for (i = 0; i < num_cases; ++i) {
+      /*
+       * For each of the types selected by this clause, see if the variable's
+       *  type bit vector contains that type and delete the type from the
+       *  bit vector (so we know if we need the default when we are done).
+       */
+      num_types = il->u[indx++].n;
+      typ_vect = il->u[indx++].vect;
+      select = 0;
+      for (j = 0; j < num_types; ++j)
+         if (has_type(typ, typ_vect[j], 1)) {
+            typcd = typ_vect[j];
+            select += 1;
+            }
+
+      if (select > 0) {
+         fnc(il->u[indx].fld);       /* action */
+
+         /*
+          * If this routine was called by the code generator, we need to
+          *  return extra information.
+          */
+         if (case_anlz != NULL) {
+            ++case_anlz->n_cases;
+            if (select == 1) {
+               if (case_anlz->il_then == NULL) {
+                  case_anlz->typcd = typcd;
+                  case_anlz->il_then = il->u[indx].fld;
+                  }
+               else if (case_anlz->il_else == NULL)
+                  case_anlz->il_else = il->u[indx].fld;
+               }
+            else {
+               /*
+                * There is more than one possible type that will cause
+                *  us to select this case. It can only be used in the "else".
+                */
+               if (case_anlz->il_else == NULL)
+                  case_anlz->il_else = il->u[indx].fld;
+               else
+                  case_anlz->n_cases = 3; /* force no inlining. */
+               }
+            }
+         }
+      ++indx;
+      }
+
+   /*
+    * If there are types that have not been handled, indicate this by
+    *  returning the index of the default clause.
+    */
+   use_dflt = 0;
+   for (i = 0; i < n_intrtyp; ++i)
+      if (bitset(typ, i)) {
+         use_dflt = 1;
+         break;
+         }
+   free_wktyp(wktyp);
+   if (use_dflt)
+      return indx;
+   else
+      return -1;
+   }
+
+/*
+ * gen_inv - general invocation. The argument list is set up, perform
+ *  abstract interpretation on each possible things being invoked.
+ */
+static void gen_inv(typ, n)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+nodeptr n;
+   {
+   int ret_flag = 0;
+   struct store *s_store;
+   struct store *store;
+   struct gentry *gptr;
+   struct implement *ip;
+   struct type *prc_typ;
+   int frst_prc;
+   int num_prcs;
+   int i;
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) {\n", n->n_file, n->n_line, n->n_col);
+      trc_indent = "   ";
+      }
+#endif					/* TypTrc */
+
+   frst_prc = type_array[proc_typ].frst_bit;
+   num_prcs = type_array[proc_typ].num_bits;
+
+   /*
+    * Dereference the type of the thing being invoked.
+    */
+   prc_typ = get_wktyp();
+   typ_deref(typ, prc_typ->bits, 0);
+
+   s_store = succ_store;
+   store = get_store(1);
+
+   if (bitset(prc_typ->bits, str_bit) ||
+       bitset(prc_typ->bits, cset_bit) ||
+       bitset(prc_typ->bits, int_bit) ||
+       bitset(prc_typ->bits, real_bit)) {
+      /*
+       * Assume integer invocation; any argument may be the result type.
+       */
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         fprintf(trcfile, "%s (%d,%d) %s{i}(", n->n_file, n->n_line, n->n_col,
+            trc_indent);
+         }
+#endif					/* TypTrc */
+
+      for (i = 0; i < num_args; ++i) {
+         MrgTyp(n_intrtyp, arg_typs->types[i], n->type);
+
+#ifdef TypTrc
+         if (trcfile != NULL) {
+            if (i > 0)
+               fprintf(trcfile, ", ");
+            prt_typ(trcfile, arg_typs->types[i]);
+            }
+#endif					/* TypTrc */
+
+         }
+
+      /*
+       * Integer invocation may succeed or fail.
+       */
+      ret_flag |= DoesRet | DoesFail;
+      mrg_store(s_store, store);
+      mrg_store(s_store, fail_store);
+
+#ifdef TypTrc
+      if (trcfile != NULL) {
+         fprintf(trcfile, ")  =>>  ");
+         prt_typ(trcfile, n->type);
+         fprintf(trcfile, "\n");
+         }
+#endif					/* TypTrc */
+      }
+
+   if (bitset(prc_typ->bits, str_bit) ||
+       bitset(prc_typ->bits, cset_bit)) {
+      /*
+       * Assume string invocation; add all procedure types to the thing
+       *  being invoked.
+       */
+      for (i = 0; i < num_prcs; ++i)
+         set_typ(prc_typ->bits, frst_prc + i);
+      }
+
+   if (bitset(prc_typ->bits, frst_prc)) {
+      /*
+       * First procedure type represents all operators that are
+       *  available via string invocation. Scan the operator table
+       *  looking for those that are in the string invocation table.
+       *  Note, this is not particularly efficient or precise.
+       */
+      for (i = 0; i < IHSize; ++i)
+         for (ip = ohash[i]; ip != NULL; ip = ip->blink)
+            if (ip->iconc_flgs & InStrTbl) {
+               succ_store = cpy_store(s_store);
+               infer_impl(ip, n, n->symtyps, n->type);
+               ret_flag |= ip->ret_flag;
+               mrg_store(succ_store, store);
+               free_store(succ_store);
+               }
+      }
+
+   /*
+    * Check for procedure, built-in, and record constructor types
+    *  and perform type inference on invocations of them.
+    */
+   for (i = 1; i < num_prcs; ++i)
+      if (bitset(prc_typ->bits, frst_prc + i)) {
+         succ_store = cpy_store(s_store);
+         gptr = proc_map[i];
+         switch (gptr->flag & (F_Proc | F_Builtin | F_Record)) {
+            case F_Proc:
+               infer_prc(gptr->val.proc, n);
+               ret_flag |= gptr->val.proc->ret_flag;
+               break;
+            case F_Builtin:
+               infer_impl(gptr->val.builtin, n, n->symtyps, n->type);
+               ret_flag |= gptr->val.builtin->ret_flag;
+               break;
+            case F_Record:
+               infer_con(gptr->val.rec, n);
+               ret_flag |= DoesRet | (err_conv ? DoesFail : 0);
+               break;
+            }
+         mrg_store(succ_store, store);
+         free_store(succ_store);
+         }
+
+   /*
+    * If error conversion is supported and a non-procedure value
+    *   might be invoked, assume the invocation can fail.
+    */
+   if (err_conv && other_type(prc_typ->bits, proc_typ))
+      mrg_store(s_store, fail_store);
+
+   free_store(s_store);
+   succ_store = store;
+   chk_succ(ret_flag, n->store);
+
+   free_wktyp(prc_typ);
+
+#ifdef TypTrc
+   if (trcfile != NULL) {
+      fprintf(trcfile, "%s (%d,%d) }\n", n->n_file, n->n_line, n->n_col);
+      trc_indent = "";
+      }
+#endif					/* TypTrc */
+   }
+
+/*
+ * get_wktyp - get a dynamically allocated bit vector to use as a
+ *  work area for doing type computations.
+ */
+static struct type *get_wktyp()
+   {
+   struct type *typ;
+
+   if ((typ = type_pool) == NULL) {
+      typ = NewStruct(type);
+      typ->size = n_rttyp;
+      typ->bits = alloc_typ(n_rttyp);
+      }
+   else {
+      type_pool = type_pool->next;
+      ClrTyp(n_rttyp, typ->bits);
+      }
+   return typ;
+   }
+
+/*
+ * free_wktyp - free a dynamically allocated type bit vector.
+ */
+static void free_wktyp(typ)
+struct type *typ;
+   {
+   typ->next = type_pool;
+   type_pool = typ;
+   }
+
+#ifdef TypTrc
+
+/*
+ * ChkSep - supply a separating space if this is not the first item.
+ */
+#define ChkSep(n) (++n > 1 ? " " : "")
+
+/*
+ * prt_typ - print a type that can include variable references.
+ */
+static void prt_typ(file, typ)
+FILE *file;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+   {
+   struct gentry *gptr;
+   struct lentry *lptr;
+   char *name;
+   int i, j, k;
+   int n;
+   int frst_bit;
+   int num_bits;
+   char *abrv;
+
+   fprintf(trcfile, "{");
+   n = 0;
+   /*
+    * Go through the types and see any sub-types are present.
+    */
+   for (k = 0; k < num_typs; ++k) {
+      frst_bit = type_array[k].frst_bit;
+      num_bits = type_array[k].num_bits;
+      abrv = icontypes[k].abrv;
+      if (k == proc_typ) {
+         /*
+          * procedures, record constructors, and built-in functions.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i)) {
+               if (i == 0)
+                  fprintf(file, "%sops", ChkSep(n));
+               else {
+                  gptr = proc_map[i];
+                  switch (gptr->flag & (F_Proc | F_Builtin | F_Record)) {
+                     case F_Proc:
+                        fprintf(file, "%s%s:%s", ChkSep(n), abrv, gptr->name);
+                        break;
+                     case F_Builtin:
+                        fprintf(file, "%sfnc:%s", ChkSep(n), gptr->name);
+                        break;
+                     case F_Record:
+                        fprintf(file, "%sconstr:%s", ChkSep(n), gptr->name);
+                        break;
+                     }
+                  }
+               }
+         }
+      else if (k == rec_typ) {
+         /*
+          * records - include record name.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s:%s", ChkSep(n), abrv, rec_map[i]->name);
+         }
+      else if (icontypes[k].support_new | k == coexp_typ) {
+         /*
+          * A type with sub-types.
+          */
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s%d", ChkSep(n), abrv, i);
+         }
+      else {
+         /*
+          * A type with no subtypes.
+          */
+         if (bitset(typ, frst_bit))
+            fprintf(file, "%s%s", ChkSep(n), abrv);
+         }
+      }
+
+   for (k = 0; k < num_cmpnts; ++k) {
+      if (typecompnt[k].var) {
+         /*
+          * Structure component that is a variable.
+          */
+         frst_bit = compnt_array[k].frst_bit;
+         num_bits = compnt_array[k].num_bits;
+         abrv = typecompnt[k].abrv;
+         for (i = 0; i < num_bits; ++i)
+            if (bitset(typ, frst_bit + i))
+               fprintf(file, "%s%s%d", ChkSep(n), abrv, i);
+         }
+      }
+
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(typ, frst_fld + i))
+         fprintf(file, "%sfld%d", ChkSep(n), i);
+
+   /*
+    * global variables
+    */
+   for (i = 0; i < n_nmgbl; ++i)
+      if (bitset(typ, frst_gbl + i)) {
+         name = NULL;
+         for (j = 0; j < GHSize && name == NULL; j++)
+            for (gptr = ghash[j]; gptr != NULL && name == NULL; 
+               gptr = gptr->blink)
+                  if (gptr->index == i)
+                     name = gptr->name;
+         for (lptr = cur_proc->statics; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         /*
+          * Static variables may be returned and dereferenced in a procedure
+          *  they don't belong to.
+          */
+         if (name == NULL)
+            name = "?static?";
+         fprintf(file, "%svar:%s", ChkSep(n), name);
+         }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i)
+      if (bitset(typ, frst_loc + i)) {
+         name = NULL;
+         for (lptr = cur_proc->args; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         for (lptr = cur_proc->dynams; lptr != NULL && name == NULL;
+            lptr = lptr->next)
+               if (lptr->val.index == i)
+                  name = lptr->name;
+         /*
+          * Local variables types may appear in the wrong procedure due to
+          *  substring trapped variables and the inference of impossible
+          *  execution paths. Make sure we don't end up with a NULL name.
+          */
+         if (name == NULL)
+            name = "?";
+         fprintf(file, "%svar:%s", ChkSep(n), name);
+         }
+
+   fprintf(trcfile, "}");
+   }
+
+/*
+ * prt_d_typ - dereference a type and print it.
+ */
+static void prt_d_typ(file, typ)
+FILE *file;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+{
+   struct type *wktyp;
+
+   wktyp = get_wktyp();
+   typ_deref(typ, wktyp->bits, 0);
+   prt_typ(file, wktyp->bits);
+   free_wktyp(wktyp);
+}
+#endif					/* TypTrc */
+
+/*
+ * get_argtyp - get an array of pointers to type bit vectors for use
+ *  in constructing an argument list. The array is large enough for the
+ *  largest argument list.
+ */ 
+static struct argtyps *get_argtyp()
+   {
+   struct argtyps *argtyps;
+
+   if ((argtyps = argtyp_pool) == NULL)
+#ifdef OptimizeType
+     argtyps = (struct argtyps *)alloc((unsigned int)(sizeof(struct argtyps) +
+      ((max_prm - 1) * sizeof(struct typinfo *))));
+#else					/* OptimizeType */
+     argtyps = (struct argtyps *)alloc((unsigned int)(sizeof(struct argtyps) +
+      ((max_prm - 1) * sizeof(unsigned int *))));
+#endif					/* OptimizeType */
+   else 
+      argtyp_pool = argtyp_pool->next;
+   return argtyps;
+   }
+
+/*
+ * free_argtyp - free array of pointers to type bitvectors.
+ */
+static void free_argtyp(argtyps)
+struct argtyps *argtyps;
+   {
+   argtyps->next = argtyp_pool;
+   argtyp_pool = argtyps;
+   }
+
+/*
+ * varsubtyp - examine a type and determine what kinds of variable
+ *  subtypes it has and whether it has any non-variable subtypes.
+ *  If the type consists of a single named variable, return its symbol
+ *  table entry through the parameter "singl".
+ */
+int varsubtyp(typ, singl)
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+struct lentry **singl;
+   {
+   struct store *stv_stor;
+   int subtypes;
+   int n_types;
+   int var_indx;
+   int frst_bit;
+   int num_bits;
+   int i, j;
+
+
+   subtypes = 0;
+   n_types = 0;
+   var_indx = -1;
+
+   /*
+    * check for non-variables.
+    */
+   for (i = 0; i < n_icntyp; ++i)
+      if (bitset(typ, i)) {
+         subtypes |= HasVal;
+         ++n_types;
+         }
+
+   /* 
+    * Predefined variable types.
+    */
+   for (i = 0; i < num_typs; ++i) {
+      if (icontypes[i].deref != DrfNone) {
+         frst_bit = type_array[i].frst_bit;
+         num_bits = type_array[i].num_bits;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(typ, frst_bit + j)) {
+               if (i == stv_typ) {
+                  /*
+                   * We have found substring trapped variable j, see whether it
+                   *  references locals or globals.
+                   */
+                  if (do_typinfer) {
+                     stv_stor = compnt_array[str_var].store;
+                     subtypes |= varsubtyp(stv_stor->types[j], NULL);
+                     }
+                  else
+                     subtypes |= HasLcl | HasPrm | HasGlb;
+                  }
+               else
+                  subtypes |= HasGlb;
+               ++n_types;
+               }
+            }
+         }
+      }
+
+   /*
+    * Aggregate compontents that are variables.
+    */
+   for (i = 0; i < num_cmpnts; ++i) {
+      if (typecompnt[i].var) {
+         frst_bit = compnt_array[i].frst_bit;
+         num_bits = compnt_array[i].num_bits;
+         for (j = 0; j < num_bits; ++j) {
+            if (bitset(typ, frst_bit + j)) {
+               subtypes |= HasGlb;
+               ++n_types;
+               }
+            }
+         }
+      }
+
+   /*
+    * record fields
+    */
+   for (i = 0; i < n_fld; ++i)
+      if (bitset(typ, frst_fld + i)) {
+         subtypes |= HasGlb;
+         ++n_types;
+         }
+
+   /*
+    * global variables, including statics
+    */
+   for (i = 0; i < n_gbl; ++i) {
+      if (bitset(typ, frst_gbl + i)) {
+         subtypes |= HasGlb;
+         var_indx = i;
+         ++n_types;
+         }
+      }
+
+   /*
+    * local variables
+    */
+   for (i = 0; i < n_loc; ++i) {
+      if (bitset(typ, frst_loc + i)) {
+         if (i < Abs(cur_proc->nargs))
+            subtypes |= HasPrm;
+         else
+            subtypes |= HasLcl;
+         var_indx = n_gbl + i;
+         ++n_types;
+         }
+      }
+
+   if (singl != NULL) {
+      /*
+       *  See if the type consists of a single named variable.
+       */
+      if (n_types == 1 && var_indx != -1)
+         *singl = cur_proc->vartypmap[var_indx];
+      else
+         *singl = NULL;
+      }
+
+   return subtypes;
+   }
+
+/*
+ * mark_recs - go through the list of parent records for this field
+ *  and mark those that are in the type. Also gather information
+ *  to help generate better code.
+ */
+void mark_recs(fp, typ, num_offsets, offset, bad_recs)
+struct fentry *fp;
+#ifdef OptimizeType
+struct typinfo *typ;
+#else					/* OptimizeType */
+unsigned int *typ;
+#endif					/* OptimizeType */
+int *num_offsets;
+int *offset;
+int *bad_recs;
+   {
+   struct par_rec *rp;
+   struct type *wktyp;
+   int frst_rec;
+   
+   *num_offsets = 0;
+   *offset = -1;
+   *bad_recs = 0;
+
+   wktyp = get_wktyp();
+   CpyTyp(n_icntyp, typ, wktyp->bits);
+
+   /*
+    * For each record containing this field, see if the record is
+    *  in the type.
+    */
+   frst_rec = type_array[rec_typ].frst_bit;
+   for (rp = fp->rlist; rp != NULL; rp = rp->next) {
+      if (bitset(wktyp->bits, frst_rec + rp->rec->rec_num)) {
+         /*
+          * This record is in the type.
+          */
+         rp->mark = 1;
+         clr_typ(wktyp->bits, frst_rec + rp->rec->rec_num);
+         if (*offset != rp->offset) {
+            *offset = rp->offset;
+            *num_offsets += 1;
+            }
+        }
+      }
+
+   /*
+    * Are there any records that do not contain this field?
+    */
+   *bad_recs = has_type(wktyp->bits, rec_typ, 0);
+   free_wktyp(wktyp);
+   }
+
+/*
+ * past_prms - return true if execution might continue past the parameter
+ *  evaluation. If a parameter has no type, this will not happen.
+ */
+int past_prms(n)
+nodeptr n;
+   {
+   struct implement *impl;
+   struct symtyps *symtyps;
+   int nparms;
+   int nargs;
+   int flag;
+   int i, j;
+
+   nargs = Val0(n);
+   impl = Impl1(n);
+   symtyps = n->symtyps;
+   nparms = impl->nargs;
+
+   if (symtyps == NULL)
+      return 1;
+
+   j = 0;
+   for (i = 0; i < nparms; ++i) {
+      flag = impl->arg_flgs[i];
+      if (flag & VarPrm && i >= nargs)
+          break;       /* no parameters for variable part of arg list */
+      if (flag & RtParm) {
+         if (is_empty(symtyps->types[j]))
+            return 0;
+         ++j;
+         }
+      if (flag & DrfPrm) {
+         if (is_empty(symtyps->types[j]))
+            return 0;
+         ++j;
+         }
+      }
+   return 1;
+   }
diff --git a/src/icont/Makefile b/src/icont/Makefile
new file mode 100644
index 0000000..8f15f9d
--- /dev/null
+++ b/src/icont/Makefile
@@ -0,0 +1,108 @@
+#  Makefile for the Icon translator, icont.
+
+include ../../Makedefs
+
+
+HFILES =	../h/define.h ../h/config.h ../h/cpuconf.h ../h/gsupport.h \
+		   ../h/mproto.h ../h/typedefs.h ../h/cstructs.h
+
+TRANS =		trans.o tcode.o tlex.o lnklist.o tparse.o tsym.o tmem.o tree.o
+
+LINKR =		link.o lglob.o lcode.o llex.o lmem.o lsym.o opcode.o
+
+OBJS =		tunix.o tglobals.o util.o $(TRANS) $(LINKR)
+
+COBJS =		../common/long.o ../common/getopt.o ../common/alloc.o \
+		   ../common/filepart.o ../common/strtbl.o ../common/ipp.o \
+		   ../common/munix.o
+
+
+
+icont:		$(OBJS) $(COBJS)
+		$(CC) $(CFLAGS) $(LDFLAGS) -o icont $(OBJS) $(COBJS)
+		cp icont ../../bin
+		strip ../../bin/icont$(EXE)
+		(cd ../../bin; rm -f icon; ln -s icont icon)
+
+$(OBJS):	$(HFILES) tproto.h
+
+$(COBJS):	$(HFILES)
+		cd ../common; $(MAKE)
+
+tunix.o:	tglobals.h ../h/version.h
+tglobals.o:	tglobals.h
+util.o:		tglobals.h tree.h ../h/fdefs.h
+
+# translator files
+trans.o:	tglobals.h tsym.h ttoken.h tree.h ../h/version.h ../h/kdefs.h
+lnklist.o:	lfile.h
+tparse.o:	../h/lexdef.h tglobals.h tsym.h tree.h keyword.h
+tcode.o:	tglobals.h tsym.h ttoken.h tree.h
+tlex.o:		../h/lexdef.h ../h/parserr.h ttoken.h tree.h ../h/esctab.h \
+		   ../common/lextab.h ../common/yylex.h ../common/error.h
+tmem.o:		tglobals.h tsym.h tree.h
+tree.o:		tree.h
+tsym.o:		tglobals.h tsym.h ttoken.h lfile.h keyword.h ../h/kdefs.h
+
+# linker files
+$(LINKR):	link.h lfile.h ../h/rt.h ../h/sys.h ../h/monitor.h \
+		   ../h/rstructs.h ../h/rmacros.h ../h/rexterns.h
+
+link.o:		tglobals.h hdr.h ../h/header.h
+lcode.o:	tglobals.h opcode.h keyword.h ../h/header.h \
+			../h/opdefs.h ../h/version.h
+lglob.o:	tglobals.h opcode.h ../h/opdefs.h ../h/version.h
+llex.o:		tglobals.h opcode.h ../h/opdefs.h
+lmem.o:		tglobals.h
+lsym.o:		tglobals.h
+opcode.o:	opcode.h ../h/opdefs.h
+
+#  hdr.h is always built, to simplify the Makefile,
+#  but it is only actually used if BinHeader is define.
+hdr.h:		newhdr ixhdr.hdr
+		./newhdr -o hdr.h ixhdr.hdr
+newhdr:		newhdr.c ../h/define.h ../h/config.h ../h/gsupport.h
+		$(CC) $(CFLAGS) $(LDFLAGS) -o newhdr newhdr.c
+ixhdr.hdr:	ixhdr.c ../h/define.h ../h/config.h ../h/header.h $(COBJS)
+		$(CC) $(CFLAGS) $(LDFLAGS) -o ixhdr.hdr \
+			ixhdr.c ../common/alloc.o ../common/munix.o
+		strip ixhdr.hdr
+
+
+
+
+#  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
+#
+#tparse.c ttoken.h:	tgram.g trash ../common/pscript
+## expect 218 shift/reduce conflicts
+#		yacc -d tgram.g
+#		./trash <y.tab.c | ../common/pscript >tparse.c
+#		mv y.tab.h ttoken.h
+#		rm -f y.tab.c
+#
+#tgram.g:	tgrammar.c ../h/define.h ../h/grammar.h \
+#			../common/yacctok.h ../common/fixgram 
+#		$(CC) -E -C tgrammar.c | ../common/fixgram >tgram.g
+#
+#../h/kdefs.h keyword.h:	../runtime/keyword.r mkkwd
+#		./mkkwd <../runtime/keyword.r
+#
+#trash:		trash.icn
+#		icont -s trash.icn
+#
+#mkkwd:		mkkwd.icn
+#		icont -s mkkwd.icn
diff --git a/src/icont/ixhdr.c b/src/icont/ixhdr.c
new file mode 100644
index 0000000..9766292
--- /dev/null
+++ b/src/icont/ixhdr.c
@@ -0,0 +1,73 @@
+/*
+ * ixhdr.c -- bootstrap header for icode files
+ *
+ * (used when BinaryHeader is defined)
+ */
+
+#include "../h/gsupport.h"
+
+static	void	doiconx		(char *argv[]);
+static	void	hsyserr		(char *av, char *file);
+
+int main(int argc, char *argv[]) {
+   char *argvx[1000];
+
+   /*
+    * Abort if we've been invoked with setuid or setgid privileges.
+    *  Allowing such usage would open a huge security hole, because
+    *  there is no way to ensure that the right iconx will interpret
+    *  the right user program.
+    */
+   if (getuid() != geteuid() || getgid() != getegid())
+      hsyserr(argv[0], ": cannot run an Icon program setuid/setgid");
+
+   /*
+    * Shift the argument list to make room for iconx in argv[0].
+    */
+   do 
+      argvx[argc + 1] = argv[argc];
+   while (argc--);
+
+   /*
+    * Pass the arglist and execute iconx.
+    */
+   doiconx(argvx);		
+   return EXIT_FAILURE;
+   }
+
+/*
+ * doiconx(argv) - execute iconx, passing argument list.
+ *
+ *  To find the interpreter, first check the environment variable ICONX.
+ *  If it defines a path, it had better work, else we abort.
+ *
+ *  Failing that, check the directory containing the icode file,
+ *  and if that doesn't work, search $PATH.
+ */
+static void doiconx(char *argv[]) {
+   char xcmd[256];
+
+   if ((argv[0] = getenv("ICONX")) != NULL && argv[0][0] != '\0') {
+      execv(argv[0], argv);		/* exec file specified by $ICONX */
+      hsyserr("cannot execute $ICONX: ", argv[0]);
+      }
+
+   argv[0] = relfile(argv[1], "/../iconx" ExecSuffix);
+   execv(argv[0], argv);  /* try iconx in same dir; just continue if absent */
+
+   if (findonpath("iconx" ExecSuffix, xcmd, sizeof(xcmd))) {   
+      argv[0] = xcmd;
+      execv(xcmd, argv);
+      hsyserr("cannot execute ", xcmd);
+      }
+
+   hsyserr(argv[1], ": cannot find iconx" ExecSuffix);
+   }
+
+/*
+ * hsyserr(s1, s2) - print s1 and s2 on stderr, then abort.
+ */
+static void hsyserr(char *s1, char *s2) {
+   fprintf(stderr, "%s%s\n", s1, s2);
+   exit(EXIT_FAILURE);
+   }
diff --git a/src/icont/keyword.h b/src/icont/keyword.h
new file mode 100644
index 0000000..f6659c1
--- /dev/null
+++ b/src/icont/keyword.h
@@ -0,0 +1,70 @@
+/*
+ * keyword.h -- Keyword manifest constants.
+ *
+ * Created mechanically by mkkwd.icn -- DO NOT EDIT.
+ */
+
+#define K_ALLOCATED    1
+#define K_ASCII        2
+#define K_CLOCK        3
+#define K_COL          4
+#define K_COLLECTIONS  5
+#define K_COLUMN       6
+#define K_CONTROL      7
+#define K_CSET         8
+#define K_CURRENT      9
+#define K_DATE        10
+#define K_DATELINE    11
+#define K_DIGITS      12
+#define K_DUMP        13
+#define K_E           14
+#define K_ERROR       15
+#define K_ERRORNUMBER 16
+#define K_ERRORTEXT   17
+#define K_ERRORVALUE  18
+#define K_ERROUT      19
+#define K_EVENTCODE   20
+#define K_EVENTSOURCE 21
+#define K_EVENTVALUE  22
+#define K_FAIL        23
+#define K_FEATURES    24
+#define K_FILE        25
+#define K_HOST        26
+#define K_INPUT       27
+#define K_INTERVAL    28
+#define K_LCASE       29
+#define K_LDRAG       30
+#define K_LETTERS     31
+#define K_LEVEL       32
+#define K_LINE        33
+#define K_LPRESS      34
+#define K_LRELEASE    35
+#define K_MAIN        36
+#define K_MDRAG       37
+#define K_META        38
+#define K_MPRESS      39
+#define K_MRELEASE    40
+#define K_NULL        41
+#define K_OUTPUT      42
+#define K_PHI         43
+#define K_PI          44
+#define K_POS         45
+#define K_PROGNAME    46
+#define K_RANDOM      47
+#define K_RDRAG       48
+#define K_REGIONS     49
+#define K_RESIZE      50
+#define K_ROW         51
+#define K_RPRESS      52
+#define K_RRELEASE    53
+#define K_SHIFT       54
+#define K_SOURCE      55
+#define K_STORAGE     56
+#define K_SUBJECT     57
+#define K_TIME        58
+#define K_TRACE       59
+#define K_UCASE       60
+#define K_VERSION     61
+#define K_WINDOW      62
+#define K_X           63
+#define K_Y           64
diff --git a/src/icont/lcode.c b/src/icont/lcode.c
new file mode 100644
index 0000000..a1481f1
--- /dev/null
+++ b/src/icont/lcode.c
@@ -0,0 +1,1564 @@
+/*
+ * lcode.c -- linker routines to parse .u1 files and produce icode.
+ */
+
+#include "link.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "opcode.h"
+#include "keyword.h"
+#include "../h/version.h"
+#include "../h/header.h"
+
+/*
+ *  This needs fixing ...
+ */
+#undef CsetPtr
+#define CsetPtr(b,c)	((c) + (((b)&0377) >> LogIntBits))
+
+/*
+ * Prototypes.
+ */
+
+static void	align		(void);
+static void	backpatch	(int lab);
+static void	clearlab	(void);
+static void	flushcode	(void);
+static void	intout		(int oint);
+static void	lemit		(int op,char *name);
+static void	lemitcon	(int k);
+static void	lemitin		(int op,word offset,int n,char *name);
+static void	lemitint	(int op,long i,char *name);
+static void	lemitl		(int op,int lab,char *name);
+static void	lemitn		(int op,word n,char *name);
+static void	lemitproc    (word name,int nargs,int ndyn,int nstat,int fstat);
+static void	lemitr		(int op,word loc,char *name);
+static void	misalign	(void);
+static void	outblock	(char *addr,int count);
+static void	setfile		(void);
+static void	wordout		(word oword);
+
+#ifdef FieldTableCompression
+   static void	charout		(unsigned char oint);
+   static void	shortout	(short oint);
+#endif					/* FieldTableCompression */
+
+#ifdef DeBugLinker
+   static void	dumpblock	(char *addr,int count);
+#endif					/* DeBugLinker */
+
+word pc = 0;		/* simulated program counter */
+
+#define outword(n)	wordout((word)(n))
+#define outop(n)	intout((int)(n))
+#define outchar(n)	charout((unsigned char)(n))
+#define outshort(n)	shortout((short)(n))
+#define CodeCheck(n) if ((long)codep + (n) > (long)((long)codeb + maxcode))\
+                     codeb = (char *) trealloc(codeb, &codep, &maxcode, 1,\
+                       (n), "code buffer");
+
+#define ByteBits 8
+
+/*
+ * gencode - read .u1 file, resolve variable references, and generate icode.
+ *  Basic process is to read each line in the file and take some action
+ *  as dictated by the opcode.	This action sometimes involves parsing
+ *  of arguments and usually culminates in the call of the appropriate
+ *  lemit* routine.
+ */
+void gencode()
+   {
+   register int op, k, lab;
+   int j, nargs, flags, implicit;
+   char *name;
+   word id, procname;
+   struct centry *cp;
+   struct gentry *gp;
+   struct fentry *fp;
+   union xval gg;
+
+   while ((op = getopc(&name)) != EOF) {
+      switch (op) {
+
+         /* Ternary operators. */
+
+         case Op_Toby:
+         case Op_Sect:
+
+         /* Binary operators. */
+
+         case Op_Asgn:
+         case Op_Cat:
+         case Op_Diff:
+         case Op_Div:
+         case Op_Eqv:
+         case Op_Inter:
+         case Op_Lconcat:
+         case Op_Lexeq:
+         case Op_Lexge:
+         case Op_Lexgt:
+         case Op_Lexle:
+         case Op_Lexlt:
+         case Op_Lexne:
+         case Op_Minus:
+         case Op_Mod:
+         case Op_Mult:
+         case Op_Neqv:
+         case Op_Numeq:
+         case Op_Numge:
+         case Op_Numgt:
+         case Op_Numle:
+         case Op_Numlt:
+         case Op_Numne:
+         case Op_Plus:
+         case Op_Power:
+         case Op_Rasgn:
+         case Op_Rswap:
+         case Op_Subsc:
+         case Op_Swap:
+         case Op_Unions:
+
+         /* Unary operators. */
+
+         case Op_Bang:
+         case Op_Compl:
+         case Op_Neg:
+         case Op_Nonnull:
+         case Op_Null:
+         case Op_Number:
+         case Op_Random:
+         case Op_Refresh:
+         case Op_Size:
+         case Op_Tabmat:
+         case Op_Value:
+
+         /* Instructions. */
+
+         case Op_Bscan:
+         case Op_Ccase:
+         case Op_Coact:
+         case Op_Cofail:
+         case Op_Coret:
+         case Op_Dup:
+         case Op_Efail:
+         case Op_Eret:
+         case Op_Escan:
+         case Op_Esusp:
+         case Op_Limit:
+         case Op_Lsusp:
+         case Op_Pfail:
+         case Op_Pnull:
+         case Op_Pop:
+         case Op_Pret:
+         case Op_Psusp:
+         case Op_Push1:
+         case Op_Pushn1:
+         case Op_Sdup:
+            newline();
+            lemit(op, name);
+            break;
+
+         case Op_Chfail:
+         case Op_Create:
+         case Op_Goto:
+         case Op_Init:
+            lab = getlab();
+            newline();
+            lemitl(op, lab, name);
+            break;
+
+         case Op_Cset:
+         case Op_Real:
+            k = getdec();
+            newline();
+            lemitr(op, lctable[k].c_pc, name);
+            break;
+
+         case Op_Field:
+            id = getid();
+            newline();
+            fp = flocate(id);
+            if (fp != NULL)
+               lemitn(op, (word)(fp->f_fid-1), name);
+	    else
+               lemitn(op, (word)-1, name);	/* no warning any more */
+            break;
+
+
+         case Op_Int: {
+            long i;
+            k = getdec();
+            newline();
+            cp = &lctable[k];
+            /*
+             * Check to see if a large integers has been converted to a string.
+             *  If so, generate the code for +s.
+             */
+            if (cp->c_flag & F_StrLit) {
+               lemit(Op_Pnull,"pnull");
+               lemitin(Op_Str, cp->c_val.sval, cp->c_length, "str");
+               lemit(Op_Number,"number");
+               break;
+               }
+            i = (long)cp->c_val.ival;
+            lemitint(op, i, name);
+            break;
+            }
+
+
+         case Op_Invoke:
+            k = getdec();
+            newline();
+            if (k == -1)
+               lemit(Op_Apply,"apply");
+            else
+               lemitn(op, (word)k, name);
+            break;
+
+         case Op_Keywd:
+            id = getstr();
+            newline();
+            k = klookup(&lsspace[id]);
+            switch (k) {
+               case 0:
+                  lfatal(&lsspace[id],"invalid keyword");
+                  break;
+               case K_FAIL:
+                  lemit(Op_Efail,"efail");
+                  break;
+               case K_NULL:
+                  lemit(Op_Pnull,"pnull");
+                  break;
+               default:
+               lemitn(op, (word)k, name);
+            }
+            break;
+
+         case Op_Llist:
+            k = getdec();
+            newline();
+            lemitn(op, (word)k, name);
+            break;
+
+         case Op_Lab:
+            lab = getlab();
+            newline();
+            #ifdef DeBugLinker
+               if (Dflag)
+                  fprintf(dbgfile, "L%d:\n", lab);
+            #endif			/* DeBugLinker */
+            backpatch(lab);
+            break;
+
+         case Op_Line:
+            /*
+             * Line number change.
+             *  All the interesting stuff happens in Op_Colm now.
+             */
+            lineno = getdec();
+
+            #ifndef SrcColumnInfo
+               /*
+                * Enter the value in the line number table
+                *  that is stored in the icode file and used during error
+                *  handling and execution monitoring.  One can generate a VM
+                *  instruction for these changes, but since the numbers are not
+                *  saved and restored during backtracking, it is more accurate
+                *  to check for line number changes in-line in the interpreter.
+                *  Fortunately, the in-line check is about as fast as executing
+                *  Op_Line instructions.  All of this is complicated by the use
+                *  of Op_Line to generate Noop instructions when enabled by the
+                *  LineCodes #define.
+                *
+                * If SrcColumnInfo is required, this code is duplicated,
+                *  with changes, in the Op_Colm case below.
+                */
+               if (lnfree >= &lntable[nsize])
+                  lntable  = (struct ipc_line *)trealloc(lntable,&lnfree,&nsize,
+                     sizeof(struct ipc_line), 1, "line number table");
+               lnfree->ipc = pc;
+               lnfree->line = lineno;
+               lnfree++;
+            #endif			/* SrcColumnInfo */
+
+            /*
+             * Could generate an Op_Line for monitoring, but don't anymore:
+             *
+             * lemitn(op, (word)lineno, name);
+             */
+
+            newline();
+
+            #ifdef LineCodes
+               #ifndef EventMon
+                  lemit(Op_Noop,"noop");
+               #endif			/* EventMon */
+            #endif			/* LineCodes */
+
+            break;
+
+         case Op_Colm:			/* always recognize, maybe ignore */
+
+            colmno = getdec();
+            #ifdef SrcColumnInfo
+               if (lnfree >= &lntable[nsize])
+                  lntable  = (struct ipc_line *)trealloc(lntable,&lnfree,&nsize,
+                     sizeof(struct ipc_line), 1, "line number table");
+               lnfree->ipc = pc;
+               lnfree->line = lineno + (colmno << 16);
+               lnfree++;
+            #endif			/* SrcColumnInfo */
+            break;
+
+         case Op_Mark:
+            lab = getlab();
+            newline();
+            lemitl(op, lab, name);
+            break;
+
+         case Op_Mark0:
+            lemit(op, name);
+            break;
+
+         case Op_Str:
+            k = getdec();
+            newline();
+            cp = &lctable[k];
+            lemitin(op, cp->c_val.sval, cp->c_length, name);
+            break;
+
+         case Op_Tally:
+            k = getdec();
+            newline();
+            lemitn(op, (word)k, name);
+            break;
+
+         case Op_Unmark:
+            lemit(Op_Unmark, name);
+            break;
+
+         case Op_Var:
+            k = getdec();
+            newline();
+            flags = lltable[k].l_flag;
+            if (flags & F_Global)
+               lemitn(Op_Global, (word)(lltable[k].l_val.global->g_index),
+                  "global");
+            else if (flags & F_Static)
+               lemitn(Op_Static, (word)(lltable[k].l_val.staticid-1), "static");
+            else if (flags & F_Argument)
+               lemitn(Op_Arg, (word)(lltable[k].l_val.offset-1), "arg");
+            else
+               lemitn(Op_Local, (word)(lltable[k].l_val.offset-1), "local");
+            break;
+
+         /* Declarations. */
+
+         case Op_Proc:
+            getstr();
+            newline();
+            procname = putident(strlen(&lsspace[lsfree]) + 1, 0);
+            if (procname >= 0 && (gp = glocate(procname)) != NULL) {
+               /*
+                * Initialize for wanted procedure.
+                */
+               locinit();
+               clearlab();
+               lineno = 0;
+               implicit = gp->g_flag & F_ImpError;
+               nargs = gp->g_nargs;
+	       align();
+               #ifdef DeBugLinker
+                  if (Dflag)
+                     fprintf(dbgfile, "\n# procedure %s\n", &lsspace[lsfree]);
+               #endif			/* DeBugLinker */
+               }
+            else {
+               /*
+                * Skip unreferenced procedure.
+                */
+               while ((op = getopc(&name)) != EOF && op != Op_End)
+                  if (op == Op_Filen)
+                     setfile();		/* handle filename op while skipping */
+                  else
+                     newline();		/* ignore everything else */
+               }
+            break;
+
+         case Op_Local:
+            k = getdec();
+            flags = getoct();
+            id = getid();
+            putlocal(k, id, flags, implicit, procname);
+            break;
+
+         case Op_Con:
+            k = getdec();
+            flags = getoct();
+            if (flags & F_IntLit) {
+               {
+               long m;
+               word s_indx;
+
+               j = getdec();		/* number of characters in integer */
+               m = getint(j,&s_indx);	/* convert if possible */
+               if (m < 0) {		/* negative indicates integer too big */
+                  gg.sval = s_indx;	/* convert to a string */
+                  putconst(k, F_StrLit, j, pc, &gg);
+                  }
+               else {			/* integers is small enough */
+                  gg.ival = m;
+                  putconst(k, flags, 0, pc, &gg);
+                  }
+               }
+               }
+            else if (flags & F_RealLit) {
+               gg.rval = getreal();
+               putconst(k, flags, 0, pc, &gg);
+               }
+            else if (flags & F_StrLit) {
+               j = getdec();
+               gg.sval = getstrlit(j);
+               putconst(k, flags, j, pc, &gg);
+               }
+            else if (flags & F_CsetLit) {
+               j = getdec();
+               gg.sval = getstrlit(j);
+               putconst(k, flags, j, pc, &gg);
+               }
+            else
+               fprintf(stderr, "gencode: illegal constant\n");
+            newline();
+            lemitcon(k);
+            break;
+
+         case Op_Filen:
+            setfile();
+            break;
+
+         case Op_Declend:
+            newline();
+            gp->g_pc = pc;
+            lemitproc(procname, nargs, dynoff, lstatics-static1, static1);
+            break;
+
+         case Op_End:
+            newline();
+            flushcode();
+            break;
+
+         default:
+            fprintf(stderr, "gencode: illegal opcode(%d): %s\n", op, name);
+            newline();
+         }
+      }
+   }
+
+/*
+ * setfile - handle Op_Filen.
+ */
+static void setfile()
+   {
+   if (fnmfree >= &fnmtbl[fnmsize])
+      fnmtbl = (struct ipc_fname *) trealloc(fnmtbl, &fnmfree,
+         &fnmsize, sizeof(struct ipc_fname), 1, "file name table");
+   fnmfree->ipc = pc;
+   fnmfree->fname = getrest();
+   strcpy(icnname, &lsspace[fnmfree->fname]);
+   fnmfree++;
+   newline();
+   }
+
+/*
+ *  lemit - emit opcode.
+ *  lemitl - emit opcode with reference to program label.
+ *	for a description of the chaining and backpatching for labels.
+ *  lemitn - emit opcode with integer argument.
+ *  lemitr - emit opcode with pc-relative reference.
+ *  lemitin - emit opcode with reference to identifier table & integer argument.
+ *  lemitint - emit word opcode with integer argument.
+ *  lemitcon - emit constant table entry.
+ *  lemitproc - emit procedure block.
+ *
+ * The lemit* routines call out* routines to effect the "outputting" of icode.
+ *  Note that the majority of the code for the lemit* routines is for debugging
+ *  purposes.
+ */
+static void lemit(op, name)
+int op;
+char *name;
+   {
+
+   #ifdef DeBugLinker
+      if (Dflag)
+         fprintf(dbgfile, "%ld:\t%d\t\t\t\t# %s\n", (long)pc, op, name);
+   #endif				/* DeBugLinker */
+
+   outop(op);
+   }
+
+static void lemitl(op, lab, name)
+int op, lab;
+char *name;
+   {
+   misalign();
+
+   #ifdef DeBugLinker
+      if (Dflag)
+         fprintf(dbgfile, "%ld:\t%d\tL%d\t\t\t# %s\n", (long)pc, op, lab, name);
+   #endif				/* DeBugLinker */
+
+   if (lab >= maxlabels)
+      labels  = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word),
+         lab - maxlabels + 1, "labels");
+   outop(op);
+   if (labels[lab] <= 0) {		/* forward reference */
+      outword(labels[lab]);
+      labels[lab] = WordSize - pc;	/* add to front of reference chain */
+      }
+   else					/* output relative offset */
+      outword(labels[lab] - (pc + WordSize));
+   }
+
+static void lemitn(op, n, name)
+int op;
+word n;
+char *name;
+   {
+   misalign();
+
+   #ifdef DeBugLinker
+      if (Dflag)
+         fprintf(dbgfile, "%ld:\t%d\t%ld\t\t\t# %s\n", (long)pc, op, (long)n,
+            name);
+   #endif				/* DeBugLinker */
+
+   outop(op);
+   outword(n);
+   }
+
+
+static void lemitr(op, loc, name)
+int op;
+word loc;
+char *name;
+   {
+   misalign();
+
+   loc -= pc + ((IntBits/ByteBits) + WordSize);
+
+   #ifdef DeBugLinker
+      if (Dflag) {
+         if (loc >= 0)
+            fprintf(dbgfile, "%ld:\t%d\t*+%ld\t\t\t# %s\n",(long) pc, op,
+               (long)loc, name);
+         else
+            fprintf(dbgfile, "%ld:\t%d\t*-%ld\t\t\t# %s\n",(long) pc, op,
+               (long)-loc, name);
+         }
+   #endif				/* DeBugLinker */
+
+   outop(op);
+   outword(loc);
+   }
+
+static void lemitin(op, offset, n, name)
+int op, n;
+word offset;
+char *name;
+   {
+   misalign();
+
+   #ifdef DeBugLinker
+      if (Dflag)
+         fprintf(dbgfile, "%ld:\t%d\t%d,S+%ld\t\t\t# %s\n", (long)pc, op, n,
+            (long)offset, name);
+   #endif				/* DeBugLinker */
+
+   outop(op);
+   outword(n);
+   outword(offset);
+   }
+
+/*
+ * lemitint can have some pitfalls.  outword is used to output the
+ *  integer and this is picked up in the interpreter as the second
+ *  word of a short integer.  The integer value output must be
+ *  the same size as what the interpreter expects.  See op_int and op_intx
+ *  in interp.s
+ */
+static void lemitint(op, i, name)
+int op;
+long i;
+char *name;
+   {
+   misalign();
+
+   #ifdef DeBugLinker
+      if (Dflag)
+         fprintf(dbgfile,"%ld:\t%d\t%ld\t\t\t# %s\n",(long)pc,op,(long)i,name);
+   #endif				/* DeBugLinker */
+
+   outop(op);
+   outword(i);
+   }
+
+static void lemitcon(k)
+register int k;
+   {
+   register int i, j;
+   register char *s;
+   int csbuf[CsetSize];
+   union {
+      char ovly[1];  /* Array used to overlay l and f on a bytewise basis. */
+      long l;
+      double f;
+      } x;
+
+   if (lctable[k].c_flag & F_RealLit) {
+
+      #ifdef Double
+         /* access real values one word at a time */
+         int *rp, *rq;
+         rp = (int *) &(x.f);
+         rq = (int *) &(lctable[k].c_val.rval);
+         *rp++ = *rq++;
+         *rp = *rq;
+      #else				/* Double */
+         x.f = lctable[k].c_val.rval;
+      #endif				/* Double */
+
+      #ifdef DeBugLinker
+         if (Dflag) {
+            fprintf(dbgfile,"%ld:\t%d\t\t\t\t# real(%g)",(long)pc,T_Real, x.f);
+            dumpblock(x.ovly,sizeof(double));
+            }
+      #endif				/* DeBugLinker */
+
+      outword(T_Real);
+
+      #ifdef Double
+         #if WordBits != 64
+            /* fill out real block with an empty word */
+            outword(0);
+            #ifdef DeBugLinker
+               if (Dflag)
+	          fprintf(dbgfile,"\t0\t\t\t\t\t# padding\n");
+            #endif			/* DeBugLinker */
+         #endif				/* WordBits != 64 */
+      #endif				/* Double */
+
+      outblock(x.ovly,sizeof(double));
+      }
+   else if (lctable[k].c_flag & F_CsetLit) {
+      for (i = 0; i < CsetSize; i++)
+         csbuf[i] = 0;
+      s = &lsspace[lctable[k].c_val.sval];
+      i = lctable[k].c_length;
+      while (i--) {
+         Setb(*s, csbuf);
+         s++;
+         }
+      j = 0;
+      for (i = 0; i < 256; i++) {
+         if (Testb(i, csbuf))
+           j++;
+         }
+
+      #ifdef DeBugLinker
+         if (Dflag) {
+            fprintf(dbgfile, "%ld:\t%d\n",(long) pc, T_Cset);
+            fprintf(dbgfile, "\t%d\n",j);
+            }
+      #endif				/* DeBugLinker */
+
+      outword(T_Cset);
+      outword(j);		   /* cset size */
+      outblock((char *)csbuf,sizeof(csbuf));
+
+      #ifdef DeBugLinker
+         if (Dflag)
+            dumpblock((char *)csbuf,CsetSize);
+      #endif				/* DeBugLinker */
+
+      }
+   }
+
+static void lemitproc(name, nargs, ndyn, nstat, fstat)
+word name;
+int nargs, ndyn, nstat, fstat;
+   {
+   register int i;
+   register char *p;
+   word s_indx;
+   int size;
+   /*
+    * FncBlockSize = sizeof(BasicFncBlock) +
+    *  sizeof(descrip)*(# of args + # of dynamics + # of statics).
+    */
+   size = (9*WordSize) + (2*WordSize) * (abs(nargs)+ndyn+nstat);
+
+   p = &lsspace[name];
+   #ifdef DeBugLinker
+      if (Dflag) {
+         fprintf(dbgfile, "%ld:\t%d\n", (long)pc, T_Proc); /* type code */
+         fprintf(dbgfile, "\t%d\n", size);		/* size of block */
+         fprintf(dbgfile, "\tZ+%ld\n",(long)(pc+size));	/* entry point */
+         fprintf(dbgfile, "\t%d\n", nargs);		/* # arguments */
+         fprintf(dbgfile, "\t%d\n", ndyn);		/* # dynamic locals */
+         fprintf(dbgfile, "\t%d\n", nstat);		/* # static locals */
+         fprintf(dbgfile, "\t%d\n", fstat);		/* first static */
+         fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n",	/* name of procedure */
+            (int)strlen(p), (long)(name), p);
+      }
+   #endif				/* DeBugLinker */
+
+   outword(T_Proc);
+   outword(size);
+   outword(pc + size - 2*WordSize); /* Have to allow for the two words
+					that we've already output. */
+   outword(nargs);
+   outword(ndyn);
+   outword(nstat);
+   outword(fstat);
+   outword(strlen(p));          /* procedure name: length & offset */
+   outword(name);
+
+   /*
+    * Output string descriptors for argument names by looping through
+    *  all locals, and picking out those with F_Argument set.
+    */
+   for (i = 0; i <= nlocal; i++) {
+      if (lltable[i].l_flag & F_Argument) {
+         s_indx = lltable[i].l_name;
+         p = &lsspace[s_indx];
+
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
+                  (long)s_indx, p);
+         #endif				/* DeBugLinker */
+
+         outword(strlen(p));
+         outword(s_indx);
+         }
+      }
+
+   /*
+    * Output string descriptors for local variable names.
+    */
+   for (i = 0; i <= nlocal; i++) {
+      if (lltable[i].l_flag & F_Dynamic) {
+         s_indx = lltable[i].l_name;
+         p = &lsspace[s_indx];
+
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
+                  (long)s_indx, p);
+         #endif				/* DeBugLinker */
+
+         outword(strlen(p));
+         outword(s_indx);
+         }
+      }
+
+   /*
+    * Output string descriptors for static variable names.
+    */
+   for (i = 0; i <= nlocal; i++) {
+      if (lltable[i].l_flag & F_Static) {
+         s_indx = lltable[i].l_name;
+         p = &lsspace[s_indx];
+
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p),
+                  (long)s_indx, p);
+         #endif				/* DeBugLinker */
+
+         outword(strlen(p));
+         outword(s_indx);
+         }
+      }
+   }
+
+/*
+ * gentables - generate interpreter code for global, static,
+ *  identifier, and record tables, and built-in procedure blocks.
+ */
+
+void gentables()
+   {
+   register int i;
+   register char *s;
+   register struct gentry *gp;
+   struct fentry *fp;
+   struct rentry *rp;
+   struct header hdr;
+
+   /*
+    * Output record constructor procedure blocks.
+    */
+   align();
+   hdr.Records = pc;
+
+   #ifdef DeBugLinker
+      if (Dflag) {
+         fprintf(dbgfile, "\n\n# global tables\n");
+         fprintf(dbgfile, "\n%ld:\t%d\t\t\t\t# record blocks\n",
+	    (long)pc, nrecords);
+         }
+   #endif				/* DeBugLinker */
+
+   outword(nrecords);
+   for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
+      if ((gp->g_flag & F_Record) && gp->g_procid > 0) {
+         s = &lsspace[gp->g_name];
+         gp->g_pc = pc;
+
+         #ifdef DeBugLinker
+            if (Dflag) {
+               fprintf(dbgfile, "%ld:\n", pc);
+               fprintf(dbgfile, "\t%d\n", T_Proc);
+               fprintf(dbgfile, "\t%d\n", RkBlkSize(gp));
+               fprintf(dbgfile, "\t_mkrec\n");
+               fprintf(dbgfile, "\t%d\n", gp->g_nargs);
+               fprintf(dbgfile, "\t-2\n");
+               fprintf(dbgfile, "\t%d\n", gp->g_procid);
+               fprintf(dbgfile, "\t1\n");
+               fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(s),
+                  (long)gp->g_name, s);
+               }
+         #endif				/* DeBugLinker */
+
+         outword(T_Proc);		/* type code */
+         outword(RkBlkSize(gp));
+         outword(0);			/* entry point (filled in by interp)*/
+         outword(gp->g_nargs);		/* number of fields */
+         outword(-2);			/* record constructor indicator */
+         outword(gp->g_procid);		/* record id */
+         outword(1);			/* serial number */
+         outword(strlen(s));		/* name of record: size and offset */
+         outword(gp->g_name);
+
+         for (i=0;i<gp->g_nargs;i++) {	/* field names (filled in by interp) */
+            int foundit = 0;
+            /*
+             * Find the field list entry corresponding to field i in
+             * record gp, then write out a descriptor for it.
+             */
+            for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
+               for (rp = fp->f_rlist; rp!= NULL; rp=rp->r_link) {
+                  if (rp->r_gp == gp && rp->r_fnum == i) {
+                     if (foundit) {
+                        /*
+                         * This internal error should never occur
+                         */
+                        fprintf(stderr,"found rec %d field %d already!!\n",
+                           gp->g_procid, i);
+                        fflush(stderr);
+                        exit(1);
+                        }
+                     #ifdef DeBugLinker
+                        if (Dflag)
+                           fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n",
+                              (int)strlen(&lsspace[fp->f_name]),
+                              fp->f_name, &lsspace[fp->f_name]);
+                     #endif		/* DeBugLinker */
+                     outword(strlen(&lsspace[fp->f_name]));
+                     outword(fp->f_name);
+                     foundit++;
+                     }
+                  }
+               }
+            if (!foundit) {
+               /*
+                * This internal error should never occur
+                */
+               fprintf(stderr,"never found rec %d field %d!!\n",
+                       gp->g_procid,i);
+               fflush(stderr);
+               exit(1);
+               }
+            }
+         }
+      }
+
+   #ifndef FieldTableCompression
+
+      /*
+       * Output record/field table (not compressed).
+       */
+      hdr.Ftab = pc;
+      #ifdef DeBugLinker
+         if (Dflag)
+            fprintf(dbgfile,"\n%ld:\t\t\t\t\t# record/field table\n",(long)pc);
+      #endif				/* DeBugLinker */
+
+      for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "%ld:\t\t\t\t\t# %s\n", (long)pc,
+                  &lsspace[fp->f_name]);
+         #endif				/* DeBugLinker */
+         rp = fp->f_rlist;
+         for (i = 1; i <= nrecords; i++) {
+            while (rp != NULL && rp->r_gp->g_procid < 0)
+	       rp = rp->r_link;		/* skip unreferenced constructor */
+            if (rp != NULL && rp->r_gp->g_procid == i) {
+               #ifdef DeBugLinker
+                  if (Dflag)
+                      fprintf(dbgfile, "\t%d\n", rp->r_fnum);
+               #endif			/* DeBugLinker */
+               outop(rp->r_fnum);
+               rp = rp->r_link;
+	       }
+            else {
+               #ifdef DeBugLinker
+                  if (Dflag)
+                      fprintf(dbgfile, "\t-1\n");
+               #endif			/* DeBugLinker */
+               outop(-1);
+               }
+            #ifdef DeBugLinker
+               if (Dflag && (i == nrecords || (i & 03) == 0))
+                  putc('\n', dbgfile);
+            #endif			/* DeBugLinker */
+            }
+         }
+
+   #else				/* FieldTableCompression */
+
+      /*
+       * Output record/field table (compressed).
+       * This code has not been tested recently.
+       */
+      {
+      int counter = 0, f_num, first, begin, end, entries;
+      int *f_fo, *f_row, *f_tabp;
+      char *f_bm;
+      int pointer, first_avail = 0, inserted, bytes;
+      hdr.Fo = pc;
+
+      /*
+       * Compute the field width required for this binary;
+       * it is determined by the maximum # of fields in any one record.
+       */
+      long ct = 0;
+      for (gp = lgfirst; gp != NULL; gp = gp->g_next)
+         if ((gp->g_flag & F_Record) && gp->g_procid > 0)
+            if (gp->g_nargs > ct) ct=gp->g_nargs;
+      if (ct > 65535L) hdr.FtabWidth = 4;
+      else if (ct > 254) hdr.FtabWidth = 2; /* 255 is (not present) */
+      else hdr.FtabWidth = 1;
+
+      /* Find out how many field names there are. */
+      hdr.Nfields = 0;
+      for (fp = lffirst; fp != NULL; fp = fp->f_nextentry)
+         hdr.Nfields++;
+
+      entries = hdr.Nfields * nrecords / 4 + 1;
+      f_tabp = malloc (entries * sizeof (int));
+      for (i = 0; i < entries; i++)
+         f_tabp[i] = -1;
+      f_fo = malloc (hdr.Nfields * sizeof (int));
+   
+      bytes = nrecords / 8;
+      if (nrecords % 8 != 0)
+         bytes++;
+      f_bm = calloc (hdr.Nfields, bytes);
+      f_row = malloc (nrecords * sizeof (int));
+      f_num = 0;
+
+      for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
+         rp = fp->f_rlist;
+         first = 1;
+         for (i = 0; i < nrecords; i++) {
+            while (rp != NULL && rp->r_gp->g_procid < 0)
+   	    rp = rp->r_link;		/* skip unreferenced constructor */
+            if (rp != NULL && rp->r_gp->g_procid == i + 1) {
+               if (first) {
+                  first = 0;
+                  begin = end = i;
+                  }
+               else
+                  end = i;
+               f_row[i] = rp->r_fnum;
+               rp = rp->r_link;
+   	       }
+            else {
+               f_row[i] = -1;
+               }
+            }
+
+         inserted = 0;
+         pointer = first_avail;
+         while (!inserted) {
+            inserted = 1;
+            for (i = begin; i <= end; i++) {
+               if (pointer + (end - begin) >= entries) {
+                  int j;
+                  int old_entries = entries;
+                  entries *= 2;
+                  f_tabp = realloc (f_tabp, entries * sizeof (int));
+                  for (j = old_entries; j < entries; j++)
+                     f_tabp[j] = -1;
+                  }
+               if (f_row[i] != -1)
+                  if (f_tabp[pointer + (i - begin)] != -1) {
+                     inserted = 0;
+                     break;
+                     }
+               }
+            pointer++;
+            }
+         pointer--;
+
+         /* Create bitmap */
+         for (i = 0; i < nrecords; i++) {
+            int index = f_num * bytes + i / 8;
+   				/* Picks out byte within bitmap row */
+            if (f_row[i] != -1) {
+               f_bm[index] |= 01;
+   	       }
+            if (i % 8 != 7)
+               f_bm [index] <<= 1;
+   	    }
+
+         if (nrecords%8)
+            f_bm[(f_num + 1) * bytes - 1] <<= 7 - (nrecords % 8);
+
+         f_fo[f_num++] = pointer - begin;
+         /* So that f_fo[] points to the first bit */
+
+         for (i = begin; i <= end; i++)
+            if (f_row[i] != -1)
+               f_tabp[pointer + (i - begin)] = f_row[i];
+         if (pointer + (end - begin) >= counter)
+            counter = pointer + (end - begin + 1);
+         while ((f_tabp[first_avail] != -1) && (first_avail <= counter))
+            first_avail++;
+         }
+
+         /* Write out the arrays. */
+         #ifdef DeBugLinker
+            if (Dflag)
+            fprintf (dbgfile, "\n%ld:\t\t\t\t\t# field offset array\n",
+	       (long)pc);
+         #endif				/* DeBugLinker */
+
+         /*
+          * Compute largest value stored in fo array
+          */
+         {
+	 word maxfo = 0;
+         for (i = 0; i < hdr.Nfields; i++) {
+            if (f_fo[i] > maxfo) maxfo = f_fo[i];
+            }
+         if (maxfo < 254)
+            hdr.FoffWidth = 1;
+         else if (maxfo < 65535L)
+            hdr.FoffWidth = 2;
+         else
+            hdr.FoffWidth = 4;
+         }
+
+         for (i = 0; i < hdr.Nfields; i++) {
+            #ifdef DeBugLinker
+               if (Dflag)
+                  fprintf (dbgfile, "\t%d\n", f_fo[i]);
+            #endif			/* DeBugLinker */
+            if (hdr.FoffWidth == 1) {
+	       outchar(f_fo[i]);
+	       }
+            else if (hdr.FoffWidth == 2)
+	       outshort(f_fo[i]);
+            else
+            outop (f_fo[i]);
+            }
+
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf (dbgfile, "\n%ld:\t\t\t\t\t# Bit maps array\n",
+	          (long)pc);
+         #endif				/* DeBugLinker */
+
+         for (i = 0; i < hdr.Nfields; i++) {
+            #ifdef DeBugLinker
+               if (Dflag) {
+                  int ct, index = i * bytes;
+                  unsigned char this_bit = 0200;
+
+                  fprintf (dbgfile, "\t");
+                  for (ct = 0; ct < nrecords; ct++) {
+                     if ((f_bm[index] | this_bit) == f_bm[index])
+                        fprintf (dbgfile, "1");
+                     else
+                        fprintf (dbgfile, "0");
+
+                     if (ct % 8 == 7) {
+                        fprintf (dbgfile, " ");
+                        index++;
+                        this_bit = 0200;
+                        }
+                     else
+                        this_bit >>= 1;
+                     }
+                  fprintf (dbgfile, "\n");
+                  }
+            #endif			/* DeBugLinker */
+            for (pointer = i * bytes; pointer < (i + 1) * bytes; pointer++) {
+               outchar (f_bm[pointer]);
+	       }
+            }
+
+         align();
+
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf (dbgfile, "\n%ld:\t\t\t\t\t# record/field array\n",
+	          (long)pc);
+         #endif				/* DeBugLinker */
+
+         hdr.Ftab = pc;
+         for (i = 0; i < counter; i++) {
+            #ifdef DeBugLinker
+               if (Dflag)
+                  fprintf (dbgfile, "\t%d\t%d\n", i, f_tabp[i]);
+            #endif			/* DeBugLinker */
+            if (hdr.FtabWidth == 1)
+               outchar(f_tabp[i]);
+            else if (hdr.FtabWidth == 2)
+               outshort(f_tabp[i]);
+            else
+               outop (f_tabp[i]);
+            }
+
+         /* Free memory allocated by Jigsaw. */
+         free (f_fo);
+         free (f_bm);
+         free (f_tabp);
+         free (f_row);
+         }
+
+      #endif				/* FieldTableCompression */
+
+   /*
+    * Output descriptors for field names.
+    */
+   align();
+   hdr.Fnames = pc;
+   for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
+      s = &lsspace[fp->f_name];
+
+      #ifdef DeBugLinker
+         if (Dflag)
+            fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n",
+               (long)pc, (int)strlen(s), (long)fp->f_name, s);
+      #endif				/* DeBugLinker */
+
+      outword(strlen(s));      /* name of field: length & offset */
+      outword(fp->f_name);
+   }
+
+   /*
+    * Output global variable descriptors.
+    */
+   hdr.Globals = pc;
+   for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
+      if (gp->g_flag & F_Builtin) {		/* function */
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "%ld:\t%06lo\t%d\t\t\t# %s\n",
+                   (long)pc, (long)D_Proc, -gp->g_procid, &lsspace[gp->g_name]);
+         #endif				/* DeBugLinker */
+         outword(D_Proc);
+         outword(-gp->g_procid);
+         }
+      else if (gp->g_flag & F_Proc) {		/* Icon procedure */
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n",
+                   (long)pc,(long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]);
+         #endif				/* DeBugLinker */
+         outword(D_Proc);
+         outword(gp->g_pc);
+         }
+      else if (gp->g_flag & F_Record) {		/* record constructor */
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n", (long) pc,
+                   (long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]);
+         #endif				/* DeBugLinker */
+         outword(D_Proc);
+         outword(gp->g_pc);
+         }
+      else {				/* simple global variable */
+         #ifdef DeBugLinker
+            if (Dflag)
+               fprintf(dbgfile, "%ld:\t%06lo\t0\t\t\t# %s\n",(long)pc,
+                  (long)D_Null, &lsspace[gp->g_name]);
+         #endif				/* DeBugLinker */
+         outword(D_Null);
+         outword(0);
+         }
+      }
+
+   /*
+    * Output descriptors for global variable names.
+    */
+   hdr.Gnames = pc;
+   for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
+
+      #ifdef DeBugLinker
+         if (Dflag)
+            fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n",
+               (long)pc, (int)strlen(&lsspace[gp->g_name]), (long)(gp->g_name),
+                  &lsspace[gp->g_name]);
+      #endif				/* DeBugLinker */
+
+      outword(strlen(&lsspace[gp->g_name]));
+      outword(gp->g_name);
+      }
+
+   /*
+    * Output a null descriptor for each static variable.
+    */
+   hdr.Statics = pc;
+   for (i = lstatics; i > 0; i--) {
+
+      #ifdef DeBugLinker
+         if (Dflag)
+            fprintf(dbgfile, "%ld:\t0\t0\n", (long)pc);
+      #endif				/* DeBugLinker */
+
+      outword(D_Null);
+      outword(0);
+      }
+   flushcode();
+
+   /*
+    * Output the string constant table and the two tables associating icode
+    *  locations with source program locations.  Note that the calls to write
+    *  really do all the work.
+    */
+
+   hdr.Filenms = pc;
+   if (longwrite((char *)fnmtbl, (long)((char *)fnmfree - (char *)fnmtbl),
+      outfile) < 0)
+         quit("cannot write icode file");
+
+   #ifdef DeBugLinker
+      if (Dflag) {
+         int k = 0;
+         struct ipc_fname *ptr;
+         for (ptr = fnmtbl; ptr < fnmfree; ptr++) {
+            fprintf(dbgfile, "%ld:\t%03d\tS+%03d\t\t\t# %s\n",
+               (long)(pc + k), ptr->ipc, ptr->fname, &lsspace[ptr->fname]);
+            k = k + 8;
+            }
+         putc('\n', dbgfile);
+         }
+
+   #endif				/* DeBugLinker */
+
+   pc += (char *)fnmfree - (char *)fnmtbl;
+
+   hdr.linenums = pc;
+   if (longwrite((char *)lntable, (long)((char *)lnfree - (char *)lntable),
+      outfile) < 0)
+         quit("cannot write icode file");
+
+   #ifdef DeBugLinker
+      if (Dflag) {
+         int k = 0;
+         struct ipc_line *ptr;
+         for (ptr = lntable; ptr < lnfree; ptr++) {
+            fprintf(dbgfile, "%ld:\t%03d\t%03d\n", (long)(pc + k),
+               ptr->ipc, ptr->line);
+            k = k + 8;
+            }
+         putc('\n', dbgfile);
+         }
+
+   #endif				/* DeBugLinker */
+
+   pc += (char *)lnfree - (char *)lntable;
+
+   hdr.Strcons = pc;
+   #ifdef DeBugLinker
+      if (Dflag) {
+         int c, j, k;
+         j = k = 0;
+         for (s = lsspace; s < &lsspace[lsfree]; ) {
+            fprintf(dbgfile, "%ld:\t%03o", (long)(pc + k), *s++ & 0377);
+            k = k + 8;
+            for (i = 7; i > 0; i--) {
+               if (s >= &lsspace[lsfree])
+                  fprintf(dbgfile,"    ");
+               else
+                  fprintf(dbgfile, " %03o", *s++ & 0377);
+               }
+            fprintf(dbgfile, "   ");
+            for (i = 0; i < 8; i++)
+               if (j < lsfree) {
+                  c = lsspace[j++];
+                  putc(isprint(c & 0377) ? c : ' ', dbgfile);
+   	       }
+            putc('\n', dbgfile);
+            }
+         }
+
+   #endif				/* DeBugLinker */
+
+   if (longwrite(lsspace, (long)lsfree, outfile) < 0)
+         quit("cannot write icode file");
+
+   pc += lsfree;
+
+   /*
+    * Output icode file header.
+    */
+   hdr.hsize = pc;
+   strcpy((char *)hdr.config,IVersion);
+   hdr.trace = trace;
+
+
+   #ifdef DeBugLinker
+      if (Dflag) {
+         fprintf(dbgfile, "\n");
+         fprintf(dbgfile, "size:	 %ld\n", (long)hdr.hsize);
+         fprintf(dbgfile, "trace:	 %ld\n", (long)hdr.trace);
+         fprintf(dbgfile, "records: %ld\n", (long)hdr.Records);
+         fprintf(dbgfile, "ftab:	 %ld\n", (long)hdr.Ftab);
+         fprintf(dbgfile, "fnames:  %ld\n", (long)hdr.Fnames);
+         fprintf(dbgfile, "globals: %ld\n", (long)hdr.Globals);
+         fprintf(dbgfile, "gnames:  %ld\n", (long)hdr.Gnames);
+         fprintf(dbgfile, "statics: %ld\n", (long)hdr.Statics);
+         fprintf(dbgfile, "strcons:   %ld\n", (long)hdr.Strcons);
+         fprintf(dbgfile, "filenms:   %ld\n", (long)hdr.Filenms);
+         fprintf(dbgfile, "linenums:   %ld\n", (long)hdr.linenums);
+         fprintf(dbgfile, "config:   %s\n", hdr.config);
+         }
+   #endif				/* DeBugLinker */
+
+   fseek(outfile, hdrsize, 0);
+   if (longwrite((char *)&hdr, (long)sizeof(hdr), outfile) < 0)
+      quit("cannot write icode file");
+
+   if (verbose >= 2) {
+      word tsize = sizeof(hdr) + hdr.hsize;
+      fprintf(stderr, "  bootstrap  %7ld\n", hdrsize);
+      tsize += hdrsize;
+      fprintf(stderr, "  header     %7ld\n", (long)sizeof(hdr));
+      fprintf(stderr, "  procedures %7ld\n", (long)hdr.Records);
+      fprintf(stderr, "  records    %7ld\n", (long)(hdr.Ftab - hdr.Records));
+      fprintf(stderr, "  fields     %7ld\n", (long)(hdr.Globals - hdr.Ftab));
+      fprintf(stderr, "  globals    %7ld\n", (long)(hdr.Statics - hdr.Globals));
+      fprintf(stderr, "  statics    %7ld\n", (long)(hdr.Filenms - hdr.Statics));
+      fprintf(stderr, "  linenums   %7ld\n", (long)(hdr.Strcons - hdr.Filenms));
+      fprintf(stderr, "  strings    %7ld\n", (long)(hdr.hsize - hdr.Strcons));
+      fprintf(stderr, "  total      %7ld\n", (long)tsize);
+      }
+   }
+
+/*
+ * align() outputs zeroes as padding until pc is a multiple of WordSize.
+ */
+static void align()
+   {
+   static word x = 0;
+
+   if (pc % WordSize != 0)
+      outblock((char *)&x, (int)(WordSize - (pc % WordSize)));
+   }
+
+/*
+ * misalign() outputs a Noop instruction for padding if pc + sizeof(int)
+ *  is not a multiple of WordSize.  This is for operations that output
+ *  an int opcode followed by an operand that needs to be word-aligned.
+ */
+static void misalign()
+   {
+   if ((pc + IntBits/ByteBits) % WordSize != 0)
+      lemit(Op_Noop, "noop [pad]");
+   }
+
+/*
+ * intout(i) outputs i as an int that is used by the runtime system
+ *  IntBits/ByteBits bytes must be moved from &word[0] to &codep[0].
+ */
+static void intout(oint)
+int oint;
+   {
+   int i;
+   union {
+      int i;
+      char c[IntBits/ByteBits];
+      } u;
+
+   CodeCheck(IntBits/ByteBits);
+   u.i = oint;
+
+   for (i = 0; i < IntBits/ByteBits; i++)
+      codep[i] = u.c[i];
+
+   codep += IntBits/ByteBits;
+   pc += IntBits/ByteBits;
+   }
+
+#ifdef FieldTableCompression
+/*
+ * charout(i) outputs i as an unsigned char that is used by the runtime system
+ */
+static void charout(unsigned char ochar)
+   {
+   CodeCheck(1);
+   *codep++ = (unsigned char)ochar;
+   pc++;
+   }
+/*
+ * shortout(i) outputs i as a short that is used by the runtime system
+ *  IntBits/ByteBits bytes must be moved from &word[0] to &codep[0].
+ */
+static void shortout(short oint)
+   {
+   int i;
+   union {
+      short i;
+      char c[2];
+      } u;
+
+   CodeCheck(2);
+   u.i = oint;
+
+   for (i = 0; i < 2; i++)
+      codep[i] = u.c[i];
+
+   codep += 2;
+   pc += 2;
+   }
+#endif					/* FieldTableCompression */
+
+
+/*
+ * wordout(i) outputs i as a word that is used by the runtime system
+ *  WordSize bytes must be moved from &oword[0] to &codep[0].
+ */
+static void wordout(oword)
+word oword;
+   {
+   int i;
+   union {
+        word i;
+        char c[WordSize];
+        } u;
+
+   CodeCheck(WordSize);
+   u.i = oword;
+
+   for (i = 0; i < WordSize; i++)
+      codep[i] = u.c[i];
+
+   codep += WordSize;
+   pc += WordSize;
+   }
+
+/*
+ * outblock(a,i) output i bytes starting at address a.
+ */
+static void outblock(addr,count)
+char *addr;
+int count;
+   {
+   CodeCheck(count);
+   pc += count;
+   while (count--)
+      *codep++ = *addr++;
+   }
+
+#ifdef DeBugLinker
+   /*
+    * dumpblock(a,i) dump contents of i bytes at address a, used only
+    *  in conjunction with -L.
+    */
+   static void dumpblock(addr, count)
+   char *addr;
+   int count;
+      {
+      int i;
+      for (i = 0; i < count; i++) {
+         if ((i & 7) == 0)
+            fprintf(dbgfile,"\n\t");
+         fprintf(dbgfile," %03o",(0377 & (unsigned)addr[i]));
+         }
+      putc('\n',dbgfile);
+      }
+   #endif				/* DeBugLinker */
+
+/*
+ * flushcode - write buffered code to the output file.
+ */
+static void flushcode()
+   {
+   if (codep > codeb)
+      if (longwrite(codeb, DiffPtrs(codep,codeb), outfile) < 0)
+         quit("cannot write icode file");
+   codep = codeb;
+   }
+
+/*
+ * clearlab - clear label table to all zeroes.
+ */
+static void clearlab()
+   {
+   register int i;
+
+   for (i = 0; i < maxlabels; i++)
+      labels[i] = 0;
+   }
+
+/*
+ * backpatch - fill in all forward references to lab.
+ */
+static void backpatch(lab)
+int lab;
+   {
+   word p, r;
+   char *q;
+   char *cp, *cr;
+   register int j;
+
+   if (lab >= maxlabels)
+      labels  = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word),
+         lab - maxlabels + 1, "labels");
+
+   p = labels[lab];
+   if (p > 0)
+      quit("multiply defined label in ucode");
+   while (p < 0) {		/* follow reference chain */
+      r = pc - (WordSize - p);	/* compute relative offset */
+      q = codep - (pc + p);	/* point to word with address */
+      cp = (char *) &p;		/* address of integer p       */
+      cr = (char *) &r;		/* address of integer r       */
+      for (j = 0; j < WordSize; j++) {	  /* move bytes from word pointed to */
+         *cp++ = *q;			  /* by q to p, and move bytes from */
+         *q++ = *cr++;			  /* r to word pointed to by q */
+         }			/* moves integers at arbitrary addresses */
+      }
+   labels[lab] = pc;
+   }
+
+#ifdef DeBugLinker
+   void idump(s)		/* dump code region */
+      char *s;
+      {
+      int *c;
+
+      fprintf(stderr,"\ndump of code region %s:\n",s);
+      for (c = (int *)codeb; c < (int *)codep; c++)
+          fprintf(stderr,"%ld: %d\n",(long)c, (int)*c);
+      fflush(stderr);
+      }
+   #endif				/* DeBugLinker */
diff --git a/src/icont/lfile.h b/src/icont/lfile.h
new file mode 100644
index 0000000..1da9746
--- /dev/null
+++ b/src/icont/lfile.h
@@ -0,0 +1,21 @@
+/*
+ * A linked list of files named by link declarations is maintained using
+ *  lfile structures.
+ */
+struct lfile {
+   char *lf_name;		/* name of the file */
+   struct lfile *lf_link;	/* pointer to next file */
+   };
+
+extern struct lfile *lfiles;
+
+
+/*
+ * "Invocable" declarations are recorded in a list of invkl structs.
+ */
+struct invkl {
+   char *iv_name;		/* name of global */
+   struct invkl *iv_link;	/* link to next entry */
+   };
+
+extern struct invkl *invkls;
diff --git a/src/icont/lglob.c b/src/icont/lglob.c
new file mode 100644
index 0000000..6583b8a
--- /dev/null
+++ b/src/icont/lglob.c
@@ -0,0 +1,356 @@
+/*
+ * lglob.c -- routines for processing globals.
+ */
+
+#include "link.h"
+#include "tglobals.h"
+#include "tproto.h"
+#include "opcode.h"
+#include "../h/version.h"
+
+/*
+ * Prototypes.
+ */
+
+static void	scanfile	(char *filename);
+static void	reference	(struct gentry *gp);
+
+int nrecords = 0;		/* number of records in program */
+
+/*
+ * readglob reads the global information from infile (.u2) and merges it with
+ *  the global table and record table.
+ */
+void readglob()
+   {
+   register word id;
+   register int n, op;
+   int k;
+   int implicit;
+   char *name;
+   struct gentry *gp;
+   extern char *progname;
+
+   if (getopc(&name) != Op_Version)
+      quitf("ucode file %s has no version identification",inname);
+   id = getid();		/* get version number of ucode */
+   newline();
+   if (strcmp(&lsspace[id],UVersion)) {
+      fprintf(stderr,"version mismatch in ucode file %s\n",inname);
+      fprintf(stderr,"\tucode version: %s\n",&lsspace[id]);
+      fprintf(stderr,"\texpected version: %s\n",UVersion);
+      exit(EXIT_FAILURE);
+      }
+   while ((op = getopc(&name)) != EOF) {
+      switch (op) {
+         case Op_Record:	/* a record declaration */
+            id = getid();	/* record name */
+            n = getdec();	/* number of fields */
+            newline();
+            gp = glocate(id);
+            /*
+             * It's ok if the name isn't already in use or if the
+             *  name is just used in a "global" declaration.  Otherwise,
+             *  it is an inconsistent redeclaration.
+             */
+            if (gp == NULL || (gp->g_flag & ~F_Global) == 0) {
+               gp = putglobal(id, F_Record, n, ++nrecords);
+               while (n--) {	/* loop reading field numbers and names */
+                  k = getdec();
+                  putfield(getid(), gp, k);
+                  newline();
+                  }
+               }
+            else {
+               lfatal(&lsspace[id], "inconsistent redeclaration");
+               while (n--)
+                  newline();
+               }
+            break;
+
+         case Op_Impl:		/* undeclared identifiers should be noted */
+            if (getopc(&name) == Op_Local)
+               implicit = 0;
+            else
+               implicit = F_ImpError;
+            break;
+
+         case Op_Trace:		/* turn on tracing */
+            trace = -1;
+            break;
+
+         case Op_Global:	/* global variable declarations */
+            n = getdec();	/* number of global declarations */
+            newline();
+            while (n--) {	/* process each declaration */
+               getdec();	/* throw away sequence number */
+               k = getoct();	/* get flags */
+               if (k & F_Proc)
+                  k |= implicit;
+               id = getid();	/* get variable name */
+               gp = glocate(id);
+               /*
+                * Check for conflicting declarations and install the
+                *  variable.
+                */
+               if (gp != NULL && (k & F_Proc) && gp->g_flag != F_Global)
+                  lfatal(&lsspace[id], "inconsistent redeclaration");
+               else if (gp == NULL || (k & F_Proc))
+                  putglobal(id, k, getdec(), 0);
+               newline();
+               }
+            break;
+
+         case Op_Invocable:	/* "invocable" declaration */
+            id = getid();	/* get name */
+            if (lsspace[id] == '0')
+               strinv = 1;	/* name of "0" means "invocable all" */
+            else
+               addinvk(&lsspace[id], 2);
+            newline();
+            break;
+
+         case Op_Link:		/* link the named file */
+            name = &lsspace[getrest()];	/* get the name and */
+            alsolink(name);	/*  put it on the list of files to link */
+            newline();
+            break;
+
+         default:
+            quitf("ill-formed global file %s",inname);
+         }
+      }
+   }
+
+/*
+ * scanrefs - scan .u1 files for references and mark unreferenced globals.
+ *
+ * Called only if -fs is *not* specified (or implied by "invocable all").
+ */
+void scanrefs()
+   {
+   int i, n;
+   char *t, *old;
+   struct fentry *fp, **fpp;
+   struct gentry *gp, **gpp;
+   struct rentry *rp;
+   struct lfile *lf, *lfls;
+   struct ientry *ip, *ipnext;
+   struct invkl *inv;
+
+   /*
+    * Loop through .u1 files and accumulate reference lists.
+    */
+   lfls = llfiles;
+   while ((lf = getlfile(&lfls)) != 0)
+      scanfile(lf->lf_name);
+   lstatics = 0;			/* discard accumulated statics */
+
+   /*
+    * Mark every global as unreferenced.
+    */
+   for (gp = lgfirst; gp != NULL; gp = gp->g_next)
+      gp->g_flag |= F_Unref;
+
+   /*
+    * Clear the F_Unref flag for referenced globals, starting with main()
+    * and marking references within procedures recursively.
+    */
+   reference(lgfirst);
+
+   /*
+    * Reference (recursively) every global declared to be "invocable".
+    */
+   for (inv = invkls; inv != NULL; inv = inv->iv_link)
+      if ((gp = glocate(instid(inv->iv_name))) != NULL)
+         reference(gp);
+
+   /*
+    * Rebuild the global list to include only referenced globals,
+    * and renumber them.  Also renumber all record constructors.
+    * Free all reference lists.
+    */
+   n = 0;
+   nrecords = 0;
+   gpp = &lgfirst;
+   while ((gp = *gpp) != NULL) {
+      if (gp->g_refs != NULL) {
+         free((char *)gp->g_refs);		/* free the reference list */
+         gp->g_refs = NULL;
+         }
+      if (gp->g_flag & F_Unref) {
+         /*
+          *  Global is not referenced anywhere.
+          */
+         gp->g_index = gp->g_procid = -1;	/* flag as unused */
+         if (verbose >= 3) {
+            if (gp->g_flag & F_Proc)
+               t = "procedure";
+            else if (gp->g_flag & F_Record)
+               t = "record   ";
+            else
+               t = "global   ";
+            if (!(gp->g_flag & F_Builtin))
+               fprintf(stderr, "  discarding %s %s\n", t, &lsspace[gp->g_name]);
+            }
+         *gpp = gp->g_next;
+         }
+      else {
+         /*
+          *  The global is used.  Assign it new serial number(s).
+          */
+         gp->g_index = n++;
+         if (gp->g_flag & F_Record)
+            gp->g_procid = ++nrecords;
+         gpp = &gp->g_next;
+         }
+      }
+
+   /*
+    * Rebuild the field list to include only referenced fields,
+    * and renumber them.
+    */
+   n = 0;
+   fpp = &lffirst;
+   while ((fp = *fpp) != NULL) {
+      for (rp = fp->f_rlist; rp != NULL; rp = rp->r_link)
+         if (rp->r_gp->g_procid > 0)	/* if record was referenced */
+            break;
+      if (rp == NULL) {
+         /*
+          *  The field was used only in unreferenced record constructors.
+          */
+         fp->f_fid = 0;
+         *fpp = fp->f_nextentry;
+         }
+      else {
+         /*
+          *  The field was referenced.  Give it the next number.
+          */
+         fp->f_fid = ++n;
+         fpp = &fp->f_nextentry;
+         }
+      }
+
+   /*
+    * Create a new, empty string space, saving a pointer to the old one.
+    * Clear the old identifier hash table.
+    */
+   old = lsspace;
+   lsspace = (char *)tcalloc(stsize, 1);
+   lsfree = 0;
+   for (i = 0; i < ihsize; i++) {
+      for (ip = lihash[i]; ip != NULL; ip = ipnext) {
+         ipnext = ip->i_blink;
+         free((char *)ip);
+         }
+      lihash[i] = NULL;
+      }
+
+   /*
+    * Reinstall the global identifiers that are actually referenced.
+    * This changes the hashing, so clear and rebuild the hash table.
+    */
+   for (i = 0; i < ghsize; i++)
+      lghash[i] = NULL;
+   for (gp = lgfirst; gp != NULL; gp = gp->g_next) {
+      gp->g_name = instid(&old[gp->g_name]);
+      i = ghasher(gp->g_name);
+      gp->g_blink = lghash[i];
+      lghash[i] = gp;
+      }
+
+   /*
+    * Reinstall the referenced record fields in similar fashion.
+    */
+   for (i = 0; i < fhsize; i++)
+      lfhash[i] = NULL;
+   for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) {
+      fp->f_name = instid(&old[fp->f_name]);
+      i = fhasher(fp->f_name);
+      fp->f_blink = lfhash[i];
+      lfhash[i] = fp;
+      }
+
+   /*
+    * Free the old string space.
+    */
+   free((char *)old);
+   }
+
+/*
+ * scanfile -- scan one file for references.
+ */
+static void scanfile(filename)
+char *filename;
+   {
+   int i, k, f, op, nrefs, flags;
+   word id, procid;
+   char *name;
+   struct gentry *gp, **rp;
+
+   makename(inname, SourceDir, filename, U1Suffix);
+   infile = fopen(inname, "r");
+   if (infile == NULL)
+      quitf("cannot open %s", inname);
+
+   while ((op = getopc(&name)) != EOF) {
+      switch (op) {
+         case Op_Proc:
+            procid = getid();
+            newline();
+            gp = glocate(procid);
+            locinit();
+            nrefs = 0;
+            break;
+         case Op_Local:
+            k = getdec();
+            flags = getoct();
+            id = getid();
+            putlocal(k, id, flags, 0, procid);
+            lltable[k].l_flag |= F_Unref;
+            break;
+         case Op_Var:
+            k = getdec();
+            newline();
+            f = lltable[k].l_flag;
+            if ((f & F_Global) && (f & F_Unref)) {
+               lltable[k].l_flag = f & ~F_Unref;
+               nrefs++;
+               }
+            break;
+         case Op_End:
+            newline();
+            if (nrefs > 0) {
+               rp = (struct gentry **)tcalloc(nrefs + 1, sizeof(*rp));
+               gp->g_refs = rp;
+               for (i = 0; i <= nlocal; i++)
+                  if ((lltable[i].l_flag & (F_Unref + F_Global)) == F_Global)
+                     *rp++ = lltable[i].l_val.global;
+               *rp = NULL;
+               }
+            break;
+         default:
+            newline();
+            break;
+         }
+      }
+
+   fclose(infile);
+   }
+
+/*
+ *
+ */
+static void reference(gp)
+struct gentry *gp;
+   {
+   struct gentry **rp;
+
+   if (gp->g_flag & F_Unref) {
+      gp->g_flag &= ~F_Unref;
+      if ((rp = gp->g_refs) != NULL)
+         while ((gp = *rp++) != 0)
+            reference(gp);
+      }
+   }
diff --git a/src/icont/link.c b/src/icont/link.c
new file mode 100644
index 0000000..362b257
--- /dev/null
+++ b/src/icont/link.c
@@ -0,0 +1,228 @@
+/*
+ * link.c -- linker main program that controls the linking process.
+ */
+
+#include "link.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "../h/header.h"
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#ifdef BinaryHeader
+   #include "hdr.h"
+#endif					/* BinaryHeader */
+
+static	void	setexe	(char *fname);
+
+FILE *infile;				/* input file (.u1 or .u2) */
+FILE *outfile;				/* interpreter code output file */
+
+#ifdef DeBugLinker
+   FILE *dbgfile;			/* debug file */
+   static char dbgname[MaxPath];	/* debug file name */
+#endif					/* DeBugLinker */
+
+struct lfile *llfiles = NULL;		/* List of files to link */
+
+char inname[MaxPath];			/* input file name */
+
+char icnname[MaxPath];			/* current icon source file name */
+int colmno = 0;				/* current source column number */
+int lineno = 0;				/* current source line number */
+int fatals = 0;				/* number of errors encountered */
+
+/*
+ *  ilink - link a number of files, returning error count
+ */
+int ilink(ifiles,outname)
+char **ifiles;
+char *outname;
+   {
+   int i;
+   struct lfile *lf,*lfls;
+   char *filename;			/* name of current input file */
+
+   linit();				/* initialize memory structures */
+   while (*ifiles)
+      alsolink(*ifiles++);		/* make initial list of files */
+
+   /*
+    * Phase I: load global information contained in .u2 files into
+    *  data structures.
+    *
+    * The list of files to link is maintained as a queue with llfiles
+    *  as the base.  lf moves along the list.  Each file is processed
+    *  in turn by forming .u2 and .icn names from each file name, each
+    *  of which ends in .u1.  The .u2 file is opened and globals is called
+    *  to process it.  When the end of the list is reached, lf becomes
+    *  NULL and the loop is terminated, completing phase I.  Note that
+    *  link instructions in the .u2 file cause files to be added to list
+    *  of files to link.
+    */
+   for (lf = llfiles; lf != NULL; lf = lf->lf_link) {
+      filename = lf->lf_name;
+      makename(inname, SourceDir, filename, U2Suffix);
+      makename(icnname, TargetDir, filename, SourceSuffix);
+      infile = fopen(inname, "r");
+      if (infile == NULL)
+         quitf("cannot open %s",inname);
+      readglob();
+      fclose(infile);
+      }
+
+   /* Phase II (optional): scan code and suppress unreferenced procs. */
+   if (!strinv)
+      scanrefs();
+
+   /* Phase III: resolve undeclared variables and generate code. */
+
+   /*
+    * Open the output file.
+    */
+   outfile = fopen(outname, "wb");
+
+   if (outfile == NULL) {		/* may exist, but can't open for "w" */
+      ofile = NULL;			/* so don't delete if it's there */
+      quitf("cannot create %s",outname);
+      }
+
+   /*
+    * Write the bootstrap header to the output file.
+    */
+   #ifdef BinaryHeader
+      /*
+       *  With BinaryHeader defined, always write MaxHdr bytes.
+       */
+      fwrite(iconxhdr, sizeof(char), MaxHdr, outfile);
+      hdrsize = MaxHdr;
+
+   #else				/* BinaryHeader */
+      /*
+       *  Write a short shell header terminated by \n\f\n\0.
+       *  Use magic "#!/bin/sh" to ensure that $0 is set when run via $PATH.
+       *  Pad header to a multiple of 8 characters.
+       *
+       *  The shell header searches for iconx in this order:
+       *     a.  location specified by ICONX environment variable
+       *         (if specified, this MUST work, else the script exits)
+       *     b.  iconx in same directory as executing binary
+       *     c.  location specified in script
+       *         (as generated by icont or as patched later)
+       *     d.  iconx in $PATH
+       *
+       *  The ugly ${1+"$@"} is a workaround for non-POSIX handling
+       *  of "$@" by some shells in the absence of any arguments.
+       *  Thanks to the Unix-haters handbook for this trick.
+       */
+      {
+      char script[2 * MaxPath + 300];
+      sprintf(script, "%s\n%s%-72s\n%s\n\n%s\n%s\n%s\n%s\n\n%s\n",
+         "#!/bin/sh",
+         "IXBIN=", iconxloc,
+         "IXLCL=`echo $0 | sed 's=[^/]*$=iconx='`",
+         "[ -n \"$ICONX\" ] && exec \"$ICONX\" $0 ${1+\"$@\"}",
+         "[ -x \"$IXLCL\" ] && exec \"$IXLCL\" $0 ${1+\"$@\"}",
+         "[ -x \"$IXBIN\" ] && exec \"$IXBIN\" $0 ${1+\"$@\"}",
+         "exec iconx $0 ${1+\"$@\"}",
+         "[executable Icon binary follows]");
+      strcat(script, "        \n\f\n" + ((int)(strlen(script) + 4) % 8));
+      hdrsize = strlen(script) + 1;	/* length includes \0 at end */
+      fwrite(script, hdrsize, 1, outfile);	/* write header */
+      }
+
+   #endif				/* BinaryHeader */
+
+   for (i = sizeof(struct header); i--;)
+      putc(0, outfile);
+   fflush(outfile);
+   if (ferror(outfile) != 0)
+      quit("unable to write to icode file");
+
+   #ifdef DeBugLinker
+      /*
+       * Open the .ux file if debugging is on.
+       */
+      if (Dflag) {
+         makename(dbgname, TargetDir, llfiles->lf_name, ".ux");
+         dbgfile = fopen(dbgname, "w");
+         if (dbgfile == NULL)
+            quitf("cannot create %s", dbgname);
+         }
+   #endif				/* DeBugLinker */
+
+   /*
+    * Loop through input files and generate code for each.
+    */
+   lfls = llfiles;
+   while ((lf = getlfile(&lfls)) != 0) {
+      filename = lf->lf_name;
+      makename(inname, SourceDir, filename, U1Suffix);
+      makename(icnname, TargetDir, filename, SourceSuffix);
+      infile = fopen(inname, "r");
+      if (infile == NULL)
+         quitf("cannot open %s", inname);
+      gencode();
+      fclose(infile);
+      }
+
+   gentables();		/* Generate record, field, global, global names,
+			   static, and identifier tables. */
+
+   fclose(outfile);
+   lmfree();
+   if (fatals > 0)
+      return fatals;
+   setexe(outname);
+   return 0;
+   }
+
+/*
+ * lwarn - issue a linker warning message.
+ */
+void lwarn(s1, s2, s3)
+char *s1, *s2, *s3;
+   {
+   fprintf(stderr, "%s: ", icnname);
+   if (lineno)
+      fprintf(stderr, "Line %d # :", lineno);
+   fprintf(stderr, "\"%s\": %s%s\n", s1, s2, s3);
+   fflush(stderr);
+   }
+
+/*
+ * lfatal - issue a fatal linker error message.
+ */
+
+void lfatal(s1, s2)
+char *s1, *s2;
+   {
+   fatals++;
+   fprintf(stderr, "%s: ", icnname);
+   if (lineno)
+      fprintf(stderr, "Line %d # : ", lineno);
+   fprintf(stderr, "\"%s\": %s\n", s1, s2);
+   }
+
+/*
+ * setexe - mark the output file as executable
+ */
+
+static void setexe(fname)
+char *fname;
+   {
+   struct stat stbuf;
+   int u, r, m;
+   /*
+    * Set each of the three execute bits (owner,group,other) if allowed by
+    *  the current umask and if the corresponding read bit is set; do not
+    *  clear any bits already set.
+    */
+   umask(u = umask(0));			/* get and restore umask */
+   if (stat(fname,&stbuf) == 0)  {	/* must first read existing mode */
+      r = (stbuf.st_mode & 0444) >> 2;	/* get & position read bits */
+      m = stbuf.st_mode | (r & ~u);	/* set execute bits */
+      chmod(fname,m);			/* change file mode */
+      }
+   }
diff --git a/src/icont/link.h b/src/icont/link.h
new file mode 100644
index 0000000..f49d436
--- /dev/null
+++ b/src/icont/link.h
@@ -0,0 +1,143 @@
+/*
+ * External declarations for the linker.
+ */
+
+#include "../h/rt.h"
+
+/*
+ * Miscellaneous external declarations.
+ */
+
+extern FILE *infile;		/* current input file */
+extern FILE *outfile;		/* linker output file */
+extern FILE *dbgfile;		/* debug file */
+extern char inname[];		/* input file name */
+extern char icnname[];		/* source program file name */
+extern int lineno;		/* source program line number (from ucode) */
+extern int colmno;		/* source program column number */
+
+extern int lstatics;		/* total number of statics */
+extern int argoff;		/* stack offset counter for arguments */
+extern int dynoff;		/* stack offset counter for locals */
+extern int static1;		/* first static in procedure */
+extern int nlocal;		/* number of locals in local table */
+extern int nconst;		/* number of constants in constant table */
+extern int nrecords;		/* number of records in program */
+extern int trace;		/* initial setting of &trace */
+extern char ixhdr[];		/* header line for direct execution */
+extern char *iconx;		/* location of iconx */
+extern int hdrloc;		/* location to place hdr block at */
+extern struct lfile *llfiles;	/* list of files to link */
+
+/*
+ * Structures for symbol table entries.
+ */
+
+struct lentry {			/* local table entry */
+   word  l_name;		/*   index into string space of variable name */
+   int l_flag;			/*   variable flags */
+   union {			/*   value field */
+      int staticid;		/*     unique id for static variables */
+      word offset;		/*     stack offset for args and locals */
+      struct gentry *global;	/*     global table entry */
+      } l_val;
+   };
+
+struct gentry {			/* global table entry */
+   struct gentry *g_blink;	/*   link for bucket chain */
+   word g_name;			/*   index into string space of variable name */
+   int g_flag;			/*   variable flags */
+   int g_nargs;			/*   number of args or fields */
+   int g_procid;		/*   procedure or record id */
+   word g_pc;			/*   position in icode of object */
+   int g_index;			/*   "index" in global table */
+   struct gentry **g_refs;	/*   other globals referenced, if a proc */
+   struct gentry *g_next;	/*   next global in table */
+   };
+
+struct centry {			/* constant table entry */
+   int c_flag;			/*   type of literal flag */
+   union xval c_val;		/*   value field */
+   int c_length;		/*   length of literal string */
+   word c_pc;			/*   position in icode of object */
+   };
+
+struct ientry {			/* identifier table entry */
+   struct ientry *i_blink;	/*   link for bucket chain */
+   word i_name;			/*   index into string space of string */
+   int i_length;		/*   length of string */
+   };
+
+struct fentry {			/* field table header entry */
+   struct fentry *f_blink;	/*   link for bucket chain */
+   word f_name;			/*   index into string space of field name */
+   int f_fid;			/*   field id */
+   struct rentry *f_rlist;	/*   head of list of records */
+   struct fentry *f_nextentry;	/*   next field name in allocation order */
+   };
+
+struct rentry {			/* field table record list entry */
+   struct rentry *r_link;	/*   link for list of records */
+   struct gentry *r_gp;		/*   global entry for record */
+   int r_fnum;			/*   offset of field within record */
+   };
+
+#include "lfile.h"
+
+/*
+ * Flag values in symbol tables.
+ */
+
+#define F_Global	    01	/* variable declared global externally */
+#define F_Unref		    02	/* procedure is unreferenced */
+#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_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 */
+
+/*
+ * Symbol table region pointers.
+ */
+
+extern struct gentry **lghash;	/* hash area for global table */
+extern struct ientry **lihash;	/* hash area for identifier table */
+extern struct fentry **lfhash;	/* hash area for field table */
+
+extern struct lentry *lltable;	/* local table */
+extern struct centry *lctable;	/* constant table */
+extern struct ipc_fname *fnmtbl; /* table associating ipc with file name */
+extern struct ipc_line *lntable; /* table associating ipc with line number */
+extern char *lsspace;		/* string space */
+extern word *labels;		/* label table */
+extern char *codeb;		/* generated code space */
+
+extern struct ipc_fname *fnmfree; /* free pointer for ipc/file name tbl */
+extern struct ipc_line *lnfree;	/* free pointer for ipc/line number tbl */
+extern word lsfree;		/* free index for string space */
+extern char *codep;		/* free pointer for code space */
+
+extern struct fentry *lffirst;	/* first field table entry */
+extern struct fentry *lflast;	/* last field table entry */
+extern struct gentry *lgfirst;	/* first global table entry */
+extern struct gentry *lglast;	/* last global table entry */
+
+
+/*
+ * Hash computation macros.
+ */
+
+#define ghasher(x)	(((word)x)&gmask)	/* for global table */
+#define fhasher(x)	(((word)x)&fmask)	/* for field table */
+
+/*
+ * Machine-dependent constants.
+ */
+
+#define RkBlkSize(gp) ((9*WordSize)+(gp)->g_nargs * sizeof(struct descrip))
diff --git a/src/icont/llex.c b/src/icont/llex.c
new file mode 100644
index 0000000..8b62d59
--- /dev/null
+++ b/src/icont/llex.c
@@ -0,0 +1,318 @@
+/*
+ * llex.c -- lexical analysis routines.
+ */
+
+#include "link.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "opcode.h"
+
+int nlflag = 0;		/* newline last seen */
+
+#define tonum(c)	(isdigit(c) ? (c - '0') : ((c & 037) + 9))
+
+/*
+ * getopc - get an opcode from infile, return the opcode number (via
+ *  binary search of opcode table), and point id at the name of the opcode.
+ */
+int getopc(id)
+char **id;
+   {
+   register char *s;
+   register struct opentry *p;
+   register int test;
+   word indx;
+   int low, high, cmp;
+
+   indx = getstr();
+   if (indx == -1)
+      return EOF;
+   s = &lsspace[indx];
+   low = 0;
+   high = NOPCODES;
+   do {
+      test = (low + high) / 2;
+      p = &optable[test];
+      if ((cmp = strcmp(p->op_name, s)) < 0)
+         low = test + 1;
+      else if (cmp > 0)
+         high = test;
+      else {
+         *id = p->op_name;
+         return (p->op_code);
+         }
+      } while (low < high);
+   *id = s;
+   return 0;
+   }
+
+/*
+ * getid - get an identifier from infile, put it in the identifier
+ *  table, and return a index to it.
+ */
+word getid()
+   {
+   word indx;
+
+   indx = getstr();
+   if (indx == -1)
+      return EOF;
+   return putident((int)strlen(&lsspace[indx])+1, 1);
+   }
+
+/*
+ * getstr - get an identifier from infile and return an index to it.
+ */
+word getstr()
+   {
+   register int c;
+   register word indx;
+
+   indx = lsfree;
+   while ((c = getc(infile)) == ' ' || c == '\t') ;
+   if (c == EOF)
+      return -1;
+   while (c != ' ' && c != '\t' && c != '\n' && c != ',' && c != EOF) {
+      if (indx >= stsize)
+         lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+            "string space");
+      lsspace[indx++] = c;
+      c = getc(infile);
+      }
+   if (indx >= stsize)
+      lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+         "string space");
+   lsspace[indx] = '\0';
+   nlflag = (c == '\n');
+   return lsfree;
+   }
+
+/*
+ * getrest - get the rest of the line from infile, put it in the identifier
+ *  table, and return its index in the string space.
+ */
+word getrest()
+   {
+   register int c;
+   register word indx;
+
+   indx = lsfree;
+   while ((c = getc(infile)) != '\n' && c != EOF) {
+      if (indx >= stsize)
+         lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+            "string space");
+      lsspace[indx++] = c;
+      }
+   if (indx >= stsize)
+      lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+         "string space");
+   lsspace[indx++] = '\0';
+   nlflag = (c == '\n');
+   return putident((int)(indx - lsfree), 1);
+   }
+
+/*
+ * getdec - get a decimal integer from infile, and return it.
+ */
+int getdec()
+   {
+   register int c, n;
+   int sign = 1, rv;
+
+   n = 0;
+   while ((c = getc(infile)) == ' ' || c == '\t') ;
+   if (c == EOF)
+      return 0;
+   if (c == '-') {
+      sign = -1;
+      c = getc(infile);
+      }
+   while (c >= '0' && c <= '9') {
+      n = n * 10 + (c - '0');
+      c = getc(infile);
+      }
+   nlflag = (c == '\n');
+   rv = n * sign;
+   return rv;					/* some compilers ... */
+   }
+
+/*
+ * getoct - get an octal number from infile, and return it.
+ */
+int getoct()
+   {
+   register int c, n;
+
+   n = 0;
+   while ((c = getc(infile)) == ' ' || c == '\t') ;
+   if (c == EOF)
+      return 0;
+   while (c >= '0' && c <= '7') {
+      n = (n << 3) | (c - '0');
+      c = getc(infile);
+      }
+   nlflag = (c == '\n');
+   return n;
+   }
+
+/*
+ *  Get integer, but if it's too large for a long, put the string via wp
+ *   and return -1.
+ */
+long getint(j,wp)
+   int j;
+   word *wp;
+   {
+   register int c;
+   int over = 0;
+   register word indx;
+   double result = 0;
+   long lresult = 0;
+   double radix;
+
+   ++j;   /* incase we need to add a '\0' and make it into a string */
+   if (lsfree + j >= stsize)
+      lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, j, "string space");
+   indx = lsfree;
+
+   while ((c = getc(infile)) >= '0' && c <= '9') {
+      lsspace[indx++] = c;
+      result = result * 10 + (c - '0');
+      lresult = lresult * 10 + (c - '0');
+      if (result <= MinLong || result >= MaxLong) {
+         over = 1;			/* flag overflow */
+         result = 0;			/* reset to avoid fp exception */
+         }
+      }
+   if (c == 'r' || c == 'R') {
+      lsspace[indx++] = c;
+      radix = result;
+      lresult = 0;
+      result = 0;
+      while ((c = getc(infile)) != 0) {
+         lsspace[indx++] = c;
+         if (isdigit(c) || isalpha(c))
+            c = tonum(c);
+         else
+            break;
+         result = result * radix + c;
+         lresult = lresult * radix + c;
+         if (result <= MinLong || result >= MaxLong) {
+            over = 1;			/* flag overflow */
+            result = 0;			/* reset to avoid fp exception */
+            }
+         }
+      }
+   nlflag = (c == '\n');
+   if (!over)
+      return lresult;			/* integer is small enough */
+   else {				/* integer is too large */
+      lsspace[indx++] = '\0';
+      *wp = putident((int)(indx - lsfree), 1); /* convert integer to string */
+      return -1;			/* indicate integer is too big */
+      }
+   }
+
+/*
+ * getreal - get an Icon real number from infile, and return it.
+ */
+double getreal()
+   {
+   double n;
+   register int c, d, e;
+   int esign;
+   register char *s, *ep;
+   char cbuf[128];
+
+   s = cbuf;
+   d = 0;
+   while ((c = getc(infile)) == '0')
+      ;
+   while (c >= '0' && c <= '9') {
+      *s++ = c;
+      d++;
+      c = getc(infile);
+      }
+   if (c == '.') {
+      if (s == cbuf)
+         *s++ = '0';
+      *s++ = c;
+      while ((c = getc(infile)) >= '0' && c <= '9')
+         *s++ = c;
+      }
+   ep = s;
+   if (c == 'e' || c == 'E') {
+      *s++ = c;
+      if ((c = getc(infile)) == '+' || c == '-') {
+         esign = (c == '-');
+         *s++ = c;
+         c = getc(infile);
+         }
+      else
+         esign = 0;
+      e = 0;
+      while (c >= '0' && c <= '9') {
+         e = e * 10 + c - '0';
+         *s++ = c;
+         c = getc(infile);
+         }
+      if (esign) e = -e;
+      e += d - 1;
+      if (abs(e) >= LogHuge)
+         *ep = '\0';
+      }
+   *s = '\0';
+   n = atof(cbuf);
+   nlflag = (c == '\n');
+   return n;
+   }
+
+/*
+ * getlab - get a label ("L" followed by a number) from infile,
+ *  and return the number.
+ */
+
+int getlab()
+   {
+   register int c;
+
+   while ((c = getc(infile)) != 'L' && c != EOF && c != '\n') ;
+   if (c == 'L')
+      return getdec();
+   nlflag = (c == '\n');
+   return 0;
+   }
+
+/*
+ * getstrlit - get a string literal from infile, as a string
+ *  of octal bytes, and return its index into the string table.
+ */
+word getstrlit(l)
+register int l;
+   {
+   register word indx;
+
+   if (lsfree + l >= stsize)
+      lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, l, "string space");
+   indx = lsfree;
+   while (!nlflag && l--)
+      lsspace[indx++] = getoct();
+   if (indx >= stsize)
+      lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+         "string space");
+   lsspace[indx++] = '\0';
+   return putident((int)(indx-lsfree), 1);
+   }
+
+/*
+ * newline - skip to next line.
+ */
+void newline()
+   {
+   register int c;
+
+   if (!nlflag) {
+      while ((c = getc(infile)) != '\n' && c != EOF) ;
+      }
+   nlflag = 0;
+   }
diff --git a/src/icont/lmem.c b/src/icont/lmem.c
new file mode 100644
index 0000000..8e091a5
--- /dev/null
+++ b/src/icont/lmem.c
@@ -0,0 +1,224 @@
+/*
+ * lmem.c -- memory initialization and allocation; also parses arguments.
+ */
+
+#include "link.h"
+#include "tproto.h"
+#include "tglobals.h"
+
+/*
+ * Prototypes.
+ */
+
+static struct	lfile *alclfile	(char *name);
+
+void dumplfiles(void);
+
+/*
+ * Memory initialization
+ */
+
+struct gentry **lghash;		/* hash area for global table */
+struct ientry **lihash;		/* hash area for identifier table */
+struct fentry **lfhash;		/* hash area for field table */
+
+struct lentry *lltable;		/* local table */
+struct centry *lctable;		/* constant table */
+struct ipc_fname *fnmtbl;	/* table associating ipc with file name */
+struct ipc_line *lntable;	/* table associating ipc with line number */
+
+char *lsspace;			/* string space */
+word *labels;			/* label table */
+char *codeb;			/* generated code space */
+
+struct ipc_fname *fnmfree;	/* free pointer for ipc/file name table */
+struct ipc_line *lnfree;	/* free pointer for ipc/line number table */
+word lsfree;			/* free index for string space */
+char *codep;			/* free pointer for code space */
+
+struct fentry *lffirst;		/* first field table entry */
+struct fentry *lflast;		/* last field table entry */
+struct gentry *lgfirst;		/* first global table entry */
+struct gentry *lglast;		/* last global table entry */
+
+/*
+ * linit - scan the command line arguments and initialize data structures.
+ */
+void linit()
+   {
+   struct gentry **gp;
+   struct ientry **ip;
+   struct fentry **fp;
+
+   llfiles = NULL;		/* Zero queue of files to link. */
+
+   /*
+    * Allocate the various data structures that are used by the linker.
+    */
+   lghash   = (struct gentry **) tcalloc(ghsize, sizeof(struct gentry *));
+   lihash   = (struct ientry **) tcalloc(ihsize, sizeof(struct ientry *));
+   lfhash   = (struct fentry **) tcalloc(fhsize, sizeof(struct fentry *));
+
+   lltable  = (struct lentry *) tcalloc(lsize, sizeof(struct lentry));
+   lctable  = (struct centry *) tcalloc(csize, sizeof(struct centry));
+
+   lnfree = lntable  = (struct ipc_line*)tcalloc(nsize,sizeof(struct ipc_line));
+
+   lsspace = (char *) tcalloc(stsize, sizeof(char));
+   lsfree = 0;
+
+   fnmtbl = (struct ipc_fname *) tcalloc(fnmsize, sizeof(struct ipc_fname));
+   fnmfree = fnmtbl;
+
+   labels  = (word *) tcalloc(maxlabels, sizeof(word));
+   codep = codeb = (char *) tcalloc(maxcode, 1);
+
+   lffirst = NULL;
+   lflast = NULL;
+   lgfirst = NULL;
+   lglast = NULL;
+
+   /*
+    * Zero out the hash tables.
+    */
+   for (gp = lghash; gp < &lghash[ghsize]; gp++)
+      *gp = NULL;
+   for (ip = lihash; ip < &lihash[ihsize]; ip++)
+      *ip = NULL;
+   for (fp = lfhash; fp < &lfhash[fhsize]; fp++)
+      *fp = NULL;
+
+   /*
+    * Install "main" as a global variable in order to insure that it
+    *  is the first global variable.  iconx/start.s depends on main
+    *  being global number 0.
+    */
+   putglobal(instid("main"), F_Global, 0, 0);
+   }
+
+#ifdef DeBugLinker
+   /*
+    * dumplfiles - print the list of files to link.  Used for debugging only.
+    */
+   void dumplfiles()
+      {
+      struct lfile *p,*lfls;
+
+      fprintf(stderr,"lfiles:\n");
+      lfls = llfiles;
+      while (p = getlfile(&lfls))
+          fprintf(stderr,"'%s'\n",p->lf_name);
+      fflush(stderr);
+      }
+#endif					/* DeBugLinker */
+
+/*
+ * alsolink - create an lfile structure for the named file and add it to the
+ *  end of the list of files (llfiles) to generate link instructions for.
+ */
+void alsolink(name)
+char *name;
+   {
+   struct lfile *nlf, *p;
+   char file[MaxPath];
+
+   if (!pathfind(file, ipath, name, U1Suffix))
+     quitf("cannot resolve reference to file '%s'",name);
+
+   nlf = alclfile(file);
+   if (llfiles == NULL) {
+      llfiles = nlf;
+      }
+   else {
+      p = llfiles;
+      while (p->lf_link != NULL) {
+        if (strcmp(p->lf_name,file) == 0)
+           return;
+        p = p->lf_link;
+        }
+      if (strcmp(p->lf_name,file) == 0)
+        return;
+      p->lf_link = nlf;
+      }
+   }
+
+/*
+ * getlfile - return a pointer (p) to the lfile structure pointed at by lptr
+ *  and move lptr to the lfile structure that p points at.  That is, getlfile
+ *  returns a pointer to the current (wrt. lptr) lfile and advances lptr.
+ */
+struct lfile *getlfile(lptr)
+struct lfile **lptr;
+   {
+   struct lfile *p;
+
+   if (*lptr == NULL)
+      return (struct lfile *)NULL;
+   else {
+      p = *lptr;
+      *lptr = p->lf_link;
+      return p;
+      }
+   }
+
+/*
+ * alclfile - allocate an lfile structure for the named file, fill
+ *  in the name and return a pointer to it.
+ */
+static struct lfile *alclfile(name)
+char *name;
+   {
+   struct lfile *p;
+
+   p = (struct lfile *) alloc(sizeof(struct lfile));
+   p->lf_link = NULL;
+   p->lf_name = salloc(name);
+   return p;
+   }
+
+/*
+ * lmfree - free memory used by the linker
+ */
+void lmfree()
+   {
+   struct fentry *fp, *fp1;
+   struct gentry *gp, *gp1;
+   struct rentry *rp, *rp1;
+   struct ientry *ip, *ip1;
+   int i;
+
+   for (i = 0; i < ihsize; ++i)
+      for (ip = lihash[i]; ip != NULL; ip = ip1) {
+           ip1 = ip->i_blink;
+           free((char *)ip);
+           }
+
+   free((char *) lghash);   lghash = NULL;
+   free((char *) lihash);   lihash = NULL;
+   free((char *) lfhash);   lfhash = NULL;
+   free((char *) lltable);   lltable = NULL;
+   free((char *) lctable);   lctable = NULL;
+   free((char *) lntable);   lntable = NULL;
+   free((char *) lsspace);   lsspace = NULL;
+   free((char *) fnmtbl);   fnmtbl = NULL;
+   free((char *) labels);   labels = NULL;
+   free((char *) codep);   codep = NULL;
+
+   for (fp = lffirst; fp != NULL; fp = fp1) {
+      for(rp = fp->f_rlist; rp != NULL; rp = rp1) {
+         rp1 = rp->r_link;
+         free((char *)rp);
+         }
+      fp1 = fp->f_nextentry;
+      free((char *)fp);
+      }
+   lffirst = NULL;
+   lflast = NULL;
+
+   for (gp = lgfirst; gp != NULL; gp = gp1) {
+      gp1 = gp->g_next;
+      free((char *)gp);
+      }
+   lgfirst = NULL;
+   lglast = NULL;
+   }
diff --git a/src/icont/lnklist.c b/src/icont/lnklist.c
new file mode 100644
index 0000000..f322355
--- /dev/null
+++ b/src/icont/lnklist.c
@@ -0,0 +1,83 @@
+/*
+ * lnklist.c -- functions for handling file linking.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "lfile.h"
+
+/*
+ * Prototype.
+ */
+static	struct lfile *alclfile	(char *name);
+
+struct lfile *lfiles;
+struct invkl *invkls;
+
+/*
+ * addinvk adds an "invokable" name to the list.
+ *  n==1 if name is an identifier; otherwise it is a string literal.
+ */
+void addinvk(name, n)
+char *name;
+int n;
+   {
+   struct invkl *p;
+
+   if (n == 1) {			/* if identifier, must be "all" */
+      if (strcmp(name, "all") != 0) {
+         tfatal("invalid operand to invocable", name);
+         return;
+         }
+      else
+         name = "0";			/* "0" represents "all" */
+      }
+   else if (!isalpha(name[0]) && (name[0] != '_'))
+      return;				/* if operator, ignore */
+
+   p = alloc(sizeof(struct invkl));
+   if (!p)
+      tsyserr("not enough memory for invocable list");
+   p->iv_name = salloc(name);
+   p->iv_link = invkls;
+   invkls = p;
+   }
+
+/*
+ * alclfile allocates an lfile structure for the named file, fills
+ *  in the name and returns a pointer to it.
+ */
+static struct lfile *alclfile(name)
+char *name;
+   {
+   struct lfile *p;
+
+   p = alloc(sizeof(struct lfile));
+   if (!p)
+      tsyserr("not enough memory for file list");
+   p->lf_link = NULL;
+   p->lf_name = salloc(name);
+   return p;
+   }
+
+/*
+ * addlfile creates an lfile structure for the named file and add it to the
+ *  end of the list of files (lfiles) to generate link instructions for.
+ */
+void addlfile(name)
+char *name;
+   {
+   struct lfile *nlf, *p;
+
+   nlf = alclfile(name);
+   if (lfiles == NULL) {
+      lfiles = nlf;
+      }
+   else {
+      p = lfiles;
+      while (p->lf_link != NULL) {
+         p = p->lf_link;
+         }
+      p->lf_link = nlf;
+      }
+   }
diff --git a/src/icont/lsym.c b/src/icont/lsym.c
new file mode 100644
index 0000000..83b6768
--- /dev/null
+++ b/src/icont/lsym.c
@@ -0,0 +1,446 @@
+/*
+ * lsym.c -- functions for symbol table manipulation.
+ */
+
+#include "link.h"
+#include "tproto.h"
+#include "tglobals.h"
+
+/*
+ * Prototypes.
+ */
+
+static struct	fentry *alcfhead
+   (struct fentry *blink, word name, int fid, struct rentry *rlist);
+static struct	rentry *alcfrec
+   (struct rentry *link, struct gentry *gp, int fnum);
+static struct	gentry *alcglobal
+   (struct gentry *blink, word name, int flag, int nargs, int procid);
+static struct	ientry *alcident	(char *nam, int len);
+
+int dynoff;			/* stack offset counter for locals */
+int argoff;			/* stack offset counter for arguments */
+int static1;			/* first static in procedure */
+int lstatics = 0;		/* static variable counter */
+
+int nlocal;			/* number of locals in local table */
+int nconst;			/* number of constants in constant table */
+int nfields = 0;		/* number of fields in field table */
+
+/*
+ * instid - copy the string s to the start of the string free space
+ *  and call putident with the length of the string.
+ */
+word instid(s)
+char *s;
+   {
+   register int l;
+   register word indx;
+   register char *p;
+
+   indx = lsfree;
+   p = s;
+   l = 0;
+   do {
+      if (indx >= stsize)
+         lsspace = (char *)trealloc(lsspace, NULL, &stsize, 1, 1,
+            "string space");
+      l++;
+      } while ((lsspace[indx++] = *p++) != 0);
+
+   return putident(l, 1);
+   }
+
+/*
+ * putident - install the identifier named by the string starting at lsfree
+ *  and extending for len bytes.  The installation entails making an
+ *  entry in the identifier hash table and then making an identifier
+ *  table entry for it with alcident.  A side effect of installation
+ *  is the incrementing of lsfree by the length of the string, thus
+ *  "saving" it.
+ *
+ * Nothing is changed if the identifier has already been installed.
+ *
+ * If "install" is 0, putident returns -1 for a nonexistent identifier,
+ * and does not install it.
+ */
+word putident(len, install)
+int len, install;
+   {
+   register int hash;
+   register char *s;
+   register struct ientry *ip;
+   int l;
+
+   /*
+    * Compute hash value by adding bytes and masking result with imask.
+    *  (Recall that imask is ihsize-1.)
+    */
+   s = &lsspace[lsfree];
+   hash = 0;
+   l = len;
+   while (l--)
+      hash += *s++;
+   l = len;
+   s = &lsspace[lsfree];
+   hash &= imask;
+   /*
+    * If the identifier hasn't been installed, install it.
+    */
+   if ((ip = lihash[hash]) != NULL) {	 /* collision */
+      for (;;) {
+         /*
+          * follow i_blink chain until id is found or end of chain reached
+          */
+         if (l == ip->i_length && lexeql(l, s, &lsspace[ip->i_name]))
+            return ip->i_name;		/* id is already installed, return it */
+         if (ip->i_blink == NULL) {	/* end of chain */
+            if (install == 0)
+               return -1;
+            ip->i_blink = alcident(s, l);
+            lsfree += l;
+            return ip->i_blink->i_name;
+            }
+         ip = ip->i_blink;
+         }
+      }
+   /*
+    * Hashed to an empty slot.
+    */
+   if (install == 0)
+      return -1;
+   lihash[hash] = alcident(s, l);
+   lsfree += l;
+   return lihash[hash]->i_name;
+   }
+
+/*
+ * lexeql - compare two strings of given length.  Returns non-zero if
+ *  equal, zero if not equal.
+ */
+int lexeql(l, s1, s2)
+register int l;
+register char *s1, *s2;
+   {
+   while (l--)
+      if (*s1++ != *s2++)
+         return 0;
+   return 1;
+   }
+
+/*
+ * alcident - get the next free identifier table entry, and fill it in with
+ *  the specified values.
+ */
+static struct ientry *alcident(nam, len)
+char *nam;
+int len;
+   {
+   register struct ientry *ip;
+
+   ip = NewStruct(ientry);
+   ip->i_blink = NULL;
+   ip->i_name = (word)(nam - lsspace);
+   ip->i_length = len;
+   return ip;
+   }
+
+/*
+ * locinit -  clear local symbol table.
+ */
+void locinit()
+   {
+   dynoff = 0;
+   argoff = 0;
+   nlocal = -1;
+   nconst = -1;
+   static1 = lstatics;
+   }
+
+/*
+ * putlocal - make a local symbol table entry.
+ */
+void putlocal(n, id, flags, imperror, procname)
+int n;
+word id;
+register int flags;
+int imperror;
+word procname;
+   {
+   register struct lentry *lp;
+   union {
+      struct gentry *gp;
+      int bn;
+      } p;
+
+   if (n >= lsize)
+      lltable  = (struct lentry *)trealloc(lltable, NULL, &lsize,
+         sizeof(struct lentry), 1, "local symbol table");
+   if (n > nlocal)
+      nlocal = n;
+   lp = &lltable[n];
+   lp->l_name = id;
+   lp->l_flag = flags;
+   if (flags == 0) {				/* undeclared */
+      if ((p.gp = glocate(id)) != NULL) {	/* check global */
+         lp->l_flag = F_Global;
+         lp->l_val.global = p.gp;
+         }
+
+      else if ((p.bn = blocate(id)) != 0) {	/* check for function */
+         lp->l_flag = F_Builtin | F_Global;
+         lp->l_val.global = putglobal(id, F_Builtin | F_Proc, -1, p.bn);
+         }
+
+      else {					/* implicit local */
+         if (imperror)
+            lwarn(&lsspace[id], "undeclared identifier, procedure ",
+               &lsspace[procname]);
+         lp->l_flag = F_Dynamic;
+         lp->l_val.offset = ++dynoff;
+         }
+      }
+   else if (flags & F_Global) {			/* global variable */
+      if ((p.gp = glocate(id)) == NULL)
+         quit("putlocal: global not in global table");
+      lp->l_val.global = p.gp;
+      }
+   else if (flags & F_Argument)			/* procedure argument */
+      lp->l_val.offset = ++argoff;
+   else if (flags & F_Dynamic)			/* local dynamic */
+      lp->l_val.offset = ++dynoff;
+   else if (flags & F_Static)			/* local static */
+      lp->l_val.staticid = ++lstatics;
+   else
+      quit("putlocal: unknown flags");
+   }
+
+/*
+ * putglobal - make a global symbol table entry.
+ */
+struct gentry *putglobal(id, flags, nargs, procid)
+word id;
+int flags;
+int nargs;
+int procid;
+   {
+   register struct gentry *p;
+
+   flags |= F_Global;
+   if ((p = glocate(id)) == NULL) {	/* add to head of hash chain */
+      p = lghash[ghasher(id)];
+      lghash[ghasher(id)] = alcglobal(p, id, flags, nargs, procid);
+      return lghash[ghasher(id)];
+      }
+   p->g_flag |= flags;
+   p->g_nargs = nargs;
+   p->g_procid = procid;
+   return p;
+   }
+
+/*
+ * putconst - make a constant symbol table entry.
+ */
+void putconst(n, flags, len, pc, valp)
+int n;
+int flags, len;
+word pc;
+union xval *valp;
+
+   {
+   register struct centry *p;
+   if (n >= csize)
+      lctable  = (struct centry *)trealloc(lctable, NULL, &csize,
+         sizeof(struct centry), 1, "constant table");
+   if (nconst < n)
+      nconst = n;
+   p = &lctable[n];
+   p->c_flag = flags;
+   p->c_pc = pc;
+   if (flags & F_IntLit) {
+      p->c_val.ival = valp->ival;
+      }
+   else if (flags & F_StrLit) {
+      p->c_val.sval = valp->sval;
+      p->c_length = len;
+      }
+   else if (flags & F_CsetLit) {
+      p->c_val.sval = valp->sval;
+      p->c_length = len;
+      }
+   else	if (flags & F_RealLit) {
+      #ifdef Double
+         /*
+          *  Access real values one word at a time.
+          */
+         int *rp, *rq;
+         rp = (int *) &(p->c_val.rval);
+         rq = (int *) &(valp->rval);
+         *rp++ = *rq++;
+         *rp   = *rq;
+      #else				/* Double */
+         p->c_val.rval = valp->rval;
+      #endif				/* Double */
+      }
+   else
+      fprintf(stderr, "putconst: bad flags: %06o %011lo\n", flags, valp->ival);
+   }
+
+/*
+ * putfield - make a record/field table entry.
+ */
+void putfield(fname, gp, fnum)
+word fname;
+struct gentry *gp;
+int fnum;
+   {
+   register struct fentry *fp;
+   register struct rentry *rp, *rp2;
+   word hash;
+
+   fp = flocate(fname);
+   if (fp == NULL) {		/* create a field entry */
+      nfields++;
+      hash = fhasher(fname);
+      fp = lfhash[hash];
+      lfhash[hash] = alcfhead(fp, fname, nfields, alcfrec((struct rentry *)NULL,
+         gp, fnum));
+      return;
+      }
+   rp = fp->f_rlist;				/* found field entry; */
+   if (rp->r_gp->g_procid > gp->g_procid) {	/* find spot in record list */
+      fp->f_rlist = alcfrec(rp, gp, fnum);
+      return;
+      }
+   while (rp->r_gp->g_procid < gp->g_procid) {	/* keep record list ascending */
+      if (rp->r_link == NULL) {
+         rp->r_link = alcfrec((struct rentry *)NULL, gp, fnum);
+         return;
+         }
+      rp2 = rp;
+      rp = rp->r_link;
+      }
+   rp2->r_link = alcfrec(rp, gp, fnum);
+   }
+
+/*
+ * glocate - lookup identifier in global symbol table, return NULL
+ *  if not present.
+ */
+struct gentry *glocate(id)
+word id;
+   {
+   register struct gentry *p;
+
+   p = lghash[ghasher(id)];
+   while (p != NULL && p->g_name != id)
+      p = p->g_blink;
+   return p;
+   }
+
+/*
+ * flocate - lookup identifier in field table.
+ */
+struct fentry *flocate(id)
+word id;
+   {
+   register struct fentry *p;
+
+   p = lfhash[fhasher(id)];
+   while (p != NULL && p->f_name != id)
+      p = p->f_blink;
+   return p;
+   }
+
+/*
+ * alcglobal - create a new global symbol table entry.
+ */
+static struct gentry *alcglobal(blink, name, flag, nargs, procid)
+struct gentry *blink;
+word name;
+int flag;
+int nargs;
+int procid;
+   {
+   register struct gentry *gp;
+
+   gp = NewStruct(gentry);
+   gp->g_blink = blink;
+   gp->g_name = name;
+   gp->g_flag = flag;
+   gp->g_nargs = nargs;
+   gp->g_procid = procid;
+   gp->g_next = NULL;
+   if (lgfirst == NULL) {
+      lgfirst = gp;
+      gp->g_index = 0;
+      }
+   else {
+      lglast->g_next = gp;
+      gp->g_index = lglast->g_index + 1;
+      }
+   lglast = gp;
+   return gp;
+   }
+
+/*
+ * alcfhead - allocate a field table header.
+ */
+static struct fentry *alcfhead(blink, name, fid, rlist)
+struct fentry *blink;
+word name;
+int fid;
+struct rentry *rlist;
+   {
+   register struct fentry *fp;
+
+   fp = NewStruct(fentry);
+   fp->f_blink = blink;
+   fp->f_name = name;
+   fp->f_fid = fid;
+   fp->f_rlist = rlist;
+   fp->f_nextentry = NULL;
+   if (lffirst == NULL)
+      lffirst = fp;
+   else
+      lflast->f_nextentry = fp;
+   lflast = fp;
+   return fp;
+   }
+
+/*
+ * alcfrec - allocate a field table record list element.
+ */
+static struct rentry *alcfrec(link, gp, fnum)
+struct rentry *link;
+struct gentry *gp;
+int fnum;
+   {
+   register struct rentry *rp;
+
+   rp = NewStruct(rentry);
+   rp->r_link = link;
+   rp->r_gp = gp;
+   rp->r_fnum = fnum;
+   return rp;
+   }
+
+/*
+ * blocate - search for a function. The search is linear to make
+ *  it easier to add/delete functions. If found, returns index+1 for entry.
+ */
+
+int blocate(s_indx)
+word s_indx;
+   {
+register char *s;
+   register int i;
+   extern char *ftable[];
+   extern int ftbsize;
+
+   s = &lsspace[s_indx];
+   for (i = 0; i < ftbsize; i++)
+      if (strcmp(ftable[i], s) == 0)
+         return i + 1;
+   return 0;
+   }
diff --git a/src/icont/mkkwd.icn b/src/icont/mkkwd.icn
new file mode 100644
index 0000000..14af432
--- /dev/null
+++ b/src/icont/mkkwd.icn
@@ -0,0 +1,52 @@
+#  mkkwd.icn
+#
+#  reads:   standard input  (typically ../runtime/keywords.r) 
+#
+#  writes:  keyword.c
+#	    keyword.h
+#	    kdefs.h
+
+procedure main()
+   local kywds, klist, line, f, k, i
+ 
+   # load keywords
+   kywds := set()
+   while line := read() do {
+      line ? {
+ 	if ="keyword" then {
+ 	   tab(find("}")+1)
+ 	   tab(many(' \t'))
+ 	   insert(kywds,tab(0))
+ 	}
+      }
+   }
+   klist := sort(kywds)
+
+   # write defined constants to keyword.h
+   hfile := wopen("keyword.h", "Keyword manifest constants")
+   lfile := wopen("../h/kdefs.h", "Keyword list")
+   i := 0
+   every k := !klist do {
+      kname := "K_" || map(k,&lcase,&ucase)
+      write(hfile, "#define ", left(kname,13), right(i+:=1,3))
+      write(lfile, "KDef(", k, ",", kname, ")")
+      }
+end
+
+
+#  wopen(fname,comment) -- open file for writing
+#
+#  opens and returns file; writes header comment; writes message to stdout
+
+procedure wopen(fname,comment)
+   local f
+   f := open(fname, "w") | stop ("can't open ", fname, " for writing")
+   write(f, "/*")
+   write(f, " * ", fname, " -- ", comment, ".")
+   write(f, " *")
+   write(f, " * Created mechanically by mkkwd.icn -- DO NOT EDIT.")
+   write(f, " */")
+   write(f)
+   write("  writing ", fname)
+   return f
+end
diff --git a/src/icont/newhdr.c b/src/icont/newhdr.c
new file mode 100644
index 0000000..7e23edb
--- /dev/null
+++ b/src/icont/newhdr.c
@@ -0,0 +1,90 @@
+/*
+ * Intermediate program to convert iconx.hdr into a header file for inclusion
+ * in icont.  This eliminates a compile-time file search on Unix systems.
+ * Definition of BinaryHeader activates the inclusion.
+ */
+
+#include "../h/gsupport.h"
+
+void putbyte(FILE *fout, int b);
+
+int main(int argc, char *argv[])
+   {
+   static const char Usage[] = "Usage %s [Filename]\n";
+   int b, n;
+   char *ifile = NULL;
+   char *ofile = NULL;
+   FILE *fin, *fout;
+
+   n = 1;
+   if (((n + 1) < argc) && !strcmp(argv[n], "-o")) {
+      ofile = argv[++n];
+      ++n;
+      }
+   if (n < argc)
+      ifile = argv[n++];
+
+   if (ifile == NULL)
+      fin = stdin;
+   else if ((fin = fopen(ifile, "rb")) == NULL) {
+      fprintf(stderr, "Cannot open \"%s\" for input\n\n", ifile);
+      fprintf(stderr, Usage, argv[0]);
+      return EXIT_FAILURE;
+      }
+
+   if (ofile == NULL)
+      fout = stdout;
+   else if ((fout = fopen(ofile, "w")) == NULL) {
+      fprintf(stderr, "Cannot open \"%s\" for output\n\n", ofile);
+      fprintf(stderr, Usage, argv[0]);
+      return EXIT_FAILURE;
+      }
+
+   /*
+    * Create an array large enough to hold iconx.hdr (+1 for luck)
+    * This array shall be included by link.c (and is nominally called
+    * hdr.h)
+    */ 
+   fprintf(fout, "static unsigned char iconxhdr[MaxHdr+1] = {\n");
+
+   /*
+    * Recreate iconx.hdr as a series of hex constants, padded with zero bytes.
+    */
+   for (n = 0; (b = getc(fin)) != EOF; n++)
+      putbyte(fout, b);
+
+   /*
+    * If header is to be used, make sure it fits.
+    */
+   #ifdef BinaryHeader
+      if (n > MaxHdr) {
+         fprintf(stderr, "%s: file size is %d bytes but MaxHdr is only %d\n",
+            argv[0], n, MaxHdr);
+         if (ofile != NULL) {
+            fclose(fout);
+            unlink(ofile);
+            }
+         return EXIT_FAILURE;
+         }
+   #endif				/* BinaryHeader */
+
+   while (n++ < MaxHdr)
+      putbyte(fout, 0);
+   fprintf(fout,"0x00};\n");	/* one more, sans comma, and finish */
+
+   return EXIT_SUCCESS;
+   }
+
+/*
+ * putbyte(b) - output byte b as two hex digits
+ */
+void putbyte(FILE *fout, int b)
+   {
+   static int n = 0;
+
+   fprintf(fout, "0x%02x,", b & 0xFF);
+   if (++n == 16) {
+      fprintf(fout, "\n");
+      n = 0;
+      }
+   }
diff --git a/src/icont/opcode.c b/src/icont/opcode.c
new file mode 100644
index 0000000..a7d557e
--- /dev/null
+++ b/src/icont/opcode.c
@@ -0,0 +1,117 @@
+#include "link.h"
+#include "tproto.h"
+#include "opcode.h"
+
+/*
+ * Opcode table.
+ */
+
+struct opentry optable[] = {
+   "asgn",	Op_Asgn,
+   "bang",	Op_Bang,
+
+   "bscan",	Op_Bscan,
+
+   "cat",	Op_Cat,
+   "ccase",	Op_Ccase,
+   "chfail",	Op_Chfail,
+   "coact",	Op_Coact,
+   "cofail",	Op_Cofail,
+   "colm",	Op_Colm,		/* always recognized, possibly ignored*/
+   "compl",	Op_Compl,
+   "con",	Op_Con,
+   "coret",	Op_Coret,
+   "create",	Op_Create,
+   "cset",	Op_Cset,
+   "declend",	Op_Declend,
+   "diff",	Op_Diff,
+   "div",	Op_Div,
+   "dup",	Op_Dup,
+   "efail",	Op_Efail,
+   "end",	Op_End,
+   "eqv",	Op_Eqv,
+   "eret",	Op_Eret,
+   "error",	Op_Error,
+   "escan",	Op_Escan,
+   "esusp",	Op_Esusp,
+   "field",	Op_Field,
+   "filen",	Op_Filen,
+
+   "global",	Op_Global,
+   "goto",	Op_Goto,
+   "impl",	Op_Impl,
+   "init",	Op_Init,
+   "int",	Op_Int,
+   "inter",	Op_Inter,
+   "invocable",	Op_Invocable,
+   "invoke",	Op_Invoke,
+   "keywd",	Op_Keywd,
+   "lab",	Op_Lab,
+   "lconcat",	Op_Lconcat,
+   "lexeq",	Op_Lexeq,
+   "lexge",	Op_Lexge,
+   "lexgt",	Op_Lexgt,
+   "lexle",	Op_Lexle,
+   "lexlt",	Op_Lexlt,
+   "lexne",	Op_Lexne,
+   "limit",	Op_Limit,
+   "line",	Op_Line,
+   "link",	Op_Link,
+   "llist",	Op_Llist,
+   "local",	Op_Local,
+   "lsusp",	Op_Lsusp,
+   "mark",	Op_Mark,
+   "mark0",	Op_Mark0,
+   "minus",	Op_Minus,
+   "mod",	Op_Mod,
+   "mult",	Op_Mult,
+   "neg",	Op_Neg,
+   "neqv",	Op_Neqv,
+   "nonnull",	Op_Nonnull,
+
+#ifdef LineCodes
+   "noop",	Op_Noop,
+#endif					/* LineCodes */
+
+   "null",	Op_Null,
+   "number",	Op_Number,
+   "numeq",	Op_Numeq,
+   "numge",	Op_Numge,
+   "numgt",	Op_Numgt,
+   "numle",	Op_Numle,
+   "numlt",	Op_Numlt,
+   "numne",	Op_Numne,
+   "pfail",	Op_Pfail,
+   "plus",	Op_Plus,
+   "pnull",	Op_Pnull,
+   "pop",	Op_Pop,
+   "power",	Op_Power,
+   "pret",	Op_Pret,
+   "proc",	Op_Proc,
+   "psusp",	Op_Psusp,
+   "push1",	Op_Push1,
+   "pushn1",	Op_Pushn1,
+   "random",	Op_Random,
+   "rasgn",	Op_Rasgn,
+   "real",	Op_Real,
+   "record",	Op_Record,
+   "refresh",	Op_Refresh,
+   "rswap",	Op_Rswap,
+   "sdup",	Op_Sdup,
+   "sect",	Op_Sect,
+   "size",	Op_Size,
+   "str",	Op_Str,
+   "subsc",	Op_Subsc,
+   "swap",	Op_Swap,
+   "tabmat",	Op_Tabmat,
+   "tally",	Op_Tally,
+   "toby",	Op_Toby,
+   "trace",	Op_Trace,
+   "unions",	Op_Unions,
+   "unmark",	Op_Unmark,
+   "value",	Op_Value,
+   "var",	Op_Var,
+   "version",	Op_Version,
+   };
+
+int NOPCODES = sizeof(optable) / sizeof(struct opentry);
diff --git a/src/icont/opcode.h b/src/icont/opcode.h
new file mode 100644
index 0000000..ca98cf1
--- /dev/null
+++ b/src/icont/opcode.h
@@ -0,0 +1,17 @@
+/*
+ * Opcode table structure.
+ */
+
+struct opentry {
+   char *op_name;		/* name of opcode */
+   int   op_code;		/* opcode number */
+   };
+
+/*
+ * External definitions.
+ */
+
+extern struct opentry optable[];
+extern int NOPCODES;
+
+#include "../h/opdefs.h"
diff --git a/src/icont/tcode.c b/src/icont/tcode.c
new file mode 100644
index 0000000..9a9787c
--- /dev/null
+++ b/src/icont/tcode.c
@@ -0,0 +1,1097 @@
+/*
+ * tcode.c -- translator functions for traversing parse trees and generating
+ *  code.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "tree.h"
+#include "ttoken.h"
+#include "tsym.h"
+
+/*
+ * Prototypes.
+ */
+
+static int	alclab		(int n);
+static void	binop		(int op);
+static void	emit		(char *s);
+static void	emitl		(char *s,int a);
+static void	emitlab		(int l);
+static void	emitn		(char *s,int a);
+static void	emits		(char *s,char *a);
+static void	emitfile	(nodeptr n);
+static void	emitline	(nodeptr n);
+static void	setloc		(nodeptr n);
+static int	traverse	(nodeptr t);
+static void	unopa		(int op, nodeptr t);
+static void	unopb		(int op);
+
+extern int tfatals;
+extern int nocode;
+
+/*
+ * Code generator parameters.
+ */
+
+#define LoopDepth   20		/* max. depth of nested loops */
+#define CaseDepth   10		/* max. depth of nested case statements */
+#define CreatDepth  10		/* max. depth of nested create statements */
+
+/*
+ * loopstk structures hold information about nested loops.
+ */
+struct loopstk {
+   int nextlab;			/* label for next exit */
+   int breaklab;		/* label for break exit */
+   int markcount;		/* number of marks */
+   int ltype;			/* loop type */
+   };
+
+/*
+ * casestk structure hold information about case statements.
+ */
+struct casestk {
+   int endlab;			/* label for exit from case statement */
+   nodeptr deftree;		/* pointer to tree for default clause */
+   };
+
+/*
+ * creatstk structures hold information about create statements.
+ */
+struct creatstk {
+   int nextlab;			/* previous value of nextlab */
+   int breaklab;		/* previous value of breaklab */
+   };
+static int nextlab;		/* next label allocated by alclab() */
+
+/*
+ * codegen - traverse tree t, generating code.
+ */
+
+void codegen(t)
+nodeptr t;
+   {
+   nextlab = 1;
+   traverse(t);
+   }
+
+/*
+ * traverse - traverse tree rooted at t and generate code.  This is just
+ *  plug and chug code for each of the node types.
+ */
+
+static int traverse(t)
+register nodeptr t;
+   {
+   register int lab, n, i;
+   struct loopstk loopsave;
+   static struct loopstk loopstk[LoopDepth];	/* loop stack */
+   static struct loopstk *loopsp;
+   static struct casestk casestk[CaseDepth];	/* case stack */
+   static struct casestk *casesp;
+   static struct creatstk creatstk[CreatDepth]; /* create stack */
+   static struct creatstk *creatsp;
+
+   n = 1;
+   switch (TType(t)) {
+
+      case N_Activat:			/* co-expression activation */
+	 if (Val0(Tree0(t)) == AUGAT) {
+	    emit("pnull");
+	    }
+	 traverse(Tree2(t));		/* evaluate result expression */
+	 if (Val0(Tree0(t)) == AUGAT)
+	    emit("sdup");
+	 traverse(Tree1(t));		/* evaluate activate expression */
+	 setloc(t);
+	 emit("coact");
+	 if (Val0(Tree0(t)) == AUGAT)
+	    emit("asgn");
+         free(Tree0(t));
+	 break;
+
+      case N_Alt:			/* alternation */
+	 lab = alclab(2);
+	 emitl("mark", lab);
+	 loopsp->markcount++;
+	 traverse(Tree0(t));		/* evaluate first alternative */
+	 loopsp->markcount--;
+         #ifdef EventMon
+            setloc(t);
+         #endif				/* EventMon */
+	 emit("esusp");                 /*  and suspend with its result */
+	 emitl("goto", lab+1);
+	 emitlab(lab);
+	 traverse(Tree1(t));		/* evaluate second alternative */
+	 emitlab(lab+1);
+	 break;
+
+      case N_Augop:			/* augmented assignment */
+      case N_Binop:			/*  or a binary operator */
+	 emit("pnull");
+	 traverse(Tree1(t));
+	 if (TType(t) == N_Augop)
+	    emit("dup");
+	 traverse(Tree2(t));
+	 setloc(t);
+	 binop((int)Val0(Tree0(t)));
+	 free(Tree0(t));
+	 break;
+
+      case N_Bar:			/* repeated alternation */
+	 lab = alclab(1);
+	 emitlab(lab);
+	 emit("mark0");         /* fail if expr fails first time */
+	 loopsp->markcount++;
+	 traverse(Tree0(t));		/* evaluate first alternative */
+	 loopsp->markcount--;
+	 emitl("chfail", lab);          /* change to loop on failure */
+	 emit("esusp");                 /* suspend result */
+	 break;
+
+      case N_Break:			/* break expression */
+	 if (loopsp->breaklab <= 0)
+	    nfatal(t, "invalid context for break", NULL);
+	 else {
+	    for (i = 0; i < loopsp->markcount; i++)
+	       emit("unmark");
+	    loopsave = *loopsp--;
+	    traverse(Tree0(t));
+	    *++loopsp = loopsave;
+	    emitl("goto", loopsp->breaklab);
+	    }
+	 break;
+
+      case N_Case:			/* case expression */
+	 lab = alclab(1);
+	 casesp++;
+	 casesp->endlab = lab;
+	 casesp->deftree = NULL;
+	 emit("mark0");
+	 loopsp->markcount++;
+	 traverse(Tree0(t));		/* evaluate control expression */
+	 loopsp->markcount--;
+	 emit("eret");
+	 traverse(Tree1(t));		/* do rest of case (CLIST) */
+	 if (casesp->deftree != NULL) { /* evaluate default clause */
+	    emit("pop");
+	    traverse(casesp->deftree);
+	    }
+	 else
+	    emit("efail");
+	 emitlab(lab);			/* end label */
+	 casesp--;
+	 break;
+
+      case N_Ccls:			/* case expression clause */
+	 if (TType(Tree0(t)) == N_Res && /* default clause */
+	     Val0(Tree0(t)) == DEFAULT) {
+	    if (casesp->deftree != NULL)
+	       nfatal(t, "more than one default clause", NULL);
+	    else
+	       casesp->deftree = Tree1(t);
+            free(Tree0(t));
+	    }
+	 else {				/* case clause */
+	    lab = alclab(1);
+	    emitl("mark", lab);
+	    loopsp->markcount++;
+	    emit("ccase");
+	    traverse(Tree0(t));		/* evaluate selector */
+	    setloc(t);
+	    emit("eqv");
+	    loopsp->markcount--;
+	    emit("unmark");
+	    emit("pop");
+	    traverse(Tree1(t));		/* evaluate expression */
+	    emitl("goto", casesp->endlab); /* goto end label */
+	    emitlab(lab);		/* label for next clause */
+	    }
+	 break;
+
+      case N_Clist:			/* list of case clauses */
+	 traverse(Tree0(t));
+	 traverse(Tree1(t));
+	 break;
+
+      case N_Conj:			/* conjunction */
+	 if (Val0(Tree0(t)) == AUGAND) {
+	    emit("pnull");
+	    }
+	 traverse(Tree1(t));
+	 if (Val0(Tree0(t)) != AUGAND)
+	    emit("pop");
+	 traverse(Tree2(t));
+	 if (Val0(Tree0(t)) == AUGAND) {
+	    setloc(t);
+	    emit("asgn");
+	    }
+	 free(Tree0(t));
+	 break;
+
+      case N_Create:			/* create expression */
+	 creatsp++;
+	 creatsp->nextlab = loopsp->nextlab;
+	 creatsp->breaklab = loopsp->breaklab;
+	 loopsp->nextlab = 0;		/* make break and next illegal */
+	 loopsp->breaklab = 0;
+	 lab = alclab(3);
+	 emitl("goto", lab+2);          /* skip over code for co-expression */
+	 emitlab(lab);			/* entry point */
+	 emit("pop");                   /* pop the result from activation */
+	 emitl("mark", lab+1);
+	 loopsp->markcount++;
+	 traverse(Tree0(t));		/* traverse code for co-expression */
+	 loopsp->markcount--;
+	 setloc(t);
+	 emit("coret");                 /* return to activator */
+	 emit("efail");                 /* drive co-expression */
+	 emitlab(lab+1);		/* loop on exhaustion */
+	 emit("cofail");                /* and fail each time */
+	 emitl("goto", lab+1);
+	 emitlab(lab+2);
+	 emitl("create", lab);          /* create entry block */
+	 loopsp->nextlab = creatsp->nextlab;   /* legalize break and next */
+	 loopsp->breaklab = creatsp->breaklab;
+	 creatsp--;
+	 break;
+
+      case N_Cset:			/* cset literal */
+	 emitn("cset", (int)Val0(t));
+	 break;
+
+      case N_Elist:			/* expression list */
+	 n = traverse(Tree0(t));
+	 n += traverse(Tree1(t));
+	 break;
+
+      case N_Empty:			/* a missing expression */
+	 emit("pnull");
+	 break;
+
+      case N_Field:			/* field reference */
+	 emit("pnull");
+	 traverse(Tree0(t));
+	 setloc(t);
+	 emits("field", Str0(Tree1(t)));
+	 free(Tree1(t));
+	 break;
+
+      case N_Id:			/* identifier */
+	 emitn("var", (int)Val0(t));
+	 break;
+
+      case N_If:			/* if expression */
+	 if (TType(Tree2(t)) == N_Empty) {
+	    lab = 0;
+	    emit("mark0");
+	    }
+	 else {
+	    lab = alclab(2);
+	    emitl("mark", lab);
+	    }
+	 loopsp->markcount++;
+	 traverse(Tree0(t));
+	 loopsp->markcount--;
+	 emit("unmark");
+	 traverse(Tree1(t));
+	 if (lab > 0) {
+	    emitl("goto", lab+1);
+	    emitlab(lab);
+	    traverse(Tree2(t));
+	    emitlab(lab+1);
+	    }
+         else
+	    free(Tree2(t));
+	 break;
+
+      case N_Int:			/* integer literal */
+	 emitn("int", (int)Val0(t));
+	 break;
+
+      case N_Apply:			/* application */
+         traverse(Tree0(t));
+         traverse(Tree1(t));
+         emitn("invoke", -1);
+         break;
+
+      case N_Invok:			/* invocation */
+	 if (TType(Tree0(t)) != N_Empty) {
+	    traverse(Tree0(t));
+	     }
+	 else {
+	    emit("pushn1");             /* default to -1(e1,...,en) */
+	    free(Tree0(t));
+	    }
+	 if (TType(Tree1(t)) == N_Empty) {
+            n = 0;
+	    free(Tree1(t));
+            }
+         else
+	    n = traverse(Tree1(t));
+	 setloc(t);
+	 emitn("invoke", n);
+	 n = 1;
+	 break;
+
+      case N_Key:			/* keyword reference */
+	 setloc(t);
+	 emits("keywd", Str0(t));
+	 break;
+
+      case N_Limit:			/* limitation */
+	 traverse(Tree1(t));
+	 setloc(t);
+	 emit("limit");
+	 loopsp->markcount++;
+	 traverse(Tree0(t));
+	 loopsp->markcount--;
+	 emit("lsusp");
+	 break;
+
+      case N_List:			/* list construction */
+	 emit("pnull");
+	 if (TType(Tree0(t)) == N_Empty) {
+	    n = 0;
+	    free(Tree0(t));
+            }
+	 else
+	    n = traverse(Tree0(t));
+	 setloc(t);
+	 emitn("llist", n);
+	 n = 1;
+	 break;
+
+      case N_Loop:			/* loop */
+	 switch ((int)Val0(Tree0(t))) {
+	    case EVERY:
+	       lab = alclab(2);
+	       loopsp++;
+	       loopsp->ltype = EVERY;
+	       loopsp->nextlab = lab;
+	       loopsp->breaklab = lab + 1;
+	       loopsp->markcount = 1;
+	       emit("mark0");
+	       traverse(Tree1(t));
+	       emit("pop");
+	       if (TType(Tree2(t)) != N_Empty) {   /* every e1 do e2 */
+		  emit("mark0");
+		  loopsp->ltype = N_Loop;
+		  loopsp->markcount++;
+		  traverse(Tree2(t));
+		  loopsp->markcount--;
+		  emit("unmark");
+		  }
+               else
+		  free(Tree2(t));
+	       emitlab(loopsp->nextlab);
+	       emit("efail");
+	       emitlab(loopsp->breaklab);
+	       loopsp--;
+	       break;
+
+	    case REPEAT:
+	       lab = alclab(3);
+	       loopsp++;
+	       loopsp->ltype = N_Loop;
+	       loopsp->nextlab = lab + 1;
+	       loopsp->breaklab = lab + 2;
+	       loopsp->markcount = 1;
+	       emitlab(lab);
+	       emitl("mark", lab);
+	       traverse(Tree1(t));
+	       emitlab(loopsp->nextlab);
+	       emit("unmark");
+	       emitl("goto", lab);
+	       emitlab(loopsp->breaklab);
+	       loopsp--;
+               free(Tree2(t));
+	       break;
+
+	    case SUSPEND:			/* suspension expression */
+	       if (creatsp > creatstk)
+		  nfatal(t, "invalid context for suspend", NULL);
+	       lab = alclab(2);
+	       loopsp++;
+	       loopsp->ltype = EVERY;		/* like every ... do for next */
+	       loopsp->nextlab = lab;
+	       loopsp->breaklab = lab + 1;
+	       loopsp->markcount = 1;
+	       emit("mark0");
+	       traverse(Tree1(t));
+	       setloc(t);
+	       emit("psusp");
+	       emit("pop");
+	       if (TType(Tree2(t)) != N_Empty) { /* suspend e1 do e2 */
+		  emit("mark0");
+		  loopsp->ltype = N_Loop;
+		  loopsp->markcount++;
+		  traverse(Tree2(t));
+		  loopsp->markcount--;
+		  emit("unmark");
+		  }
+               else
+		  free(Tree2(t));
+	       emitlab(loopsp->nextlab);
+	       emit("efail");
+	       emitlab(loopsp->breaklab);
+	       loopsp--;
+	       break;
+
+	    case WHILE:
+	       lab = alclab(3);
+	       loopsp++;
+	       loopsp->ltype = N_Loop;
+	       loopsp->nextlab = lab + 1;
+	       loopsp->breaklab = lab + 2;
+	       loopsp->markcount = 1;
+	       emitlab(lab);
+	       emit("mark0");
+	       traverse(Tree1(t));
+	       if (TType(Tree2(t)) != N_Empty) {
+		  emit("unmark");
+		  emitl("mark", lab);
+		  traverse(Tree2(t));
+		  }
+               else
+		  free(Tree2(t));
+	       emitlab(loopsp->nextlab);
+	       emit("unmark");
+	       emitl("goto", lab);
+	       emitlab(loopsp->breaklab);
+	       loopsp--;
+	       break;
+
+	    case UNTIL:
+	       lab = alclab(4);
+	       loopsp++;
+	       loopsp->ltype = N_Loop;
+	       loopsp->nextlab = lab + 2;
+	       loopsp->breaklab = lab + 3;
+	       loopsp->markcount = 1;
+	       emitlab(lab);
+	       emitl("mark", lab+1);
+	       traverse(Tree1(t));
+	       emit("unmark");
+	       emit("efail");
+	       emitlab(lab+1);
+	       emitl("mark", lab);
+	       traverse(Tree2(t));
+	       emitlab(loopsp->nextlab);
+	       emit("unmark");
+	       emitl("goto", lab);
+	       emitlab(loopsp->breaklab);
+	       loopsp--;
+	       break;
+	    }
+	 free(Tree0(t));
+	 break;
+
+      case N_Next:			/* next expression */
+	 if (loopsp < loopstk || loopsp->nextlab <= 0)
+	    nfatal(t, "invalid context for next", NULL);
+	 else {
+	    if (loopsp->ltype != EVERY && loopsp->markcount > 1)
+	       for (i = 0; i < loopsp->markcount - 1; i++)
+		  emit("unmark");
+	    emitl("goto", loopsp->nextlab);
+	    }
+	 break;
+
+      case N_Not:			/* not expression */
+	 lab = alclab(1);
+	 emitl("mark", lab);
+	 loopsp->markcount++;
+	 traverse(Tree0(t));
+	 loopsp->markcount--;
+	 emit("unmark");
+	 emit("efail");
+	 emitlab(lab);
+	 emit("pnull");
+	 break;
+
+      case N_Proc:			/* procedure */
+	 loopsp = loopstk;
+	 loopsp->nextlab = 0;
+	 loopsp->breaklab = 0;
+	 loopsp->markcount = 0;
+	 casesp = casestk;
+	 creatsp = creatstk;
+
+	 writecheck(fprintf(codefile, "proc %s\n", Str0(Tree0(t))));
+	 emitfile(t);
+	 lout(codefile);
+	 constout(codefile);
+	 emit("declend");
+	 emitline(t);
+
+	 if (TType(Tree1(t)) != N_Empty) {
+	    lab = alclab(1);
+	    emitl("init", lab);
+	    emitl("mark", lab);
+	    traverse(Tree1(t));
+	    emit("unmark");
+	    emitlab(lab);
+	    }
+         else
+	    free(Tree1(t));
+	 if (TType(Tree2(t)) != N_Empty)
+	    traverse(Tree2(t));
+         else
+	    free(Tree2(t));
+	 setloc(Tree3(t));
+	 emit("pfail");
+	 emit("end");
+	 if (!silent)
+	    fprintf(stderr, "  %s\n", Str0(Tree0(t)));
+	 free(Tree0(t));
+	 free(Tree3(t));
+	 break;
+
+      case N_Real:			/* real literal */
+	 emitn("real", (int)Val0(t));
+	 break;
+
+      case N_Ret:			/* return expression */
+	 if (creatsp > creatstk)
+	    nfatal(t, "invalid context for return or fail", NULL);
+	 if (Val0(Tree0(t)) == FAIL)
+	    free(Tree1(t));
+         else {
+	    lab = alclab(1);
+	    emitl("mark", lab);
+	    loopsp->markcount++;
+	    traverse(Tree1(t));
+	    loopsp->markcount--;
+	    setloc(t);
+	    emit("pret");
+	    emitlab(lab);
+	    }
+	 setloc(t);
+	 emit("pfail");
+         free(Tree0(t));
+	 break;
+
+      case N_Scan:			/* scanning expression */
+	 if (Val0(Tree0(t)) == AUGQMARK)
+	    emit("pnull");
+	 traverse(Tree1(t));
+	 if (Val0(Tree0(t)) == AUGQMARK)
+	    emit("sdup");
+	 setloc(t);
+	 emit("bscan");
+	 traverse(Tree2(t));
+	 setloc(t);
+	 emit("escan");
+	 if (Val0(Tree0(t)) == AUGQMARK)
+	    emit("asgn");
+	 free(Tree0(t));
+	 break;
+
+      case N_Sect:			/* section operation */
+	 emit("pnull");
+	 traverse(Tree1(t));
+	 traverse(Tree2(t));
+	 if (Val0(Tree0(t)) == PCOLON || Val0(Tree0(t)) == MCOLON)
+	    emit("dup");
+	 traverse(Tree3(t));
+	 setloc(Tree0(t));
+	 if (Val0(Tree0(t)) == PCOLON)
+	    emit("plus");
+	 else if (Val0(Tree0(t)) == MCOLON)
+	    emit("minus");
+	 setloc(t);
+	 emit("sect");
+	 free(Tree0(t));
+	 break;
+
+      case N_Slist:			/* semicolon-separated expr list */
+	 lab = alclab(1);
+	 emitl("mark", lab);
+	 loopsp->markcount++;
+	 traverse(Tree0(t));
+	 loopsp->markcount--;
+	 emit("unmark");
+	 emitlab(lab);
+	 traverse(Tree1(t));
+	 break;
+
+      case N_Str:			/* string literal */
+	 emitn("str", (int)Val0(t));
+	 break;
+
+      case N_To:			/* to expression */
+	 emit("pnull");
+	 traverse(Tree0(t));
+	 traverse(Tree1(t));
+	 emit("push1");
+	 setloc(t);
+	 emit("toby");
+	 break;
+
+      case N_ToBy:			/* to-by expression */
+	 emit("pnull");
+	 traverse(Tree0(t));
+	 traverse(Tree1(t));
+	 traverse(Tree2(t));
+	 setloc(t);
+	 emit("toby");
+	 break;
+
+      case N_Unop:			/* unary operator */
+	 unopa((int)Val0(Tree0(t)),t);
+	 traverse(Tree1(t));
+	 setloc(t);
+	 unopb((int)Val0(Tree0(t)));
+	 free(Tree0(t));
+	 break;
+
+      default:
+	 emitn("?????", TType(t));
+	 tsyserr("traverse: undefined node type");
+      }
+   free(t);
+   return n;
+   }
+
+/*
+ * binop emits code for binary operators.  For non-augmented operators,
+ *  the name of operator is emitted.  For augmented operators, an "asgn"
+ *  is emitted after the name of the operator.
+ */
+static void binop(op)
+int op;
+   {
+   register int asgn;
+   register char *name;
+
+   asgn = 0;
+   switch (op) {
+
+      case ASSIGN:
+	 name = "asgn";
+	 break;
+
+      case AUGCARET:
+	 asgn++;
+      case CARET:
+	 name = "power";
+	 break;
+
+      case AUGCONCAT:
+	 asgn++;
+      case CONCAT:
+	 name = "cat";
+	 break;
+
+      case AUGDIFF:
+	 asgn++;
+      case DIFF:
+	 name = "diff";
+	 break;
+
+      case AUGEQUIV:
+	 asgn++;
+      case EQUIV:
+	 name = "eqv";
+	 break;
+
+      case AUGINTER:
+	 asgn++;
+      case INTER:
+	 name = "inter";
+	 break;
+
+      case LBRACK:
+	 name = "subsc";
+	 break;
+
+      case AUGLCONCAT:
+	 asgn++;
+      case LCONCAT:
+	 name = "lconcat";
+	 break;
+
+      case AUGSEQ:
+	 asgn++;
+      case SEQ:
+	 name = "lexeq";
+	 break;
+
+      case AUGSGE:
+	 asgn++;
+      case SGE:
+	 name = "lexge";
+	 break;
+
+      case AUGSGT:
+	 asgn++;
+      case SGT:
+	 name = "lexgt";
+	 break;
+
+      case AUGSLE:
+	 asgn++;
+      case SLE:
+	 name = "lexle";
+	 break;
+
+      case AUGSLT:
+	 asgn++;
+      case SLT:
+	 name = "lexlt";
+	 break;
+
+      case AUGSNE:
+	 asgn++;
+      case SNE:
+	 name = "lexne";
+	 break;
+
+      case AUGMINUS:
+	 asgn++;
+      case MINUS:
+	 name = "minus";
+	 break;
+
+      case AUGMOD:
+	 asgn++;
+      case MOD:
+	 name = "mod";
+	 break;
+
+      case AUGNEQUIV:
+	 asgn++;
+      case NEQUIV:
+	 name = "neqv";
+	 break;
+
+      case AUGNMEQ:
+	 asgn++;
+      case NMEQ:
+	 name = "numeq";
+	 break;
+
+      case AUGNMGE:
+	 asgn++;
+      case NMGE:
+	 name = "numge";
+	 break;
+
+      case AUGNMGT:
+	 asgn++;
+      case NMGT:
+	 name = "numgt";
+	 break;
+
+      case AUGNMLE:
+	 asgn++;
+      case NMLE:
+	 name = "numle";
+	 break;
+
+      case AUGNMLT:
+	 asgn++;
+      case NMLT:
+	 name = "numlt";
+	 break;
+
+      case AUGNMNE:
+	 asgn++;
+      case NMNE:
+	 name = "numne";
+	 break;
+
+      case AUGPLUS:
+	 asgn++;
+      case PLUS:
+	 name = "plus";
+	 break;
+
+      case REVASSIGN:
+	 name = "rasgn";
+	 break;
+
+      case REVSWAP:
+	 name = "rswap";
+	 break;
+
+      case AUGSLASH:
+	 asgn++;
+      case SLASH:
+	 name = "div";
+	 break;
+
+      case AUGSTAR:
+	 asgn++;
+      case STAR:
+	 name = "mult";
+	 break;
+
+      case SWAP:
+	 name = "swap";
+	 break;
+
+      case AUGUNION:
+	 asgn++;
+      case UNION:
+	 name = "unions";
+	 break;
+
+      default:
+	 emitn("?binop", op);
+	 tsyserr("binop: undefined binary operator");
+      }
+   emit(name);
+   if (asgn)
+      emit("asgn");
+
+   }
+/*
+ * unopa and unopb handle code emission for unary operators. unary operator
+ *  sequences that are the same as binary operator sequences are recognized
+ *  by the lexical analyzer as binary operators.  For example, ~===x means to
+ *  do three tab(match(...)) operations and then a cset complement, but the
+ *  lexical analyzer sees the operator sequence as the "neqv" binary
+ *  operation.	unopa and unopb unravel tokens of this form.
+ *
+ * When a N_Unop node is encountered, unopa is called to emit the necessary
+ *  number of "pnull" operations to receive the intermediate results.  This
+ *  amounts to a pnull for each operation.
+ */
+static void unopa(op,t)
+int op;
+nodeptr t;
+   {
+   switch (op) {
+      case NEQUIV:		/* unary ~ and three = operators */
+	 emit("pnull");
+      case SNE:		/* unary ~ and two = operators */
+      case EQUIV:		/* three unary = operators */
+	 emit("pnull");
+      case NMNE:		/* unary ~ and = operators */
+      case UNION:		/* two unary + operators */
+      case DIFF:		/* two unary - operators */
+      case SEQ:		/* two unary = operators */
+      case INTER:		/* two unary * operators */
+	 emit("pnull");
+      case BACKSLASH:		/* unary \ operator */
+      case BANG:		/* unary ! operator */
+      case CARET:		/* unary ^ operator */
+      case PLUS:		/* unary + operator */
+      case TILDE:		/* unary ~ operator */
+      case MINUS:		/* unary - operator */
+      case NMEQ:		/* unary = operator */
+      case STAR:		/* unary * operator */
+      case QMARK:		/* unary ? operator */
+      case SLASH:		/* unary / operator */
+      case DOT:			/* unary . operator */
+         emit("pnull");
+         break;
+      default:
+	 tsyserr("unopa: undefined unary operator");
+      }
+   }
+
+/*
+ * unopb is the back-end code emitter for unary operators.  It emits
+ *  the operations represented by the token op.  For tokens representing
+ *  a single operator, the name of the operator is emitted.  For tokens
+ *  representing a sequence of operators, recursive calls are used.  In
+ *  such a case, the operator sequence is "scanned" from right to left
+ *  and unopb is called with the token for the appropriate operation.
+ *
+ * For example, consider the sequence of calls and code emission for "~===":
+ *	unopb(NEQUIV)		~===
+ *	    unopb(NMEQ)	=
+ *		emits "tabmat"
+ *	    unopb(NMEQ)	=
+ *		emits "tabmat"
+ *	    unopb(NMEQ)	=
+ *		emits "tabmat"
+ *	    emits "compl"
+ */
+static void unopb(op)
+int op;
+   {
+   register char *name;
+
+   switch (op) {
+
+      case DOT:			/* unary . operator */
+	 name = "value";
+	 break;
+
+      case BACKSLASH:		/* unary \ operator */
+	 name = "nonnull";
+	 break;
+
+      case BANG:		/* unary ! operator */
+	 name = "bang";
+	 break;
+
+      case CARET:		/* unary ^ operator */
+	 name = "refresh";
+	 break;
+
+      case UNION:		/* two unary + operators */
+	 unopb(PLUS);
+      case PLUS:		/* unary + operator */
+	 name = "number";
+	 break;
+
+      case NEQUIV:		/* unary ~ and three = operators */
+	 unopb(NMEQ);
+      case SNE:		/* unary ~ and two = operators */
+	 unopb(NMEQ);
+      case NMNE:		/* unary ~ and = operators */
+	 unopb(NMEQ);
+      case TILDE:		/* unary ~ operator (cset compl) */
+	 name = "compl";
+	 break;
+
+      case DIFF:		/* two unary - operators */
+	 unopb(MINUS);
+      case MINUS:		/* unary - operator */
+	 name = "neg";
+	 break;
+
+      case EQUIV:		/* three unary = operators */
+	 unopb(NMEQ);
+      case SEQ:		/* two unary = operators */
+	 unopb(NMEQ);
+      case NMEQ:		/* unary = operator */
+	 name = "tabmat";
+	 break;
+
+      case INTER:		/* two unary * operators */
+	 unopb(STAR);
+      case STAR:		/* unary * operator */
+	 name = "size";
+	 break;
+
+      case QMARK:		/* unary ? operator */
+	 name = "random";
+	 break;
+
+      case SLASH:		/* unary / operator */
+	 name = "null";
+	 break;
+
+      default:
+	 emitn("?unop", op);
+	 tsyserr("unopb: undefined unary operator");
+      }
+   emit(name);
+   }
+
+/*
+ * emitfile(n) emits "filen" directives for node n's source location.
+ * emitline(n) emits "line" and possibly "colm" directives.
+ * setloc(n) does both.
+ *  A directive is only emitted if the corresponding value
+ *  has changed since the previous call.
+ *
+ */
+static char *lastfiln = NULL;
+static int lastlin = 0;
+
+static void setloc(n)
+nodeptr n;
+   {
+   emitfile(n);
+   emitline(n);
+   }
+
+static void emitfile(n)
+nodeptr n;
+   {
+   if ((n != NULL) &&
+      (TType(n) != N_Empty) &&
+      (File(n) != NULL) &&
+      (lastfiln == NULL || strcmp(File(n), lastfiln) != 0)) {
+         lastfiln = File(n);
+         emits("filen", lastfiln);
+         }
+   }
+
+static void emitline(n)
+nodeptr n;
+   {
+   #ifdef SrcColumnInfo
+      /*
+       * if either line or column has changed, emit location information
+       */
+      if (((Col(n) << 16) + Line(n)) != lastlin) {
+         lastlin = (Col(n) << 16) + Line(n);
+         emitn("line",Line(n));
+         emitn("colm",Col(n));
+         }
+   #else				/* SrcColumnInfo */
+      /*
+       * if line has changed, emit line information
+       */
+      if (Line(n) != lastlin) {
+         lastlin = Line(n);
+         emitn("line", lastlin);
+         }
+   #endif				/* SrcColumnInfo */
+   }
+
+/*
+ * The emit* routines output ucode to codefile.  The various routines are:
+ *
+ *  emitlab(l) - emit "lab" instruction for label l.
+ *  emit(s) - emit instruction s.
+ *  emitl(s,a) - emit instruction s with reference to label a.
+ *  emitn(s,n) - emit instruction s with numeric argument a.
+ *  emits(s,a) - emit instruction s with string argument a.
+ */
+static void emitlab(l)
+int l;
+   {
+   writecheck(fprintf(codefile, "lab L%d\n", l));
+   }
+
+static void emit(s)
+char *s;
+   {
+   writecheck(fprintf(codefile, "\t%s\n", s));
+   }
+
+static void emitl(s, a)
+char *s;
+int a;
+   {
+   writecheck(fprintf(codefile, "\t%s\tL%d\n", s, a));
+   }
+
+static void emitn(s, a)
+char *s;
+int a;
+   {
+   writecheck(fprintf(codefile, "\t%s\t%d\n", s, a));
+   }
+
+static void emits(s, a)
+char *s, *a;
+   {
+   writecheck(fprintf(codefile, "\t%s\t%s\n", s, a));
+   }
+
+/*
+ * alclab allocates n labels and returns the first.  For the interpreter,
+ *  labels are restarted at 1 for each procedure, while in the compiler,
+ *  they start at 1 and increase throughout the entire compilation.
+ */
+static int alclab(n)
+int n;
+   {
+   register int lab;
+
+   lab = nextlab;
+   nextlab += n;
+   return lab;
+   }
diff --git a/src/icont/tglobals.c b/src/icont/tglobals.c
new file mode 100644
index 0000000..0e963ea
--- /dev/null
+++ b/src/icont/tglobals.c
@@ -0,0 +1,24 @@
+/*
+ * tglobals.c - declaration and initialization of icont globals.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+
+#define Global
+#define Init(v) = v
+#include "tglobals.h"			/* define globals */
+
+/*
+ *  Initialize globals that cannot be handled statically.
+ */
+void initglob(void) {
+   /*
+    * Round hash table sizes to next power of two, and set masks for hashing.
+    */
+   lchsize = round2(lchsize);  cmask = lchsize - 1;
+   fhsize = round2(fhsize);  fmask = fhsize - 1;
+   ghsize = round2(ghsize);  gmask = ghsize - 1;
+   ihsize = round2(ihsize);  imask = ihsize - 1;
+   lhsize = round2(lhsize);  lmask = lhsize - 1;
+   }
diff --git a/src/icont/tglobals.h b/src/icont/tglobals.h
new file mode 100644
index 0000000..5568293
--- /dev/null
+++ b/src/icont/tglobals.h
@@ -0,0 +1,67 @@
+/*
+ *  Global variables.
+ */
+
+#ifndef Global
+   #define Global extern
+   #define Init(v)
+#endif					/* Global */
+
+/*
+ * Masks for accessing hash tables.
+ */
+Global int cmask;			/* mask for constant table hash */
+Global int fmask;			/* mask for field table hash */
+Global int gmask;			/* mask for global table hash */
+Global int imask;			/* mask for identifier table hash */
+Global int lmask;			/* mask for local table hash */
+
+/*
+ * Array sizes for various linker tables that can be expanded with realloc().
+ */
+Global unsigned int csize	Init(100);	/* constant table */
+Global unsigned int lsize	Init(100);	/* local table */
+Global unsigned int nsize	Init(1000);	/* ipc/line num. assoc. table */
+Global unsigned int stsize	Init(20000);	/* string space */
+Global unsigned int maxcode	Init(15000);	/* code space */
+Global unsigned int fnmsize	Init(10);	/* ipc/file name assoc. table */
+Global unsigned int maxlabels	Init(500);	/* maximum num of labels/proc */
+
+/*
+ * Sizes of various hash tables.
+ */
+Global unsigned int lchsize	Init(128);	/* constant hash table */
+Global unsigned int fhsize	Init(32);	/* field hash table */
+Global unsigned int ghsize	Init(128);	/* global hash table */
+Global unsigned int ihsize	Init(128);	/* identifier hash table */
+Global unsigned int lhsize	Init(128);	/* local hash table */
+
+/*
+ * Variables related to command processing.
+ */
+Global char *progname	Init("icont");	/* program name for diagnostics */
+Global int silent	Init(0);	/* -s: suppress info messages? */
+Global int m4pre	Init(0);	/* -m: use m4 preprocessor? */
+Global int uwarn	Init(0);	/* -u: warn about undefined ids? */
+Global int trace	Init(0);	/* -t: initial &trace value */
+Global int pponly	Init(0);	/* -E: preprocess only */
+Global int strinv	Init(0);	/* -f s: allow full string invocation */
+Global int verbose	Init(1);	/* -v n: verbosity of commentary */
+
+#ifdef DeBugLinker
+   Global int Dflag	Init(0);	/* -L: linker debug (write .ux file) */
+#endif					/* DeBugLinker */
+
+/*
+ * Files and related globals.
+ */
+Global char *lpath;			/* search path for $include */
+Global char *ipath;			/* search path for linking */
+
+Global FILE *codefile	Init(0);	/* current ucode output file */
+Global FILE *globfile	Init(0);	/* current global table output file */
+
+Global char *ofile	Init(NULL);	/* name of linker output file */
+
+Global char *iconxloc;			/* path to iconx */
+Global long hdrsize;			/* size of iconx header */
diff --git a/src/icont/tgrammar.c b/src/icont/tgrammar.c
new file mode 100644
index 0000000..7301c07
--- /dev/null
+++ b/src/icont/tgrammar.c
@@ -0,0 +1,239 @@
+/*
+ * tgrammar.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 includes in tgram.g by fixgram.icn.
+ */
+/*#include "../h/gsupport.h"*/
+/*#include "../h/lexdef.h"*/
+/*#include "tproto.h"*/
+/*#include "tglobals.h"*/
+/*#include "tsym.h"*/
+/*#include "tree.h"*/
+/*#include "keyword.h"*/
+/*#undef YYSTYPE*/
+/*#define YYSTYPE nodeptr*/
+/*#define YYMAXDEPTH 500*/
+
+extern int fncargs[];
+int idflag;
+int id_cnt;
+
+#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()		id_cnt = 0
+#define Arglist2(x)		/* empty */
+#define Arglist3(x,y,z)		id_cnt = -id_cnt
+#define Bact(x1,x2,x3)		$$ = tree5(N_Activat,x2,x2,x3,x1)
+#define Bamper(x1,x2,x3)	$$ = tree5(N_Conj,x2,x2,x1,x3)
+#define Bassgn(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Baugact(x1,x2,x3)	$$ = tree5(N_Activat,x2,x2,x3,x1)
+#define Baugamper(x1,x2,x3)	$$ = tree5(N_Conj,x2,x2,x1,x3)
+#define Baugcat(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugeq(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugeqv(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugge(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bauggt(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bauglcat(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugle(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bauglt(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugne(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugneqv(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugques(x1,x2,x3)	$$ = tree5(N_Scan,x2,x2,x1,x3)
+#define Baugseq(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugsge(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugsgt(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugsle(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugslt(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Baugsne(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bcaret(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bcareta(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bcat(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bdiff(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bdiffa(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Beq(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Beqv(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bge(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bgt(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Binter(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bintera(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Blcat(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Ble(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Blim(x1,x2,x3)		$$ = tree4(N_Limit,x1,x1,x3)
+#define Blt(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bminus(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bminusa(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bmod(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bmoda(x1,x2,x3)		$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bne(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bneqv(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bplus(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bplusa(x1,x2,x3)	$$ = tree5(N_Augop,x2,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)		$$ = tree3(N_List,x1,x2)
+#define Brassgn(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Break(x1,x2)		$$ = tree3(N_Break,x1,x2)
+#define Brswap(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bseq(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bsge(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bsgt(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bslash(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bslasha(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bsle(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bslt(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bsne(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bstar(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bstara(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Bswap(x1,x2,x3)		$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Bunion(x1,x2,x3)	$$ = tree5(N_Binop,x2,x2,x1,x3)
+#define Buniona(x1,x2,x3)	$$ = tree5(N_Augop,x2,x2,x1,x3)
+#define Call(x1,x2,x3,x4)	if (Val2(x1) = blocate(Str0(x1))) {\
+                                   Val4(x1) = fncargs[Val2(x1)-1]; \
+				   $$ = tree4(N_Call,x2,x1,x3);} \
+				else { \
+				   Val0(x1) = putloc(Str0(x1),0); \
+				   $$ = tree4(N_Invok,x2,x1,x3); \
+				   }
+#define Case(x1,x2,x3,x4,x5,x6) $$ = tree4(N_Case,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)		Val0(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)
+#define Elst0(x1)		/* empty */
+#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,0);\
+				id_cnt = 1
+#define Idlist(x1,x2,x3)	install(Str0(x3),idflag,0);\
+				++id_cnt
+#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)		Val0(x) = putlit(Str0(x),F_IntLit,0)
+#define Initial1()		$$ = EmptyNode
+#define Initial2(x1,x2,x3)	$$ = x2
+#define Invocable(x1,x2)	/* empty */
+#define Invocdcl(x1)		/* empty */
+#define Invoclist(x1,x2,x3)	/* empty */
+#define Invocop1(x1)		addinvk(Str0(x1),1)
+#define Invocop2(x1)		addinvk(Str0(x1),2)
+#define Invocop3(x1,x2,x3)	addinvk(Str0(x1),3)
+#define Invoke(x1,x2,x3,x4)	$$ = tree4(N_Invok,x2,x1,x3)
+#define Keyword(x1,x2)		if (klookup(Str0(x2)) == 0)\
+				   tfatal("invalid keyword",Str0(x2));\
+				$$ = c_str_leaf(N_Key,x1,Str0(x2))
+#define Kfail(x1,x2)		$$ = c_str_leaf(N_Key,x1,"fail")
+#define Link(x1,x2)		/* empty */
+#define Linkdcl(x)		/* empty */
+#define Lnkfile1(x)		addlfile(Str0(x))
+#define Lnkfile2(x)		addlfile(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)\
+				   $$ = tree4(N_Invok,x1,EmptyNode,x2);\
+				else\
+				   $$ = x2
+#define Pcolon(x)		$$ = x
+#define Pdco0(x1,x2,x3)		$$ = tree4(N_Invok,x2,x1,\
+				      tree3(N_List,x2,EmptyNode))
+#define Pdco1(x1,x2,x3,x4)	$$ = tree4(N_Invok,x2,x1,tree3(N_List,x2,x3))
+#define Pdcolist0(x)		$$ = tree3(N_Create,x,x)
+#define Pdcolist1(x1,x2,x3)	$$ = tree4(N_Elist,x2,x1,tree3(N_Create,x2,x3))
+#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)		if (!nocode)\
+				   codegen(x);\
+				nocode = 0;\
+				loc_init()
+#define Prochead1(x1,x2)	idflag = F_Argument
+#define Prochead2(x1,x2,x3,x4,x5,x6)\
+				$$ = x2;\
+				install(Str0(x2),F_Proc|F_Global,id_cnt)
+#define Progend(x1,x2)		gout(globfile)
+#define Recdcl(x)		if (!nocode)\
+				   rout(globfile, Str0(x));\
+				nocode = 0;\
+				loc_init()
+#define Record1(x1,x2)		idflag = F_Argument
+#define Record2(x1,x2,x3,x4,x5,x6) install(Str0(x2),F_Record|F_Global,id_cnt); \
+				    $$ = x2
+#define Repeat(x1,x2)		$$ = tree5(N_Loop,x1,x1,x2,EmptyNode)
+#define Return(x1,x2)		$$ = tree4(N_Ret,x1,x1,x2)
+#define Rliter(x)		Val0(x) = putlit(Str0(x),F_RealLit,0)
+#define Section(x1,x2,x3,x4,x5,x6) $$ = tree6(N_Sect,x4,x4,x1,x3,x5)
+#define Sliter(x)		Val0(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,x4)
+#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)		$$ = tree4(N_To,x2,x1,x3)
+#define To1(x1,x2,x3,x4,x5)	$$ = tree5(N_ToBy,x2,x1,x3,x5)
+#define Uat(x1,x2)		$$ = tree5(N_Activat,x1,x1,x2,EmptyNode)
+#define Ubackslash(x1,x2)	$$ = tree4(N_Unop,x1,x1,x2)
+#define Ubang(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Ubar(x1,x2)		$$ = tree3(N_Bar,x2,x2)
+#define Ucaret(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2)
+#define Udiff(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Udot(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uequiv(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uinter(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Ulconcat(x1,x2)		$$ = tree3(N_Bar,x2,x2)
+#define Ulexeq(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Ulexne(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uminus(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Unot(x1,x2)		$$ = tree3(N_Not,x2,x2)
+#define Unotequiv(x1,x2)	$$ = tree4(N_Unop,x1,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)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Unumne(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uplus(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uqmark(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uslash(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Ustar(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Utilde(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Uunion(x1,x2)		$$ = tree4(N_Unop,x1,x1,x2)
+#define Var(x)			Val0(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.
+ */
+static void xfree(p)
+char *p;
+{
+   free(p);
+}
+
+/*#define free(p) xfree((char*)p)*/
diff --git a/src/icont/tlex.c b/src/icont/tlex.c
new file mode 100644
index 0000000..d79bcc9
--- /dev/null
+++ b/src/icont/tlex.c
@@ -0,0 +1,16 @@
+/*
+ * tlex.c -- the lexical analyzer for icont.
+ */
+
+#include "../h/gsupport.h"
+#undef T_Real
+#undef T_String
+#undef T_Cset
+#include "../h/lexdef.h"
+#include "ttoken.h"
+#include "tree.h"
+#include "tproto.h"
+#include "../h/parserr.h"
+#include "../common/lextab.h"
+#include "../common/yylex.h"
+#include "../common/error.h"
diff --git a/src/icont/tmem.c b/src/icont/tmem.c
new file mode 100644
index 0000000..54e1b60
--- /dev/null
+++ b/src/icont/tmem.c
@@ -0,0 +1,76 @@
+/*
+ * tmem.c -- memory initialization and allocation for the translator.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "tsym.h"
+#include "tree.h"
+
+struct tlentry **lhash;		/* hash area for local table */
+struct tgentry **ghash;		/* hash area for global table */
+struct tcentry **chash;		/* hash area for constant table */
+
+struct tlentry *lfirst;		/* first local table entry */
+struct tlentry *llast;		/* last local table entry */
+struct tcentry *cfirst;		/* first constant table entry */
+struct tcentry *clast;		/* last constant table entry */
+struct tgentry *gfirst;		/* first global table entry */
+struct tgentry *glast;		/* last global table entry */
+
+extern struct str_buf lex_sbuf;
+
+
+/*
+ * tmalloc - allocate memory for the translator
+ */
+
+void tmalloc()
+{
+   chash = (struct tcentry **) tcalloc(lchsize, sizeof (struct tcentry *));
+   ghash = (struct tgentry **) tcalloc(ghsize, sizeof (struct tgentry *));
+   lhash = (struct tlentry **) tcalloc(lhsize, sizeof (struct tlentry *));
+   init_str();
+   init_sbuf(&lex_sbuf);
+   }
+
+/*
+ * meminit - clear tables for use in translating the next file
+ */
+void tminit()
+   {
+   register struct tlentry **lp;
+   register struct tgentry **gp;
+   register struct tcentry **cp;
+
+   lfirst = NULL;
+   llast = NULL;
+   cfirst = NULL;
+   clast = NULL;
+   gfirst = NULL;
+   glast = NULL;
+
+   /*
+    * Zero out the hash tables.
+    */
+   for (lp = lhash; lp < &lhash[lhsize]; lp++)
+      *lp = NULL;
+   for (gp = ghash; gp < &ghash[ghsize]; gp++)
+      *gp = NULL;
+   for (cp = chash; cp < &chash[lchsize]; cp++)
+      *cp = NULL;
+   }
+
+/*
+ * tmfree - free memory used by the translator
+ */
+void tmfree()
+   {
+   free((char *) chash);   chash = NULL;
+   free((char *) ghash);   ghash = NULL;
+   free((char *) lhash);   lhash = NULL;
+
+   free_stbl();           /* free string table */
+   clear_sbuf(&lex_sbuf); /* free buffer store for strings */
+   }
diff --git a/src/icont/tparse.c b/src/icont/tparse.c
new file mode 100644
index 0000000..35420fb
--- /dev/null
+++ b/src/icont/tparse.c
@@ -0,0 +1,1917 @@
+# 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 "tgram.g"
+/*
+ * These commented directives are passed through the first application
+ * of cpp, then turned into real includes in tgram.g by fixgram.icn.
+ */
+#include "../h/gsupport.h"
+#undef T_Real
+#undef T_String
+#undef T_Cset
+#include "../h/lexdef.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "tsym.h"
+#include "tree.h"
+#include "keyword.h"
+#undef YYSTYPE
+#define YYSTYPE nodeptr
+#define YYMAXDEPTH 500
+
+extern int fncargs[];
+int idflag;
+int id_cnt;
+
+
+
+#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 442 "tgram.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 179 "tgram.g"
+{gout(globfile);} break;
+case 4:
+# line 184 "tgram.g"
+{if (!nocode) rout(globfile, Str0(yypvt[-0])); nocode = 0; loc_init();} break;
+case 5:
+# line 185 "tgram.g"
+{if (!nocode) codegen(yypvt[-0]); nocode = 0; loc_init();} break;
+case 6:
+# line 186 "tgram.g"
+{;} break;
+case 7:
+# line 187 "tgram.g"
+{;} break;
+case 8:
+# line 188 "tgram.g"
+{;} break;
+case 9:
+# line 190 "tgram.g"
+{;} break;
+case 11:
+# line 193 "tgram.g"
+{;} break;
+case 12:
+# line 195 "tgram.g"
+{addinvk(Str0(yypvt[-0]),1);} break;
+case 13:
+# line 196 "tgram.g"
+{addinvk(Str0(yypvt[-0]),2);} break;
+case 14:
+# line 197 "tgram.g"
+{addinvk(Str0(yypvt[-2]),3);} break;
+case 15:
+# line 199 "tgram.g"
+{;} break;
+case 17:
+# line 202 "tgram.g"
+{;} break;
+case 18:
+# line 204 "tgram.g"
+{addlfile(Str0(yypvt[-0]));} break;
+case 19:
+# line 205 "tgram.g"
+{addlfile(Str0(yypvt[-0]));} break;
+case 20:
+# line 207 "tgram.g"
+{idflag = F_Global;} break;
+case 21:
+# line 207 "tgram.g"
+{;} break;
+case 22:
+# line 209 "tgram.g"
+{idflag = F_Argument;} break;
+case 23:
+# line 209 "tgram.g"
+{
+		install(Str0(yypvt[-4]),F_Record|F_Global,id_cnt); yyval = yypvt[-4];
+		} break;
+case 24:
+# line 213 "tgram.g"
+{id_cnt = 0;} break;
+case 25:
+# line 214 "tgram.g"
+{;} break;
+case 26:
+# line 216 "tgram.g"
+{
+		yyval = tree6(N_Proc,yypvt[-5],yypvt[-5],yypvt[-2],yypvt[-1],yypvt[-0]);
+		} break;
+case 27:
+# line 220 "tgram.g"
+{idflag = F_Argument;} break;
+case 28:
+# line 220 "tgram.g"
+{
+		yyval = yypvt[-4]; install(Str0(yypvt[-4]),F_Proc|F_Global,id_cnt);
+		} break;
+case 29:
+# line 224 "tgram.g"
+{id_cnt = 0;} break;
+case 30:
+# line 225 "tgram.g"
+{;} break;
+case 31:
+# line 226 "tgram.g"
+{id_cnt = -id_cnt;} break;
+case 32:
+# line 229 "tgram.g"
+{
+		install(Str0(yypvt[-0]),idflag,0); id_cnt = 1;
+		} break;
+case 33:
+# line 232 "tgram.g"
+{
+		install(Str0(yypvt[-0]),idflag,0); ++id_cnt;
+		} break;
+case 34:
+# line 236 "tgram.g"
+{;} break;
+case 35:
+# line 237 "tgram.g"
+{;} break;
+case 36:
+# line 239 "tgram.g"
+{idflag = F_Dynamic;} break;
+case 37:
+# line 240 "tgram.g"
+{idflag = F_Static;} break;
+case 38:
+# line 242 "tgram.g"
+{yyval = tree1(N_Empty);} break;
+case 39:
+# line 243 "tgram.g"
+{yyval = yypvt[-1];} break;
+case 40:
+# line 245 "tgram.g"
+{yyval = tree1(N_Empty);} break;
+case 41:
+# line 246 "tgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 42:
+# line 248 "tgram.g"
+{yyval = tree1(N_Empty);} break;
+case 45:
+# line 252 "tgram.g"
+{yyval = tree5(N_Conj,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 47:
+# line 255 "tgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 49:
+# line 258 "tgram.g"
+case 50:
+# line 259 "tgram.g"
+case 51:
+# line 260 "tgram.g"
+case 52:
+# line 261 "tgram.g"
+{yyval = tree5(N_Binop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 53:
+# line 262 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 54:
+# line 263 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 55:
+# line 264 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 56:
+# line 265 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 57:
+# line 266 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 58:
+# line 267 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 59:
+# line 268 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 60:
+# line 269 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 61:
+# line 270 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 62:
+# line 271 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 63:
+# line 272 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 64:
+# line 273 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 65:
+# line 274 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 66:
+# line 275 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 67:
+# line 276 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 68:
+# line 277 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 69:
+# line 278 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 70:
+# line 279 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 71:
+# line 280 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 72:
+# line 281 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 73:
+# line 282 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 74:
+# line 283 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 75:
+# line 284 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 76:
+# line 285 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 77:
+# line 286 "tgram.g"
+{yyval = tree5(N_Augop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 78:
+# line 287 "tgram.g"
+{yyval = tree5(N_Scan,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 79:
+# line 288 "tgram.g"
+{yyval = tree5(N_Conj,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 80:
+# line 289 "tgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-0],yypvt[-2]);} break;
+case 82:
+# line 292 "tgram.g"
+{yyval = tree4(N_To,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 83:
+# line 293 "tgram.g"
+{yyval = tree5(N_ToBy,yypvt[-3],yypvt[-4],yypvt[-2],yypvt[-0]);} break;
+case 85:
+# line 296 "tgram.g"
+{yyval = tree4(N_Alt,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 87:
+# line 299 "tgram.g"
+case 88:
+# line 300 "tgram.g"
+case 89:
+# line 301 "tgram.g"
+case 90:
+# line 302 "tgram.g"
+case 91:
+# line 303 "tgram.g"
+case 92:
+# line 304 "tgram.g"
+case 93:
+# line 305 "tgram.g"
+case 94:
+# line 306 "tgram.g"
+case 95:
+# line 307 "tgram.g"
+case 96:
+# line 308 "tgram.g"
+case 97:
+# line 309 "tgram.g"
+case 98:
+# line 310 "tgram.g"
+case 99:
+# line 311 "tgram.g"
+case 100:
+# line 312 "tgram.g"
+case 102:
+# line 315 "tgram.g"
+case 103:
+# line 316 "tgram.g"
+case 105:
+# line 319 "tgram.g"
+case 106:
+# line 320 "tgram.g"
+case 107:
+# line 321 "tgram.g"
+case 108:
+# line 322 "tgram.g"
+case 110:
+# line 325 "tgram.g"
+case 111:
+# line 326 "tgram.g"
+case 112:
+# line 327 "tgram.g"
+case 113:
+# line 328 "tgram.g"
+case 115:
+# line 331 "tgram.g"
+{yyval = tree5(N_Binop,yypvt[-1],yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 117:
+# line 334 "tgram.g"
+{yyval = tree4(N_Limit,yypvt[-2],yypvt[-2],yypvt[-0]);} break;
+case 118:
+# line 335 "tgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-0],yypvt[-2]);} break;
+case 119:
+# line 336 "tgram.g"
+{yyval = tree4(N_Apply,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 121:
+# line 339 "tgram.g"
+{yyval = tree5(N_Activat,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 122:
+# line 340 "tgram.g"
+{yyval = tree3(N_Not,yypvt[-0],yypvt[-0]);} break;
+case 123:
+# line 341 "tgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]);} break;
+case 124:
+# line 342 "tgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]);} break;
+case 125:
+# line 343 "tgram.g"
+{yyval = tree3(N_Bar,yypvt[-0],yypvt[-0]);} break;
+case 126:
+# line 344 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 127:
+# line 345 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 128:
+# line 346 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 129:
+# line 347 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 130:
+# line 348 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 131:
+# line 349 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 132:
+# line 350 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 133:
+# line 351 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 134:
+# line 352 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 135:
+# line 353 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 136:
+# line 354 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 137:
+# line 355 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 138:
+# line 356 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 139:
+# line 357 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 140:
+# line 358 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 141:
+# line 359 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 142:
+# line 360 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 143:
+# line 361 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 144:
+# line 362 "tgram.g"
+{yyval = tree4(N_Unop,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 154:
+# line 373 "tgram.g"
+{yyval = tree3(N_Create,yypvt[-1],yypvt[-0]);} break;
+case 155:
+# line 374 "tgram.g"
+{Val0(yypvt[-0]) = putloc(Str0(yypvt[-0]),0);} break;
+case 156:
+# line 375 "tgram.g"
+{yyval = tree2(N_Next,yypvt[-0]);} break;
+case 157:
+# line 376 "tgram.g"
+{yyval = tree3(N_Break,yypvt[-1],yypvt[-0]);} break;
+case 158:
+# line 377 "tgram.g"
+{if ((yypvt[-1])->n_type == N_Elist) yyval = tree4(N_Invok,yypvt[-2],tree1(N_Empty),yypvt[-1]); else yyval = yypvt[-1];} break;
+case 159:
+# line 378 "tgram.g"
+{yyval = yypvt[-1];} break;
+case 160:
+# line 379 "tgram.g"
+{yyval = tree3(N_List,yypvt[-2],yypvt[-1]);} break;
+case 161:
+# line 380 "tgram.g"
+{yyval = buildarray(yypvt[-3],yypvt[-2],yypvt[-1],yypvt[-0]);} break;
+case 162:
+# line 381 "tgram.g"
+{yyval = tree4(N_Invok,yypvt[-1],yypvt[-2], tree3(N_List,yypvt[-1],tree1(N_Empty)));} break;
+case 163:
+# line 382 "tgram.g"
+{yyval = tree4(N_Invok,yypvt[-2],yypvt[-3],tree3(N_List,yypvt[-2],yypvt[-1]));} break;
+case 164:
+# line 383 "tgram.g"
+{yyval = tree4(N_Invok,yypvt[-2],yypvt[-3],yypvt[-1]);} break;
+case 165:
+# line 384 "tgram.g"
+{yyval = tree4(N_Field,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 166:
+# line 385 "tgram.g"
+{yyval = c_str_leaf(N_Key,yypvt[-1],"fail");} break;
+case 167:
+# line 386 "tgram.g"
+{if (klookup(Str0(yypvt[-0])) == 0) tfatal("invalid keyword",Str0(yypvt[-0])); yyval = c_str_leaf(N_Key,yypvt[-1],Str0(yypvt[-0]));} break;
+case 168:
+# line 388 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 169:
+# line 389 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]);} break;
+case 170:
+# line 391 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 171:
+# line 392 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]);} break;
+case 172:
+# line 394 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 173:
+# line 395 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]);} break;
+case 174:
+# line 397 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 175:
+# line 399 "tgram.g"
+{yyval = tree4(N_Ret,yypvt[-0],yypvt[-0],tree1(N_Empty));} break;
+case 176:
+# line 400 "tgram.g"
+{yyval = tree4(N_Ret,yypvt[-1],yypvt[-1],yypvt[-0]);} break;
+case 177:
+# line 401 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-1],yypvt[-1],yypvt[-0],tree1(N_Empty));} break;
+case 178:
+# line 402 "tgram.g"
+{yyval = tree5(N_Loop,yypvt[-3],yypvt[-3],yypvt[-2],yypvt[-0]);} break;
+case 179:
+# line 404 "tgram.g"
+{yyval = tree5(N_If,yypvt[-3],yypvt[-2],yypvt[-0],tree1(N_Empty));} break;
+case 180:
+# line 405 "tgram.g"
+{yyval = tree5(N_If,yypvt[-5],yypvt[-4],yypvt[-2],yypvt[-0]);} break;
+case 181:
+# line 407 "tgram.g"
+{yyval = tree4(N_Case,yypvt[-5],yypvt[-4],yypvt[-1]);} break;
+case 183:
+# line 410 "tgram.g"
+{yyval = tree4(N_Clist,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 184:
+# line 412 "tgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 185:
+# line 413 "tgram.g"
+{yyval = tree4(N_Ccls,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 186:
+# line 415 "tgram.g"
+{;} break;
+case 187:
+# line 416 "tgram.g"
+{yyval = tree4(N_Elist,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+case 188:
+# line 418 "tgram.g"
+{
+		yyval = tree3(N_Create,yypvt[-0],yypvt[-0]);
+		} break;
+case 189:
+# line 421 "tgram.g"
+{
+		yyval = tree4(N_Elist,yypvt[-1],yypvt[-2],tree3(N_Create,yypvt[-1],yypvt[-0]));
+		} break;
+case 190:
+# line 425 "tgram.g"
+{Val0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_IntLit,0);} break;
+case 191:
+# line 426 "tgram.g"
+{Val0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_RealLit,0);} break;
+case 192:
+# line 427 "tgram.g"
+{Val0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_StrLit,(int)Val1(yypvt[-0]));} break;
+case 193:
+# line 428 "tgram.g"
+{Val0(yypvt[-0]) = putlit(Str0(yypvt[-0]),F_CsetLit,(int)Val1(yypvt[-0]));} break;
+case 194:
+# line 430 "tgram.g"
+{yyval = tree6(N_Sect,yypvt[-2],yypvt[-2],yypvt[-5],yypvt[-3],yypvt[-1]);} break;
+case 195:
+# line 432 "tgram.g"
+{yyval = yypvt[-0];} break;
+case 196:
+# line 433 "tgram.g"
+{yyval = yypvt[-0];} break;
+case 197:
+# line 434 "tgram.g"
+{yyval = yypvt[-0];} break;
+case 199:
+# line 437 "tgram.g"
+{yyval = tree4(N_Slist,yypvt[-1],yypvt[-2],yypvt[-0]);} break;
+	}
+	goto yystack;		/* reset registers in driver code */
+}
diff --git a/src/icont/tproto.h b/src/icont/tproto.h
new file mode 100644
index 0000000..aaea6c4
--- /dev/null
+++ b/src/icont/tproto.h
@@ -0,0 +1,106 @@
+/*
+ * Prototypes for functions in icont.
+ */
+
+void	addinvk			(char *name, int n);
+void	addlfile		(char *name);
+pointer	alloc			(unsigned int n);
+void	alsolink		(char *name);
+int	blocate			(word s);
+struct	node *c_str_leaf	(int type,struct node *loc_model, char *c);
+void	codegen			(struct node *t);
+void	constout		(FILE *fd);
+void	dummyda			(void);
+struct	fentry *flocate		(word id);
+struct	fileparts *fparse	(char *s);
+void	gencode			(void);
+void	gentables		(void);
+int	getdec			(void);
+int	getopr			(int ac, int *cc);
+word	getid			(void);
+long	getint			(int i, word *wp);
+int	getlab			(void);
+struct	lfile *getlfile		(struct lfile * *lptr);
+int	getoct			(void);
+int	getopc			(char * *id);
+double	getreal			(void);
+word	getrest			(void);
+word	getstr			(void);
+word	getstrlit		(int l);
+struct	gentry *glocate		(word id);
+void	gout			(FILE *fd);
+struct	node *i_str_leaf	(int type,struct node *loc_model,char *c,int d);
+int	ilink			(char * *ifiles,char *outname);
+void	initglob		(void);
+void	install			(char *name,int flag,int argcnt);
+word	instid			(char *s);
+struct	node *int_leaf		(int type,struct node *loc_model,int c);
+int	klookup			(char *id);
+int	lexeql			(int l,char *s1,char *s2);
+void	lfatal			(char *s1,char *s2);
+void	linit			(void);
+void	lmfree			(void);
+void	loc_init		(void);
+void	locinit			(void);
+void	lout			(FILE *fd);
+void	lwarn			(char *s1,char *s2,char *s3);
+char	*makename		(char *dest,char *d,char *name,char *e);
+void	newline			(void);
+int	nextchar		(void);
+void	nfatal			(struct node *n,char *s1,char *s2);
+void	putconst		(int n,int flags,int len,word pc, union xval *valp);
+void	putfield		(word fname,struct gentry *gp,int fnum);
+struct	gentry *putglobal	(word id,int flags,int nargs, int procid);
+char	*putid			(int len);
+word	putident		(int len, int install);
+int	putlit			(char *id,int idtype,int len);
+int	putloc			(char *id,int id_type);
+void	putlocal		(int n,word id,int flags,int imperror,
+				   word procname);
+void	quit			(char *msg);
+void	quitf			(char *msg,char *arg);
+void	readglob		(void);
+void report			(char *s);
+unsigned int round2		(unsigned int n);
+void	rout			(FILE *fd,char *name);
+char	*salloc			(char *s);
+void	scanrefs		(void);
+void	sizearg			(char *arg,char * *argv);
+int	smatch			(char *s,char *t);
+pointer	tcalloc			(unsigned int m,unsigned int n);
+void	tfatal			(char *s1,char *s2);
+void	tmalloc			(void);
+void	tmfree			(void);
+void	tminit			(void);
+int	trans			(char * *ifiles, char *tgtdir);
+pointer trealloc		(pointer table, pointer tblfree,
+                                  unsigned int *size, int unit_size,
+                                  int min_units, char *tbl_name);
+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);
+struct node *buildarray		(struct node *a,struct node *lb,
+					struct node *e, struct node *rb);
+void	treeinit		(void);
+void	tsyserr			(char *s);
+void	writecheck		(int rc);
+void	yyerror			(int tok,struct node *lval,int state);
+int	yylex			(void);
+int	yyparse			(void);
+
+#ifdef DeBugTrans
+   void	cdump			(void);
+   void	gdump			(void);
+   void	ldump			(void);
+#endif					/* DeBugTrans */
+
+#ifdef DeBugLinker
+   void	idump			(char *c);
+#endif					/* DeBugLinker */
diff --git a/src/icont/trans.c b/src/icont/trans.c
new file mode 100644
index 0000000..c27b1f6
--- /dev/null
+++ b/src/icont/trans.c
@@ -0,0 +1,125 @@
+/*
+ * trans.c - main control of the translation process.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "../h/version.h"
+#include "tglobals.h"
+#include "tsym.h"
+#include "tree.h"
+#include "ttoken.h"
+
+/*
+ * Prototypes.
+ */
+
+static	void	trans1		(char *filename, char *tgtdir);
+
+int tfatals;			/* number of fatal errors in file */
+int afatals;			/* total number of fatal errors */
+int nocode;			/* non-zero to suppress code generation */
+int in_line;			/* current input line number */
+int incol;			/* current input column number */
+int peekc;			/* one-character look ahead */
+
+/*
+ * translate a number of files, returning an error count
+ */
+int trans(ifiles, tgtdir)
+char **ifiles;
+char *tgtdir;
+   {
+   afatals = 0;
+
+   tmalloc();			/* allocate memory for translation */
+   while (*ifiles) {
+      trans1(*ifiles++, tgtdir);	/* translate each file in turn */
+      afatals += tfatals;
+      }
+   tmfree();			/* free memory used for translation */
+
+   /*
+    * Report information about errors and warnings and be correct about it.
+    */
+   if (afatals == 1)
+      report("1 error\n");
+   else if (afatals > 1) {
+      char tmp[12];
+      sprintf(tmp, "%d errors\n", afatals);
+      report(tmp);
+      }
+   else
+      report("No errors\n");
+
+   return afatals;
+   }
+
+/*
+ * translate one file.
+ */
+static void trans1(filename, tgtdir)
+char *filename, *tgtdir;
+{
+   char oname1[MaxPath];	/* buffer for constructing file name */
+   char oname2[MaxPath];	/* buffer for constructing file name */
+
+   tfatals = 0;			/* reset error counts */
+   nocode = 0;			/* allow code generation */
+   in_line = 1;			/* start with line 1, column 0 */
+   incol = 0;
+   peekc = 0;			/* clear character lookahead */
+
+   if (!ppinit(filename,lpath,m4pre))
+      quitf("cannot open %s",filename);
+
+   if (strcmp(filename,"-") == 0)
+      filename = "stdin";
+
+   report(filename);
+
+   if (pponly) {
+      ppecho();
+      return;
+      }
+
+   /*
+    * Form names for the .u1 and .u2 files and open them.
+    *  Write the ucode version number to the .u2 file.
+    */
+   makename(oname1, tgtdir, filename, U1Suffix);
+   codefile = fopen(oname1, "w");
+   if (codefile == NULL)
+      quitf("cannot create %s", oname1);
+   makename(oname2, tgtdir, filename, U2Suffix);
+   globfile = fopen(oname2, "w");
+   if (globfile == NULL)
+      quitf("cannot create %s", oname2);
+   writecheck(fprintf(globfile,"version\t%s\n",UVersion));
+
+   tok_loc.n_file = filename;
+   in_line = 1;
+
+   tminit();				/* Initialize data structures */
+   yyparse();				/* Parse the input */
+
+   /*
+    * Close the output files.
+    */
+   if (fclose(codefile) != 0 || fclose(globfile) != 0)
+      quit("cannot close ucode file");
+   if (tfatals) {
+      remove(oname1);
+      remove(oname2);
+      }
+   }
+
+/*
+ * writecheck - check the return code from a stdio output operation
+ */
+void writecheck(rc)
+int rc;
+   {
+   if (rc < 0)
+      quit("cannot write to ucode file");
+}
diff --git a/src/icont/trash.icn b/src/icont/trash.icn
new file mode 100644
index 0000000..a94594b
--- /dev/null
+++ b/src/icont/trash.icn
@@ -0,0 +1,35 @@
+#
+#  This is an ad-hoc program for removing duplicate code in the main switch
+#  statement for binary operators (the optimizer should fold these, if
+#  the compiler can get that far).
+#
+#  This program relies on the form of parse.c as presently produced; it is
+#  fragile and may need modification for other versions of parse.c.  Look
+#  at your parse.c first to see if the template is correct.
+#
+#  The same thing could be done for N_Unop, but if this works, that will not
+#  be necesssary.
+
+procedure main()
+   template := "{yyval = tree5(N_Binop"
+   while line := read () do {
+      if not(match(template,line)) then
+         write(line)		# copy until "offending member" is found
+      else {
+         lastline := line	# save it for last case in group
+         buffer := []		# push-back buffer
+         repeat {
+            put(buffer,read())	# "case ..."
+            put(buffer,read())	# "# line ...
+            line := read()
+            if not match(template,line) then {
+               write(lastline)	# if not a duplicate, insert the one instance
+               while write(get(buffer))	# write out lines pushed back
+               write(line)	# write the new line
+               break		# break back to the main loop (may be more)
+               }
+             else while write(get(buffer))  # else write out lines pushed back
+             }
+          }
+       }
+end
diff --git a/src/icont/tree.c b/src/icont/tree.c
new file mode 100644
index 0000000..535c62a
--- /dev/null
+++ b/src/icont/tree.c
@@ -0,0 +1,175 @@
+/*
+ * tree.c -- functions for constructing parse trees
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "tree.h"
+
+/*
+ *  tree[1-6] construct parse tree nodes with specified values.
+ *   Parameters a and b are line and column information,
+ *   while parameters c through f 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;
+   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;
+   return t;
+   }
+
+nodeptr tree3(type, loc_model, c)
+int type;
+nodeptr loc_model;
+nodeptr c;
+   {
+   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->n_field[0].n_ptr = c;
+   return t;
+   }
+
+nodeptr tree4(type, loc_model, c, d)
+int type;
+nodeptr loc_model;
+nodeptr c, d;
+   {
+   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->n_field[0].n_ptr = c;
+   t->n_field[1].n_ptr = d;
+   return t;
+   }
+
+nodeptr tree5(type, loc_model, c, d, e)
+int type;
+nodeptr loc_model;
+nodeptr c, d, e;
+   {
+   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->n_field[0].n_ptr = c;
+   t->n_field[1].n_ptr = d;
+   t->n_field[2].n_ptr = e;
+   return t;
+   }
+
+nodeptr tree6(type, loc_model, c, d, e, f)
+int type;
+nodeptr loc_model;
+nodeptr c, d, e, f;
+   {
+   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->n_field[0].n_ptr = c;
+   t->n_field[1].n_ptr = d;
+   t->n_field[2].n_ptr = e;
+   t->n_field[3].n_ptr = f;
+   return t;
+   }
+
+nodeptr buildarray(a,lb,e,rb)
+nodeptr a, lb, e, rb;
+   {
+   register nodeptr t, t2;
+   if (e->n_type == N_Elist) {
+      t2 = int_leaf(lb->n_type, lb, (int)lb->n_field[0].n_val);
+      t = tree5(N_Binop, t2, t2, buildarray(a,lb,e->n_field[0].n_ptr,rb),
+		e->n_field[1].n_ptr);
+      free(e);
+      }
+   else
+      t = tree5(N_Binop, lb, lb, a, e);
+   return t;
+   }
+
+nodeptr int_leaf(type, loc_model, c)
+int type;
+nodeptr loc_model;
+int c;
+   {
+   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->n_field[0].n_val = c;
+   return t;
+   }
+
+nodeptr c_str_leaf(type, loc_model, c)
+int type;
+nodeptr loc_model;
+char *c;
+   {
+   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->n_field[0].n_str = c;
+   return t;
+   }
+
+nodeptr i_str_leaf(type, loc_model, c, d)
+int type;
+nodeptr loc_model;
+char *c;
+int d;
+   {
+   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->n_field[0].n_str = c;
+   t->n_field[1].n_val = d;
+   return t;
+   }
+
diff --git a/src/icont/tree.h b/src/icont/tree.h
new file mode 100644
index 0000000..7950c81
--- /dev/null
+++ b/src/icont/tree.h
@@ -0,0 +1,109 @@
+/*
+ * Structure of a tree node.
+ */
+
+typedef	struct node	*nodeptr;
+#define YYSTYPE nodeptr
+
+union field {
+   long n_val;		/* integer-valued fields */
+   char *n_str;		/* string-valued fields */
+   nodeptr n_ptr;	/* subtree pointers */
+   };
+
+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 */
+   union field n_field[1];      /* variable-content fields */
+   };
+
+#define NewNode(size) (struct node *)alloc(\
+    (sizeof(struct node) + (size-1) * sizeof(union field)))
+
+/*
+ * Macros to access fields of parse tree nodes.
+ */
+
+#define TType(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 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
+
+/*
+ * 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_Augop		 3		/* augmented operator */
+#define N_Bar		 4		/* generator control structure */
+#define N_Binop		 5		/* other binary operator */
+#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_Conj		10		/* conjunction operator */
+#define N_Create	11		/* create control structure */
+#define N_Cset		12		/* cset literal */
+#define N_Elist		14		/* list of expressions */
+#define N_Empty		15		/* empty expression or statement */
+#define N_Field		16		/* record field reference */
+#define N_Id		17		/* identifier token */
+#define N_If		18		/* if-then-else statement */
+#define N_Int		19		/* integer literal */
+#define N_Invok		20		/* invocation */
+#define N_Key		21		/* keyword */
+#define N_Limit		22		/* LIMIT control structure */
+#define N_List		23		/* [ ... ] style list */
+#define N_Loop		24		/* while, until, every, or repeat */
+#define N_Not		25		/* not prefix control structure */
+#define N_Next		26		/* next statement */
+#define N_Op		27		/* operator token */
+#define N_Proc		28		/* procedure */
+#define N_Real		29		/* real literal */
+#define N_Res		30		/* reserved word token */
+#define N_Ret		31		/* fail, return, or succeed */
+#define N_Scan		32		/* scan-using statement */
+#define N_Sect		33		/* s[i:j] (section) */
+#define N_Slist		34		/* list of statements */
+#define N_Str		35		/* string literal */
+#define N_Susp		36		/* suspend statement */
+#define N_To		37		/* TO operator */
+#define N_ToBy		38		/* TO-BY operator */
+#define N_Unop		39		/* unary operator */
+#define N_Apply		40		/* procedure application */
+
+
+/*
+ * 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,optab[a].tok.t_type)
+#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)
diff --git a/src/icont/tsym.c b/src/icont/tsym.c
new file mode 100644
index 0000000..1d0f16c
--- /dev/null
+++ b/src/icont/tsym.c
@@ -0,0 +1,519 @@
+/*
+ * tsym.c -- functions for symbol table management.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "ttoken.h"
+#include "tsym.h"
+#include "keyword.h"
+#include "lfile.h"
+
+/*
+ * Prototypes.
+ */
+
+static struct	tgentry *alcglob
+   (struct tgentry *blink, char *name,int flag,int nargs);
+static struct	tcentry *alclit
+   (struct tcentry *blink, char *name, int len,int flag);
+static struct	tlentry *alcloc
+   (struct tlentry *blink, char *name,int flag);
+static struct	tcentry *clookup	(char *id,int flag);
+static struct	tgentry *glookup	(char *id);
+static struct	tlentry *llookup	(char *id);
+static void	putglob
+   (char *id,int id_type, int n_args);
+
+#ifdef DeBugTrans
+   void	cdump	(void);
+   void	gdump	(void);
+   void	ldump	(void);
+#endif					/* DeBugTrans */
+
+
+/*
+ * Keyword table.
+ */
+
+struct keyent {
+   char *keyname;
+   int keyid;
+   };
+
+#define KDef(p,n) Lit(p), n,
+static struct keyent keytab[] = {
+#include "../h/kdefs.h"
+   NULL, -1
+};
+
+/*
+ * loc_init - clear the local and constant symbol tables.
+ */
+
+void loc_init()
+   {
+   struct tlentry *lptr, *lptr1;
+   struct tcentry *cptr, *cptr1;
+   int i;
+
+   /*
+    * Clear local table, freeing entries.
+    */
+   for (i = 0; i < lhsize; i++) {
+      for (lptr = lhash[i]; lptr != NULL; lptr = lptr1) {
+          lptr1 = lptr->l_blink;
+          free((char *)lptr);
+          }
+       lhash[i] = NULL;
+       }
+   lfirst = NULL;
+   llast = NULL;
+
+   /*
+    * Clear constant table, freeing entries.
+    */
+   for (i = 0; i < lchsize; i++) {
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr1) {
+          cptr1 = cptr->c_blink;
+          free((char *)cptr);
+          }
+       chash[i] = NULL;
+       }
+   cfirst = NULL;
+   clast = NULL;
+   }
+
+/*
+ * 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, argcnt)
+char *name;
+int flag, argcnt;
+   {
+   union {
+      struct tgentry *gp;
+      struct tlentry *lp;
+      } p;
+
+   switch (flag) {
+      case F_Global:	/* a variable in a global declaration */
+         if ((p.gp = glookup(name)) == NULL)
+            putglob(name, flag, argcnt);
+         else
+            p.gp->g_flag |= flag;
+         break;
+
+      case F_Proc|F_Global:	/* procedure declaration */
+      case F_Record|F_Global:	/* record declaration */
+      case F_Builtin|F_Global:	/* external declaration */
+         if ((p.gp = glookup(name)) == NULL)
+            putglob(name, flag, argcnt);
+         else if ((p.gp->g_flag & (~F_Global)) == 0) { /* superfluous global
+							   declaration for
+							   record or proc */
+            p.gp->g_flag |= flag;
+            p.gp->g_nargs = argcnt;
+            }
+         else			/* the user can't make up his mind */
+            tfatal("inconsistent redeclaration", name);
+         break;
+
+      case F_Static:	/* static declaration */
+      case F_Dynamic:	/* local declaration (possibly implicit?) */
+      case F_Argument:	/* formal parameter */
+         if ((p.lp = llookup(name)) == NULL)
+            putloc(name,flag);
+         else if (p.lp->l_flag == flag) /* previously declared as same type */
+            tfatal("redeclared identifier", name);
+         else		/* previously declared as different type */
+            tfatal("inconsistent redeclaration", name);
+         break;
+
+      default:
+         tsyserr("install: unrecognized symbol table flag.");
+      }
+   }
+
+/*
+ * putloc - make a local symbol table entry and return the index
+ *  of the entry in lhash.  alcloc does the work if there is a collision.
+ */
+int putloc(id,id_type)
+char *id;
+int id_type;
+   {
+   register struct tlentry *ptr;
+
+   if ((ptr = llookup(id)) == NULL) {	/* add to head of hash chain */
+      ptr = lhash[lhasher(id)];
+      lhash[lhasher(id)] = alcloc(ptr, id, id_type);
+      return lhash[lhasher(id)]->l_index;
+      }
+   return ptr->l_index;
+   }
+
+/*
+ * putglob makes a global symbol table entry. alcglob does the work if there
+ *  is a collision.
+ */
+
+static void putglob(id, id_type, n_args)
+char *id;
+int id_type, n_args;
+   {
+   register struct tgentry *ptr;
+
+   if ((ptr = glookup(id)) == NULL) {	 /* add to head of hash chain */
+      ptr = ghash[ghasher(id)];
+      ghash[ghasher(id)] = alcglob(ptr, id, id_type, n_args);
+      }
+   }
+
+/*
+ * putlit makes a constant symbol table entry and returns the table "index"
+ *  of the constant.  alclit does the work if there is a collision.
+ */
+int putlit(id, idtype, len)
+char *id;
+int len, idtype;
+   {
+   register struct tcentry *ptr;
+
+   if ((ptr = clookup(id,idtype)) == NULL) {   /* add to head of hash chain */
+      ptr = chash[chasher(id)];
+      chash[chasher(id)] = alclit(ptr, id, len, idtype);
+      return chash[chasher(id)]->c_index;
+      }
+   return ptr->c_index;
+   }
+
+/*
+ * llookup looks up id in local symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+
+static struct tlentry *llookup(id)
+char *id;
+   {
+   register struct tlentry *ptr;
+
+   ptr = lhash[lhasher(id)];
+   while (ptr != NULL && ptr->l_name != id)
+      ptr = ptr->l_blink;
+   return ptr;
+   }
+
+/*
+ * glookup looks up id in global symbol table and returns pointer to
+ *  to it if found or NULL if not present.
+ */
+static struct tgentry *glookup(id)
+char *id;
+   {
+   register struct tgentry *ptr;
+
+   ptr = ghash[ghasher(id)];
+   while (ptr != NULL && ptr->g_name != id) {
+      ptr = ptr->g_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 tcentry *clookup(id,flag)
+char *id;
+int flag;
+   {
+   register struct tcentry *ptr;
+
+   ptr = chash[chasher(id)];
+   while (ptr != NULL && (ptr->c_name != id || ptr->c_flag != flag))
+      ptr = ptr->c_blink;
+
+   return ptr;
+   }
+
+/*
+ * klookup looks up keyword named by id in keyword table and returns
+ *  its number (keyid).
+ */
+int klookup(id)
+register char *id;
+   {
+   register struct keyent *kp;
+
+   for (kp = keytab; kp->keyid >= 0; kp++)
+      if (strcmp(kp->keyname,id) == 0)
+         return (kp->keyid);
+
+   return 0;
+   }
+
+#ifdef DeBugTrans
+/*
+ * ldump displays local symbol table to stdout.
+ */
+
+void ldump()
+   {
+   register int i;
+   register struct tlentry *lptr;
+   int n;
+
+   if (llast == NULL)
+      n = 0;
+   else
+      n = llast->l_index + 1;
+   fprintf(stderr,"Dump of local symbol table (%d entries)\n", n);
+   fprintf(stderr," loc   blink   id		  (name)      flags\n");
+   for (i = 0; i < lhsize; i++)
+      for (lptr = lhash[i]; lptr != NULL; lptr = lptr->l_blink)
+         fprintf(stderr,"%5d  %5d  %5d	%20s  %7o\n", lptr->l_index,
+		lptr->l_blink, lptr->l_name, lptr->l_name, lptr->l_flag);
+   fflush(stderr);
+
+   }
+
+/*
+ * gdump displays global symbol table to stdout.
+ */
+
+void gdump()
+   {
+   register int i;
+   register struct tgentry *gptr;
+   int n;
+
+   if (glast == NULL)
+      n = 0;
+   else
+      n = glast->g_index + 1;
+   fprintf(stderr,"Dump of global symbol table (%d entries)\n", n);
+   fprintf(stderr," loc   blink   id		  (name)      flags	  nargs\n");
+   for (i = 0; i < ghsize; i++)
+      for (gptr = ghash[i]; gptr != NULL; gptr = gptr->g_blink)
+         fprintf(stderr,"%5d  %5d  %5d	%20s  %7o   %8d\n", gptr->g_index,
+		gptr->g_blink, gptr->g_name, gptr->g_name,
+		gptr->g_flag, gptr->g_nargs);
+   fflush(stderr);
+   }
+
+/*
+ * cdump displays constant symbol table to stdout.
+ */
+
+void cdump()
+   {
+   register int i;
+   register struct tcentry *cptr;
+   int n;
+
+   if (clast == NULL)
+      n = 0;
+   else
+      n = clast->c_index + 1;
+   fprintf(stderr,"Dump of constant symbol table (%d entries)\n", n);
+   fprintf(stderr," loc   blink   id		  (name)      flags\n");
+   for (i = 0; i < lchsize; i++)
+      for (cptr = chash[i]; cptr != NULL; cptr = cptr->c_blink)
+         fprintf(stderr,"%5d  %5d  %5d	%20s  %7o\n", cptr->c_index,
+		cptr->c_blink, cptr->c_name, cptr->c_name, cptr->c_flag);
+   fflush(stderr);
+   }
+#endif					/* DeBugTrans */
+
+/*
+ * alcloc allocates a local symbol table entry, fills in fields with
+ *  specified values and returns the new entry.
+ */
+static struct tlentry *alcloc(blink, name, flag)
+struct tlentry *blink;
+char *name;
+int flag;
+   {
+   register struct tlentry *lp;
+
+   lp = NewStruct(tlentry);
+   lp->l_blink = blink;
+   lp->l_name = name;
+   lp->l_flag = flag;
+   lp->l_next = NULL;
+   if (lfirst == NULL) {
+      lfirst = lp;
+      lp->l_index = 0;
+      }
+   else {
+      llast->l_next = lp;
+      lp->l_index = llast->l_index + 1;
+      }
+   llast = lp;
+   return lp;
+   }
+
+/*
+ * alcglob allocates a global symbol table entry, fills in fields with
+ *  specified values and returns offset of new entry.
+ */
+static struct tgentry *alcglob(blink, name, flag, nargs)
+struct tgentry *blink;
+char *name;
+int flag, nargs;
+   {
+   register struct tgentry *gp;
+
+   gp = NewStruct(tgentry);
+   gp->g_blink = blink;
+   gp->g_name = name;
+   gp->g_flag = flag;
+   gp->g_nargs = nargs;
+   gp->g_next = NULL;
+   if (gfirst == NULL) {
+      gfirst = gp;
+      gp->g_index = 0;
+      }
+   else {
+      glast->g_next = gp;
+      gp->g_index = glast->g_index + 1;
+      }
+   glast = gp;
+   return gp;
+   }
+
+/*
+ * alclit allocates a constant symbol table entry, fills in fields with
+ *  specified values and returns the new entry.
+ */
+static struct tcentry *alclit(blink, name, len, flag)
+struct tcentry *blink;
+char *name;
+int len, flag;
+   {
+   register struct tcentry *cp;
+
+   cp = NewStruct(tcentry);
+   cp->c_blink = blink;
+   cp->c_name = name;
+   cp->c_length = len;
+   cp->c_flag = flag;
+   cp->c_next = NULL;
+   if (cfirst == NULL) {
+      cfirst = cp;
+      cp->c_index = 0;
+      }
+   else {
+      clast->c_next = cp;
+      cp->c_index = clast->c_index + 1;
+      }
+   clast = cp;
+   return cp;
+   }
+
+/*
+ * lout dumps local symbol table to fd, which is a .u1 file.
+ */
+void lout(fd)
+FILE *fd;
+   {
+   register struct tlentry *lp;
+
+   for (lp = lfirst; lp != NULL; lp = lp->l_next)
+      writecheck(fprintf(fd, "\tlocal\t%d,%06o,%s\n",
+         lp->l_index, lp->l_flag, lp->l_name));
+   }
+
+/*
+ * constout dumps constant symbol table to fd, which is a .u1 file.
+ */
+void constout(fd)
+FILE *fd;
+   {
+   register int l;
+   register char *c;
+   register struct tcentry *cp;
+
+   for (cp = cfirst; cp != NULL; cp = cp->c_next) {
+      writecheck(fprintf(fd, "\tcon\t%d,%06o", cp->c_index, cp->c_flag));
+      if (cp->c_flag & F_IntLit)
+         writecheck(fprintf(fd,",%d,%s\n",(int)strlen(cp->c_name),cp->c_name));
+      else if (cp->c_flag & F_RealLit)
+         writecheck(fprintf(fd, ",%s\n", cp->c_name));
+      else {
+         c = cp->c_name;
+         l = cp->c_length;
+         writecheck(fprintf(fd, ",%d", l));
+         while (l--)
+            writecheck(fprintf(fd, ",%03o", *c++ & 0377));
+         writecheck(putc('\n', fd));
+         }
+      }
+   }
+
+/*
+ * rout dumps a record declaration for name to file fd, which is a .u2 file.
+ */
+void rout(fd,name)
+FILE *fd;
+char *name;
+   {
+   register struct tlentry *lp;
+   int n;
+
+   if (llast == NULL)
+      n = 0;
+   else
+      n = llast->l_index + 1;
+   writecheck(fprintf(fd, "record\t%s,%d\n", name, n));
+   for (lp = lfirst; lp != NULL; lp = lp->l_next)
+      writecheck(fprintf(fd, "\t%d,%s\n", lp->l_index, lp->l_name));
+   }
+
+/*
+ * gout writes various items to fd, which is a .u2 file.  These items
+ *  include: implicit status, tracing activation, link directives,
+ *  invocable directives, and the global table.
+ */
+void gout(fd)
+FILE *fd;
+   {
+   register char *name;
+   register struct tgentry *gp;
+   int n;
+   struct lfile *lfl;
+   struct invkl *ivl;
+
+   if (uwarn)
+      name = "error";
+   else
+      name = "local";
+   writecheck(fprintf(fd, "impl\t%s\n", name));
+   if (trace)
+      writecheck(fprintf(fd, "trace\n"));
+
+   lfl = lfiles;
+   while (lfl) {
+      writecheck(fprintf(fd,"link\t%s.u1\n",lfl->lf_name));
+      lfl = lfl->lf_link;
+      }
+   lfiles = 0;
+
+   for (ivl = invkls; ivl != NULL; ivl = ivl->iv_link)
+      writecheck(fprintf(fd, "invocable\t%s\n", ivl->iv_name));
+   invkls = NULL;
+
+   if (glast == NULL)
+      n = 0;
+   else
+      n = glast->g_index + 1;
+   writecheck(fprintf(fd, "global\t%d\n", n));
+   for (gp = gfirst; gp != NULL; gp = gp->g_next)
+      writecheck(fprintf(fd, "\t%d,%06o,%s,%d\n", gp->g_index, gp->g_flag,
+         gp->g_name, gp->g_nargs));
+   }
diff --git a/src/icont/tsym.h b/src/icont/tsym.h
new file mode 100644
index 0000000..a932345
--- /dev/null
+++ b/src/icont/tsym.h
@@ -0,0 +1,69 @@
+/*
+ * Structures for symbol table entries.
+ */
+
+struct tlentry {			/* local table entry */
+   struct tlentry *l_blink;	/*   link for bucket chain */
+   char *l_name;		/*   name of variable */
+   int l_flag;			/*   variable flags */
+   int l_index;			/*   "index" of local in table */
+   struct tlentry *l_next;      /*   next local in table */
+   };
+
+struct tgentry {			/* global table entry */
+   struct tgentry *g_blink;	/*   link for bucket chain */
+   char *g_name;		/*   name of variable */
+   int g_flag;			/*   variable flags */
+   int g_nargs;			/*   number of args (procedure) or */
+   int g_index;			/*   "index" of global in table */
+   struct tgentry *g_next;      /*   next global in table */
+   };				/*     number of fields (record) */
+
+struct tcentry {			/* constant table entry */
+   struct tcentry *c_blink;	/*   link for bucket chain */
+   char *c_name;		/*   pointer to string */
+   int c_length;		/*   length of string */
+   int c_flag;			/*   type of literal flag */
+   int c_index;			/*   "index" of constant in table */
+   struct tcentry *c_next;      /*   next constant in table */
+   };
+
+/*
+ * 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_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 */
+
+/*
+ * Symbol table region pointers.
+ */
+
+extern struct tlentry **lhash;	/* hash area for local table */
+extern struct tgentry **ghash;	/* hash area for global table */
+extern struct tcentry **chash;	/* hash area for constant table */
+
+extern struct tlentry *lfirst;	/* first local table entry */
+extern struct tlentry *llast;	/* last local table entry */
+extern struct tcentry *cfirst;	/* first constant table entry */
+extern struct tcentry *clast;	/* last constant table entry */
+extern struct tgentry *gfirst;	/* first global table entry */
+extern struct tgentry *glast;	/* last global table entry */
+
+/*
+ * Hash functions for symbol tables.
+ */
+
+#define ghasher(x)	(((word)x)&gmask)	 /* global symbol table */
+#define lhasher(x)	(((word)x)&lmask)	 /* local symbol table */
+#define chasher(x)	(((word)x)&cmask)	 /* constant symbol table */
diff --git a/src/icont/ttoken.h b/src/icont/ttoken.h
new file mode 100644
index 0000000..1e95e98
--- /dev/null
+++ b/src/icont/ttoken.h
@@ -0,0 +1,111 @@
+# define IDENT 257
+# define INTLIT 258
+# define REALLIT 259
+# define STRINGLIT 260
+# define CSETLIT 261
+# define EOFX 262
+# define BREAK 263
+# define BY 264
+# define CASE 265
+# define CREATE 266
+# define DEFAULT 267
+# define DO 268
+# define ELSE 269
+# define END 270
+# define EVERY 271
+# define FAIL 272
+# define GLOBAL 273
+# define IF 274
+# define INITIAL 275
+# define INVOCABLE 276
+# define LINK 277
+# define LOCAL 278
+# define NEXT 279
+# define NOT 280
+# define OF 281
+# define PROCEDURE 282
+# define RECORD 283
+# define REPEAT 284
+# define RETURN 285
+# define STATIC 286
+# define SUSPEND 287
+# define THEN 288
+# define TO 289
+# define UNTIL 290
+# define WHILE 291
+# define BANG 292
+# define MOD 293
+# define AUGMOD 294
+# define AND 295
+# define AUGAND 296
+# define STAR 297
+# define AUGSTAR 298
+# define INTER 299
+# define AUGINTER 300
+# define PLUS 301
+# define AUGPLUS 302
+# define UNION 303
+# define AUGUNION 304
+# define MINUS 305
+# define AUGMINUS 306
+# define DIFF 307
+# define AUGDIFF 308
+# define DOT 309
+# define SLASH 310
+# define AUGSLASH 311
+# define ASSIGN 312
+# define SWAP 313
+# define NMLT 314
+# define AUGNMLT 315
+# define REVASSIGN 316
+# define REVSWAP 317
+# define SLT 318
+# define AUGSLT 319
+# define SLE 320
+# define AUGSLE 321
+# define NMLE 322
+# define AUGNMLE 323
+# define NMEQ 324
+# define AUGNMEQ 325
+# define SEQ 326
+# define AUGSEQ 327
+# define EQUIV 328
+# define AUGEQUIV 329
+# define NMGT 330
+# define AUGNMGT 331
+# define NMGE 332
+# define AUGNMGE 333
+# define SGT 334
+# define AUGSGT 335
+# define SGE 336
+# define AUGSGE 337
+# define QMARK 338
+# define AUGQMARK 339
+# define AT 340
+# define AUGAT 341
+# define BACKSLASH 342
+# define CARET 343
+# define AUGCARET 344
+# define BAR 345
+# define CONCAT 346
+# define AUGCONCAT 347
+# define LCONCAT 348
+# define AUGLCONCAT 349
+# define TILDE 350
+# define NMNE 351
+# define AUGNMNE 352
+# define SNE 353
+# define AUGSNE 354
+# define NEQUIV 355
+# define AUGNEQUIV 356
+# define LPAREN 357
+# define RPAREN 358
+# define PCOLON 359
+# define COMMA 360
+# define MCOLON 361
+# define COLON 362
+# define SEMICOL 363
+# define LBRACK 364
+# define RBRACK 365
+# define LBRACE 366
+# define RBRACE 367
diff --git a/src/icont/tunix.c b/src/icont/tunix.c
new file mode 100644
index 0000000..9478403
--- /dev/null
+++ b/src/icont/tunix.c
@@ -0,0 +1,420 @@
+/*
+ * tunix.c - user interface for Unix.
+ */
+
+#include "../h/gsupport.h"
+#include "../h/version.h"
+#include "tproto.h"
+#include "tglobals.h"
+
+static void execute (char *ofile, char *efile, char *args[]);
+static void usage (void);
+static char *libpath (char *prog, char *envname);
+
+static void txrun(char *(*func)(FILE*, char*), char *source, char *args[]);
+static char *copyfile(FILE *f, char *srcfile);
+static char *savefile(FILE *f, char *srcprog);
+static void cleanup(void);
+
+static char **rfiles;		/* list of files removed by cleanup() */
+
+/*
+ * for old method of hardwiring iconx path; not normally used.
+ */
+static char patchpath[MaxPath+18] = "%PatchStringHere->";
+
+/*
+ * 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(int argc, char *argv[]) {
+   int nolink = 0;			/* suppress linking? */
+   int errors = 0;			/* translator and linker errors */
+   char **tfiles, **tptr;		/* list of files to translate */
+   char **lfiles, **lptr;		/* list of files to link */
+   char **rptr;				/* list of files to remove */
+   char *efile = NULL;			/* stderr file */
+   char buf[MaxPath];			/* file name construction buffer */
+   int c, n;
+   char ch;
+   struct fileparts *fp;
+
+   /*
+    * Initialize globals.
+    */
+   initglob();				/* general global initialization */
+   ipath = libpath(argv[0], "IPATH");	/* set library search paths */
+   lpath = libpath(argv[0], "LPATH");
+   if (strlen(patchpath) > 18)
+      iconxloc = patchpath + 18;	/* use stated iconx path if patched */
+   else
+      iconxloc = relfile(argv[0], "/../iconx");	/* otherwise infer it */
+
+   /*
+    * Process options.
+    * IMPORTANT:  When making changes here,
+    * also update usage() function and man page.
+    */
+   while ((c = getopt(argc, argv, "+ce:f:o:stuv:ELNP:VX:")) != EOF)
+      switch (c) {
+         case 'c':			/* -c: compile only (no linking) */
+            nolink = 1;
+            break;
+         case 'e':			/* -e file: [undoc] redirect stderr */
+            efile = optarg;
+            break;
+         case 'f':			/* -f features: enable features */
+            if (strchr(optarg, 's') || strchr(optarg, 'a'))
+               strinv = 1;		/* this is the only icont feature */
+            break;
+         case 'o':			/* -o file: name output file */
+            ofile = optarg;
+            break;
+         case 's':			/* -s: suppress informative messages */
+            silent = 1;
+            verbose = 0;
+            break;
+         case 't':			/* -t: turn on procedure tracing */
+            trace = -1;
+            break;
+         case 'u':			/* -u: warn about undeclared ids */
+            uwarn = 1;
+            break;
+         case 'v':			/* -v n: set verbosity level */
+            if (sscanf(optarg, "%d%c", &verbose, &ch) != 1)
+               quitf("bad operand to -v option: %s", optarg);
+            if (verbose == 0)
+               silent = 1;
+            break;
+         case 'E':			/* -E: preprocess only */
+            pponly = 1;
+            nolink = 1;
+            break;
+         case 'P':			/* -P program: execute from argument */
+            txrun(savefile, optarg, &argv[optind]);
+            break;	/*NOTREACHED*/
+         case 'N':			/* -N: don't embed iconx path */
+            iconxloc = "";
+            break;
+         case 'V':			/* -V: print version information */
+            fprintf(stderr, "%s  (%s, %s)\n", Version, Config, __DATE__);
+            if (optind == argc)
+               exit(0);
+            break;
+         case 'X':			/* -X srcfile: execute single srcfile */
+            txrun(copyfile, optarg, &argv[optind]);
+            break;	/*NOTREACHED*/
+
+         #ifdef DeBugLinker
+            case 'L':			/* -L: enable linker debugging */
+               Dflag = 1;
+               break;
+         #endif				/* DeBugLinker */
+
+         default:
+         case 'x':			/* -x illegal until after file list */
+            usage();
+         }
+
+   /*
+    * If argv[0] ends in "icon" (instead of "icont" or anything else),
+    * process as "icon [options] sourcefile [arguments]" scripting shortcut.
+    */
+   n = strlen(argv[0]);
+   if (n >= 4 && strcmp(argv[0]+n-4, "icon") == 0) {
+      if (optind < argc)
+         txrun(copyfile, argv[optind], &argv[optind+1]);
+      else
+         usage();
+      }
+
+   /*
+    * Allocate space for lists of file names.
+    */
+   n = argc - optind + 1;
+   tptr = tfiles = alloc(n * sizeof(char *));
+   lptr = lfiles = alloc(n * sizeof(char *));
+   rptr = rfiles = alloc(2 * n * sizeof(char *));
+
+   /*
+    * Scan file name arguments.
+    */
+   while (optind < argc)  {
+      if (strcmp(argv[optind], "-x") == 0)	/* stop at -x */
+         break;
+      else if (strcmp(argv[optind], "-") == 0) {
+         *tptr++ = "-";				/* "-" means standard input */
+         *lptr++ = *rptr++ = "stdin.u1";
+         *rptr++ = "stdin.u2";
+         }
+      else {
+         fp = fparse(argv[optind]);		/* parse file name */
+         if (*fp->ext == '\0' || smatch(fp->ext, SourceSuffix)) {
+            makename(buf, SourceDir, argv[optind], SourceSuffix);
+            *tptr++ = salloc(buf);		/* translate the .icn file */
+            makename(buf, TargetDir, argv[optind], U1Suffix);
+            *lptr++ = *rptr++ = salloc(buf);	/* link & remove .u1 */
+            makename(buf, TargetDir, argv[optind], U2Suffix);
+            *rptr++ = salloc(buf);		/* also remove .u2 */
+            }
+         else if (smatch(fp->ext, U1Suffix) || smatch(fp->ext, U2Suffix)
+               || smatch(fp->ext, USuffix)) {
+            makename(buf, TargetDir, argv[optind], U1Suffix);
+            *lptr++ = salloc(buf);
+            }
+         else
+            quitf("bad argument %s", argv[optind]);
+         }
+      optind++;
+      }
+
+   *tptr = *lptr = *rptr = NULL;	/* terminate filename lists */
+   if (lptr == lfiles)
+      usage();				/* error -- no files named */
+
+   /*
+    * Translate .icn files to make .u1 and .u2 files.
+    */
+   if (tptr > tfiles) {
+      if (!pponly)
+         report("Translating");
+      errors = trans(tfiles, TargetDir);
+      if (errors > 0)			/* exit if errors seen */
+         exit(EXIT_FAILURE);
+      }
+
+   /*
+    * Link .u1 and .u2 files to make an executable.
+    */
+   if (nolink)				/* exit if no linking wanted */
+      exit(EXIT_SUCCESS);
+
+   if (ofile == NULL)  {		/* if no -o file, synthesize a name */
+      ofile = salloc(makename(buf, TargetDir, lfiles[0], IcodeSuffix));
+      }
+   else {				/* add extension in necessary */
+      fp = fparse(ofile);
+      if (*fp->ext == '\0' && *IcodeSuffix != '\0') /* if no ext given */
+         ofile = salloc(makename(buf, NULL, ofile, IcodeSuffix));
+   }
+
+   report("Linking");
+   errors = ilink(lfiles, ofile);	/* link .u files to make icode file */
+
+   /*
+    * Finish by removing intermediate files.
+    *  Execute the linked program if so requested and if there were no errors.
+    */
+   cleanup();				/* delete intermediate files */
+   if (errors > 0) {			/* exit if linker errors seen */
+      remove(ofile);
+      exit(EXIT_FAILURE);
+      }
+   if (optind < argc)  {
+      report("Executing");
+      execute (ofile, efile, argv + optind + 1);
+      }
+   exit(EXIT_SUCCESS);
+   return 0;
+   }
+
+/*
+ * execute - execute iconx to run the icon program
+ */
+static void execute(char *ofile, char *efile, char *args[]) {
+   int n;
+   char **argv, **p;
+   char buf[MaxPath+10];
+
+   /*
+    * Build argument vector.
+    */
+   for (n = 0; args[n] != NULL; n++)	/* count arguments */
+      ;
+   p = argv = alloc((n + 5) * sizeof(char *));
+
+   *p++ = ofile;			/* pass icode file name */
+   while ((*p++ = *args++) != 0)	/* copy args into argument vector */
+      ;
+   *p = NULL;
+
+   /*
+    * Redirect stderr if requested.
+    */
+   if (efile != NULL) {
+      close(fileno(stderr));
+      if (strcmp(efile, "-") == 0)
+         dup(fileno(stdout));
+      else if (freopen(efile, "w", stderr) == NULL)
+         quitf("could not redirect stderr to %s\n", efile);
+      }
+   
+   /*
+    * Export $ICONX to specify the path to iconx.
+    */
+   sprintf(buf, "ICONX=%s", iconxloc);
+   putenv(buf);
+
+   /*
+    * Execute the generated program.
+    */
+   execv(ofile, argv);
+   quitf("could not execute %s", ofile);
+   }
+
+void report(char *s) {
+   char *c = (strchr(s, '\n') ? "" : ":\n") ;
+   if (!silent)
+      fprintf(stderr, "%s%s", s, c);
+   }
+
+/*
+ * Print a usage message and abort the run.
+ */
+static void usage(void) {
+   fprintf(stderr, "usage: icon  sourcefile   [args]\n");
+   fprintf(stderr, "       icon  -P 'program' [args]\n");
+   fprintf(stderr, "       icont %s\n",
+      "[-cstuENV] [-f s] [-o ofile] [-v i] file ... [-x args]");
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * Return path after appending lib directory.
+ */
+static char *libpath(char *prog, char *envname) {
+   char buf[1000], *s;
+
+   s = getenv(envname);
+   if (s != NULL)
+      #if CYGWIN
+         cygwin_win32_to_posix_path_list(s, buf);
+      #else				/* CYGWIN */
+         strcpy(buf, s);
+      #endif				/* CYGWIN */
+   else
+      strcpy(buf, ".");
+   strcat(buf, ":");
+   strcat(buf, relfile(prog, "/../../lib"));
+   return salloc(buf);
+   }
+
+/*
+ * Translate, link, and execute a source file.
+ * Does not return under any circumstances.
+ */
+static void txrun(char *(*func)(FILE*, char*), char *source, char *args[]) {
+   int omask;
+   char c1, c2;
+   char *flist[2], *progname;
+   char srcfile[MaxPath], u1[MaxPath], u2[MaxPath];
+   char icode[MaxPath], buf[MaxPath + 20];
+   static char abet[] = "abcdefghijklmnopqrstuvwxyz";
+   FILE *f;
+
+   silent = 1;			/* don't issue commentary while translating */
+   uwarn = 1;			/* do diagnose undeclared identifiers */
+   omask = umask(0077);		/* remember umask; keep /tmp files private */
+
+   /*
+    * Invent a file named /tmp/innnnnxx.icn.
+    */
+   srand(time(NULL));
+   c1 = abet[rand() % (sizeof(abet) - 1)];
+   c2 = abet[rand() % (sizeof(abet) - 1)];
+   sprintf(srcfile, "/tmp/i%d%c%c.icn", getpid(), c1, c2);
+
+   /*
+    * Copy the source code to the temporary file.
+    */
+   f = fopen(srcfile, "w");
+   if (f == NULL)
+      quitf("cannot open for writing: %s", srcfile);
+   progname = func(f, source);
+   fclose(f);
+
+   /*
+    * Derive other names and arrange for cleanup on exit.
+    */
+   rfiles = alloc(5 * sizeof(char *));
+   rfiles[0] = srcfile;
+   makename(rfiles[1] = u1, NULL, srcfile, U1Suffix);
+   makename(rfiles[2] = u2, NULL, srcfile, U2Suffix);
+   makename(rfiles[3] = icode, NULL, srcfile, IcodeSuffix);
+   rfiles[4] = NULL;
+   atexit(cleanup);
+
+   /*
+    * Translate to produce .u1 and .u2 files.
+    */
+   flist[0] = srcfile;
+   flist[1] = NULL;
+   if (trans(flist, SourceDir) > 0)
+      exit(EXIT_FAILURE);
+
+   /*
+    * Link to make an icode file.
+    */
+   flist[0] = u1;
+   if (ilink(flist, icode) > 0)
+      exit(EXIT_FAILURE);
+
+   /*
+    * Execute the icode file.
+    */
+   rfiles[3] = NULL;			/* don't delete icode yet */
+   cleanup();				/* but delete the others */
+   sprintf(buf, "ICODE_TEMP=%s:%s", icode, progname);
+   putenv(buf);				/* tell iconx to delete icode */
+   umask(omask);			/* reset original umask */
+   execute(icode, NULL, args);		/* execute the program */
+   quitf("could not execute %s", icode);
+   }
+
+/*
+ * Dump a string to a file, prefixed by  $line 0 "[inline]".
+ */
+static char *savefile(FILE *f, char *srcprog) {
+   static char *progname = "[inline]";
+   fprintf(f, "$line 0 \"%s\"\n", progname);
+   fwrite(srcprog, 1, strlen(srcprog), f);
+   return progname;
+   }
+
+/*
+ * Copy a source file for later translation, adding  $line 0 "filename".
+ */
+static char *copyfile(FILE *f, char *srcfile) {
+   int c;
+   FILE *e;
+
+   if (strcmp(srcfile, "-") == 0) {
+      e = stdin;
+      srcfile = "stdin";
+      }
+   else {
+      if ((e = fopen(srcfile, "r")) == NULL)
+         quitf("cannot open: %s", srcfile);
+      }
+   fprintf(f, "$line 0 \"%s\"\n", srcfile);
+   while ((c = getc(e)) != EOF)
+      putc(c, f);
+   fclose(e);
+   return srcfile;
+   }
+
+/*
+ * Deletes the files listed in rfiles[].
+ */
+static void cleanup(void) {
+   char **p;
+
+   for (p = rfiles; *p; p++)
+      remove(*p);
+   }
diff --git a/src/icont/util.c b/src/icont/util.c
new file mode 100644
index 0000000..3a54901
--- /dev/null
+++ b/src/icont/util.c
@@ -0,0 +1,93 @@
+/*
+ *  util.c -- general utility functions.
+ */
+
+#include "../h/gsupport.h"
+#include "tproto.h"
+#include "tglobals.h"
+#include "tree.h"
+
+extern int optind;
+extern char *ofile;
+
+/*
+ * Information about Icon functions.
+ */
+
+/*
+ * Names of Icon functions.
+ */
+char *ftable[] = {
+#define FncDef(p,n) Lit(p),
+#define FncDefV(p) Lit(p),
+#include "../h/fdefs.h"
+#undef FncDef
+#undef FncDefV
+   };
+
+int ftbsize = sizeof(ftable) / sizeof(char *);
+
+/*
+ * tcalloc - allocate and zero m*n bytes
+ */
+pointer tcalloc(m, n)
+unsigned int m, n;
+   {
+   pointer a;
+
+   if ((a = calloc(m, n)) == 0)
+      quit("out of memory");
+   return a;
+   }
+
+/*
+ * trealloc - realloc a table making it half again larger and zero the
+ *   new part of the table.
+ */
+pointer trealloc(table, tblfree, size, unit_size, min_units, tbl_name)
+pointer table;      /* table to be realloc()ed */
+pointer tblfree;    /* reference to table free pointer if there is one */
+unsigned int *size; /* size of table */
+int unit_size;      /* number of bytes in a unit of the table */
+int min_units;      /* the minimum number of units that must be allocated. */
+char *tbl_name;     /* name of the table */
+   {
+   word new_size;
+   word num_bytes;
+   word free_offset;
+   word i;
+   char *new_tbl;
+
+   new_size = (*size * 3) / 2;
+   if (new_size - *size < min_units)
+      new_size = *size + min_units;
+   num_bytes = new_size * unit_size;
+
+   if (tblfree != NULL)
+      free_offset = DiffPtrs(*(char **)tblfree,  (char *)table);
+
+   if ((new_tbl = realloc(table, (unsigned)num_bytes)) == 0)
+      quitf("out of memory for %s", tbl_name);
+
+   for (i = *size * unit_size; i < num_bytes; ++i)
+      new_tbl[i] = 0;
+
+   *size = new_size;
+   if (tblfree != NULL)
+      *(char **)tblfree = (char *)(new_tbl + free_offset);
+
+   return (pointer)new_tbl;
+   }
+
+
+/*
+ * round2 - round an integer up to the next power of 2.
+ */
+unsigned int round2(n)
+unsigned int n;
+   {
+   unsigned int b = 1;
+   while (b < n)
+      b <<= 1;
+   return b;
+   }
diff --git a/src/preproc/Makefile b/src/preproc/Makefile
new file mode 100644
index 0000000..c3d17ed
--- /dev/null
+++ b/src/preproc/Makefile
@@ -0,0 +1,34 @@
+include ../../Makedefs
+
+POBJS = pout.o pchars.o perr.o pmem.o bldtok.o macro.o preproc.o evaluate.o\
+	files.o gettok.o pinit.o
+
+COBJS= ../common/getopt.o ../common/time.o ../common/strtbl.o ../common/alloc.o
+
+ICOBJS=	getopt.o time.o strtbl.o alloc.o
+
+OBJS= $(POBJS) $(COBJS)
+
+DOT_H = preproc.h pproto.h ptoken.h ../h/define.h ../h/config.h\
+        ../h/typedefs.h ../h/mproto.h
+
+common:
+	cd ../common; $(MAKE) $(ICOBJS)
+	$(MAKE) pp
+
+pp: pmain.o $(OBJS)
+	$(CC) -o pp pmain.o $(OBJS)
+
+pmain.o:	$(DOT_H)
+p_out.o:	$(DOT_H)
+pchars.o:	$(DOT_H)
+p_err.o:	$(DOT_H)
+pmem.o:		$(DOT_H)
+pstring.o:	$(DOT_H)
+bldtok.o:	$(DOT_H)
+macro.o:	$(DOT_H)
+preproc.o:	$(DOT_H)
+evaluate.o:	$(DOT_H)
+files.o:	$(DOT_H)
+gettok.o:	$(DOT_H)
+p_init.o:	$(DOT_H)
diff --git a/src/preproc/README b/src/preproc/README
new file mode 100644
index 0000000..35d6a23
--- /dev/null
+++ b/src/preproc/README
@@ -0,0 +1,7 @@
+This directory contains files for building pp, a ANSI-C preprocessor for
+C (with some extensions).  pp itself is not needed to build the Icon
+compiler system -- the files here are automatically incorporated in
+rtt.
+
+However, if you want to build a stand-alone version of pp for
+some other use, the Makefile here will do it.
diff --git a/src/preproc/bldtok.c b/src/preproc/bldtok.c
new file mode 100644
index 0000000..7eafad9
--- /dev/null
+++ b/src/preproc/bldtok.c
@@ -0,0 +1,766 @@
+/*
+ * This file contains routines for building tokens out of characters from a
+ *  "character source". This source is the top element on the source stack.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static int           pp_tok_id  (char *s);
+static struct token *chck_wh_sp (struct char_src *cs);
+static struct token *pp_number  (void);
+static struct token *char_str   (int delim, int tok_id);
+static struct token *hdr_tok    (int delim, int tok_id, struct char_src *cs);
+
+int whsp_image = NoSpelling;    /* indicate what is in white space tokens */
+struct token *zero_tok;         /* token for literal 0 */
+struct token *one_tok;          /* token for literal 1 */
+
+#include "../preproc/pproto.h"
+
+/*
+ * IsWhSp(c) - true if c is a white space character.
+ */
+#define IsWhSp(c) (c == ' ' || c == '\n' || c == '\t' || c == '\v' || c == '\f')
+
+/*
+ * AdvChar() - advance to next character from buffer, filling the buffer
+ *   if needed.
+ */
+#define AdvChar() \
+   if (++next_char == last_char) \
+      fill_cbuf();
+
+static int line;                   /* current line number */
+static char *fname;                /* current file name */
+static struct str_buf tknize_sbuf; /* string buffer */
+
+/*
+ * List of preprocessing directives and the corresponding token ids.
+ */
+static struct rsrvd_wrd pp_rsrvd[] = {
+   PPDirectives
+   {"if",      PpIf},
+   {"else",    PpElse},
+   {"ifdef",   PpIfdef},
+   {"ifndef",  PpIfndef},
+   {"elif",    PpElif},
+   {"endif",   PpEndif},
+   {"include", PpInclude},
+   {"define",  PpDefine},
+   {"undef",   PpUndef},
+   {"begdef",  PpBegdef},
+   {"enddef",  PpEnddef},
+   {"line",    PpLine},
+   {"error",   PpError},
+   {"pragma",  PpPragma},
+   {NULL, Invalid}};
+
+/*
+ * init_tok - initialize tokenizer.
+ */
+void init_tok()
+   {
+   struct rsrvd_wrd *rw;
+   static int first_time = 1;
+
+   if (first_time) {
+      first_time = 0;
+      init_sbuf(&tknize_sbuf); /* initialize string buffer */
+      /*
+       * install reserved words into the string table
+       */
+      for (rw = pp_rsrvd; rw->s != NULL; ++rw)
+         rw->s = spec_str(rw->s);
+
+      zero_tok = new_token(PpNumber, spec_str("0"), "", 0);
+      one_tok = new_token(PpNumber, spec_str("1"), "", 0);
+      }
+   }
+
+/*
+ * pp_tok_id - see if s in the name of a preprocessing directive.
+ */
+static int pp_tok_id(s)
+char *s;
+   {
+   struct rsrvd_wrd *rw;
+
+   for (rw = pp_rsrvd; rw->s != NULL && rw->s != s; ++rw)
+      ;
+   return rw->tok_id;
+   }
+
+/*
+ * chk_eq_sign - look ahead to next character to see if it is an equal sign.
+ *  It is used for processing -D options.
+ */
+int chk_eq_sign()
+   {
+   if (*next_char == '=') {
+      AdvChar();
+      return 1;
+      }
+   else
+      return 0;
+   }
+
+/*
+ * chck_wh_sp - If the input is at white space, construct a white space token
+ *  and return it, otherwise return NULL. This function also helps keeps track
+ *  of preprocessor directive boundaries.
+ */
+static struct token *chck_wh_sp(cs)
+struct char_src *cs;
+   {
+   register int c1, c2;
+   struct token *t;
+   int tok_id;
+
+   /*
+    * See if we are at white space or a comment.
+    */
+   c1 = *next_char;
+   if (!IsWhSp(c1) && (c1 != '/' || next_char[1] != '*'))
+      return NULL;
+
+   /*
+    * Fine the line number of the current character in the line number
+    *  buffer, and correct it if we have encountered any #line directives.
+    */
+   line = cs->line_buf[next_char - first_char] + cs->line_adj;
+   if (c1 == '\n')
+      --line;      /* a new-line really belongs to the previous line */
+
+   tok_id = WhiteSpace;
+   for (;;) {
+      if (IsWhSp(c1)) {
+         /*
+          * The next character is a white space. If we are retaining the
+          *  image of the white space in the token, copy the character to
+          *  the string buffer. If we are in the midst of a preprocessor
+          *  directive and find a new-line, indicate the end of the
+          *  the directive.
+          */
+         AdvChar();
+         if (whsp_image != NoSpelling)
+            AppChar(tknize_sbuf, c1);
+         if (c1 == '\n') {
+            if (cs->dir_state == Within)
+               tok_id = PpDirEnd;
+            cs->dir_state = CanStart;
+            if (tok_id == PpDirEnd)
+               break;
+            }
+         }
+      else if (c1 == '/' && next_char[1] == '*') {
+         /*
+          * Start of comment. If we are retaining the image of comments,
+          *  copy the characters into the string buffer.
+          */
+         if (whsp_image == FullImage) {
+            AppChar(tknize_sbuf, '/');
+            AppChar(tknize_sbuf, '*');
+            }
+         AdvChar();
+         AdvChar();
+
+         /*
+          * Look for the end of the comment.
+          */
+         c1 = *next_char;
+         c2 = next_char[1];
+         while (c1 != '*' || c2 != '/') {
+            if (c1 == EOF)
+                errfl1(fname, line, "eof encountered in comment");
+            AdvChar();
+            if (whsp_image == FullImage)
+               AppChar(tknize_sbuf, c1);
+            c1 = c2;
+            c2 = next_char[1];
+            }
+
+         /*
+          * Determine if we are retaining the image of a comment, replacing
+          *  a comment by one space character, or ignoring comments.
+          */
+         if (whsp_image == FullImage) {
+            AppChar(tknize_sbuf, '*');
+            AppChar(tknize_sbuf, '/');
+            }
+         else if (whsp_image == NoComment)
+            AppChar(tknize_sbuf, ' ');
+         AdvChar();
+         AdvChar();
+         }
+      else
+         break;         /* end of white space */
+      c1 = *next_char;
+      }
+
+   /*
+    * If we are not retaining the image of white space, replace it all
+    *  with one space character.
+    */
+   if (whsp_image == NoSpelling)
+      AppChar(tknize_sbuf, ' ');
+
+   t = new_token(tok_id, str_install(&tknize_sbuf), fname, line);
+
+   /*
+    * Look ahead to see if a ## operator is next.
+    */
+   if (*next_char == '#' && next_char[1] == '#')
+      if (tok_id == PpDirEnd)
+         errt1(t, "## expressions must not cross directive boundaries");
+      else {
+         /*
+          * Discard white space before a ## operator.
+          */
+         free_t(t);
+         return NULL;
+         }
+   return t;
+   }
+
+/*
+ * pp_number - Create a token for a preprocessing number (See ANSI C Standard
+ *  for the syntax of such a number).
+ */
+static struct token *pp_number()
+   {
+   register int c;
+
+   c = *next_char;
+   for (;;) {
+      if (c == 'e' || c == 'E') {
+         AppChar(tknize_sbuf, c);
+         AdvChar();
+         c = *next_char;
+         if (c == '+' || c == '-') {
+            AppChar(tknize_sbuf, c);
+            AdvChar();
+            c = *next_char;
+            }
+         }
+      else if (isdigit(c) || c == '.' || islower(c) || isupper(c) || c == '_') {
+         AppChar(tknize_sbuf, c);
+         AdvChar();
+         c = *next_char;
+         }
+      else {
+         return new_token(PpNumber, str_install(&tknize_sbuf), fname, line);
+         }
+      }
+   }
+
+/*
+ * char_str - construct a token for a character constant or string literal.
+ */
+static struct token *char_str(delim, tok_id)
+int delim;
+int tok_id;
+   {
+   register int c;
+
+   for (c = *next_char; c != EOF && c != '\n' &&  c != delim; c = *next_char) {
+      AppChar(tknize_sbuf, c);
+      if (c == '\\') {
+         c = next_char[1];
+         if (c == EOF || c == '\n')
+            break;
+         else {
+            AppChar(tknize_sbuf, c);
+            AdvChar();
+            }
+         }
+      AdvChar();
+      }
+   if (c == EOF)
+      errfl1(fname, line, "End-of-file encountered within a literal");
+   if (c == '\n')
+      errfl1(fname, line, "New-line encountered within a literal");
+   AdvChar();
+   return new_token(tok_id, str_install(&tknize_sbuf), fname, line);
+   }
+
+/*
+ * hdr_tok - create a token for an #include header. The delimiter may be
+ *  > or ".
+ */
+static struct token *hdr_tok(delim, tok_id, cs)
+int delim;
+int tok_id;
+struct char_src *cs;
+   {
+   register int c;
+
+   line = cs->line_buf[next_char - first_char] + cs->line_adj;
+   AdvChar();
+
+   for (c = *next_char; c != delim; c = *next_char) {
+      if (c == EOF)
+         errfl1(fname, line,
+            "End-of-file encountered within a header name");
+      if (c == '\n')
+         errfl1(fname, line,
+            "New-line encountered within a header name");
+      AppChar(tknize_sbuf, c);
+      AdvChar();
+      }
+   AdvChar();
+   return new_token(tok_id, str_install(&tknize_sbuf), fname, line);
+   }
+
+/*
+ * tokenize - return the next token from the character source on the top
+ *  of the source stack.
+ */
+struct token *tokenize()
+   {
+   struct char_src *cs;
+   struct token *t1, *t2;
+   register int c;
+   int tok_id;
+
+
+   cs = src_stack->u.cs;
+
+   /*
+    * Check to see if the last call left a token from a look ahead.
+    */
+   if (cs->tok_sav != NULL) {
+      t1 = cs->tok_sav;
+      cs->tok_sav = NULL;
+      return t1;
+      }
+
+   if (*next_char == EOF)
+      return NULL;
+
+   /*
+    * Find the current line number and file name for the character
+    *  source and check for white space.
+    */
+   line = cs->line_buf[next_char - first_char] + cs->line_adj;
+   fname = cs->fname;
+   if ((t1 = chck_wh_sp(cs)) != NULL)
+       return t1;
+
+   c = *next_char;  /* look at next character */
+   AdvChar();
+
+   /*
+    * If the last thing we saw in this character source was white space
+    *  containing a new-line, then we must look for the start of a
+    *  preprocessing directive.
+    */
+   if (cs->dir_state == CanStart) {
+      cs->dir_state = Reset;
+      if  (c == '#' && *next_char != '#') {
+         /*
+          * Assume we are within a preprocessing directive and check
+          *  for white space to discard.
+          */
+         cs->dir_state = Within;
+         if ((t1 = chck_wh_sp(cs)) != NULL)
+            if (t1->tok_id == PpDirEnd) {
+               /*
+                * We found a new-line, this is a null preprocessor directive.
+                */
+               cs->tok_sav = t1;
+               AppChar(tknize_sbuf, '#');
+               return new_token(PpNull, str_install(&tknize_sbuf), fname, line);
+               }
+            else
+               free_t(t1);  /* discard white space */
+         c = *next_char;
+         if (islower(c) || isupper(c) || c == '_') {
+            /*
+             * Tokenize the identifier following the #
+             */
+            t1 = tokenize();
+            if ((tok_id = pp_tok_id(t1->image)) == Invalid) {
+               /*
+                * We have a stringizing operation, not a preprocessing
+                *  directive.
+                */
+               cs->dir_state = Reset;
+               cs->tok_sav = t1;
+               AppChar(tknize_sbuf, '#');
+               return new_token('#', str_install(&tknize_sbuf), fname, line);
+               }
+            else {
+               t1->tok_id = tok_id;
+               if (tok_id == PpInclude) {
+                  /*
+                   * A header name has to be tokenized specially. Find
+                   *  it, then save the token.
+                   */
+                  if ((t2 = chck_wh_sp(cs)) != NULL)
+                     if (t2->tok_id == PpDirEnd)
+                        errt1(t2, "file name missing from #include");
+                     else
+                        free_t(t2);
+                  c = *next_char;
+                  if (c == '"')
+                     cs->tok_sav = hdr_tok('"', StrLit, cs);
+                  else if (c == '<')
+                     cs->tok_sav = hdr_tok('>', PpHeader, cs);
+                  }
+               /*
+                * Return the token indicating the kind of preprocessor
+                *  directive we have started.
+                */
+               return t1;
+               }
+            }
+         else
+            errfl1(fname, line,
+               "# must be followed by an identifier or keyword");
+         }
+      }
+
+   /*
+    * Check for literals containing wide characters.
+    */
+   if (c == 'L') {
+      if (*next_char == '\'') {
+         AdvChar();
+         t1 = char_str('\'', LCharConst);
+         if (t1->image[0] == '\0')
+            errt1(t1, "invalid character constant");
+         return t1;
+         }
+      else if (*next_char == '"') {
+         AdvChar();
+         return char_str('"', LStrLit);
+         }
+      }
+
+   /*
+    * Check for identifier.
+    */
+   if (islower(c) || isupper(c) || c == '_') {
+      AppChar(tknize_sbuf, c);
+      c = *next_char;
+      while (islower(c) || isupper(c) || isdigit(c) || c == '_') {
+         AppChar(tknize_sbuf, c);
+         AdvChar();
+         c = *next_char;
+         }
+      return new_token(Identifier, str_install(&tknize_sbuf), fname, line);
+     }
+
+   /*
+    * Check for number.
+    */
+   if (isdigit(c)) {
+      AppChar(tknize_sbuf, c);
+      return pp_number();
+      }
+
+   /*
+    * Check for character constant.
+    */
+   if (c == '\'') {
+      t1 = char_str(c, CharConst);
+      if (t1->image[0] == '\0')
+         errt1(t1, "invalid character constant");
+      return t1;
+      }
+
+   /*
+    * Check for string constant.
+    */
+   if (c == '"')
+      return char_str(c, StrLit);
+
+   /*
+    * Check for operators and punctuation. Anything that does not fit these
+    *  categories is a single character token.
+    */
+   AppChar(tknize_sbuf, c);
+   switch (c) {
+      case '.':
+         c = *next_char;
+         if (isdigit(c)) {
+            /*
+             * Number
+             */
+            AppChar(tknize_sbuf, c);
+            AdvChar();
+            return pp_number();
+            }
+         else if (c == '.' && next_char[1] == '.') {
+            /*
+             *  ...
+             */
+            AdvChar();
+            AdvChar();
+            AppChar(tknize_sbuf, '.');
+            AppChar(tknize_sbuf, '.');
+            return new_token(Ellipsis, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('.', str_install(&tknize_sbuf), fname, line);
+
+      case '+':
+         c = *next_char;
+         if (c == '+') {
+            /*
+             *  ++
+             */
+            AppChar(tknize_sbuf, '+');
+            AdvChar();
+            return new_token(Incr, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  +=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(PlusAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('+', str_install(&tknize_sbuf), fname, line);
+
+      case '-':
+         c = *next_char;
+         if (c == '>') {
+            /*
+             *  ->
+             */
+            AppChar(tknize_sbuf, '>');
+            AdvChar();
+            return new_token(Arrow, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '-') {
+            /*
+             *  --
+             */
+            AppChar(tknize_sbuf, '-');
+            AdvChar();
+            return new_token(Decr, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  -=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(MinusAsgn, str_install(&tknize_sbuf), fname,
+               line);
+            }
+         else
+            return new_token('-', str_install(&tknize_sbuf), fname, line);
+
+      case '<':
+         c = *next_char;
+         if (c == '<') {
+            AppChar(tknize_sbuf, '<');
+            AdvChar();
+            if (*next_char == '=') {
+               /*
+                *  <<=
+                */
+               AppChar(tknize_sbuf, '=');
+               AdvChar();
+               return new_token(LShftAsgn, str_install(&tknize_sbuf), fname,
+                  line);
+               }
+            else
+               /*
+                *  <<
+                */
+               return new_token(LShft, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  <=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(Leq, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('<', str_install(&tknize_sbuf), fname, line);
+
+      case '>':
+         c = *next_char;
+         if (c == '>') {
+            AppChar(tknize_sbuf, '>');
+            AdvChar();
+            if (*next_char == '=') {
+               /*
+                *  >>=
+                */
+               AppChar(tknize_sbuf, '=');
+               AdvChar();
+               return new_token(RShftAsgn, str_install(&tknize_sbuf), fname,
+                  line);
+               }
+            else
+               /*
+                *  >>
+                */
+               return new_token(RShft, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  >=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(Geq, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('>', str_install(&tknize_sbuf), fname, line);
+
+      case '=':
+         if (*next_char == '=') {
+            /*
+             *  ==
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(TokEqual, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('=', str_install(&tknize_sbuf), fname, line);
+
+      case '!':
+         if (*next_char == '=') {
+            /*
+             *  !=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(Neq, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('!', str_install(&tknize_sbuf), fname, line);
+
+      case '&':
+         c = *next_char;
+         if (c == '&') {
+            /*
+             *  &&
+             */
+            AppChar(tknize_sbuf, '&');
+            AdvChar();
+            return new_token(And, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  &=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(AndAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('&', str_install(&tknize_sbuf), fname, line);
+
+      case '|':
+         c = *next_char;
+         if (c == '|') {
+            /*
+             *  ||
+             */
+            AppChar(tknize_sbuf, '|');
+            AdvChar();
+            return new_token(Or, str_install(&tknize_sbuf), fname, line);
+            }
+         else if (c == '=') {
+            /*
+             *  |=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(OrAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('|', str_install(&tknize_sbuf), fname, line);
+
+      case '*':
+         if (*next_char == '=') {
+            /*
+             *  *=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(MultAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('*', str_install(&tknize_sbuf), fname, line);
+
+      case '/':
+         if (*next_char == '=') {
+            /*
+             *  /=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(DivAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('/', str_install(&tknize_sbuf), fname, line);
+
+      case '%':
+         if (*next_char == '=') {
+            /*
+             *  &=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(ModAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('%', str_install(&tknize_sbuf), fname, line);
+
+      case '^':
+         if (*next_char == '=') {
+            /*
+             *  ^=
+             */
+            AppChar(tknize_sbuf, '=');
+            AdvChar();
+            return new_token(XorAsgn, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            return new_token('^', str_install(&tknize_sbuf), fname, line);
+
+      case '#':
+         /*
+          * Token pasting or stringizing operator.
+          */
+         if (*next_char == '#') {
+            /*
+             *  ##
+             */
+            AppChar(tknize_sbuf, '#');
+            AdvChar();
+            t1 =  new_token(PpPaste, str_install(&tknize_sbuf), fname, line);
+            }
+         else
+            t1 = new_token('#', str_install(&tknize_sbuf), fname, line);
+
+         /*
+          * The operand must be in the same preprocessing directive.
+          */
+         if ((t2 = chck_wh_sp(cs)) != NULL)
+            if (t2->tok_id == PpDirEnd)
+              errt2(t2, t1->image,
+               " preprocessing expression must not cross directive boundary");
+            else
+               free_t(t2);
+         return t1;
+
+      default:
+         return new_token(c, str_install(&tknize_sbuf), fname, line);
+      }
+   }
diff --git a/src/preproc/evaluate.c b/src/preproc/evaluate.c
new file mode 100644
index 0000000..9c329f6
--- /dev/null
+++ b/src/preproc/evaluate.c
@@ -0,0 +1,561 @@
+/*
+ * This file contains functions to evaluate constant expressions for
+ *  conditional inclusion. These functions are organized as a recursive
+ *  decent parser based on the C grammar presented in the ANSI C Standard
+ *  document. The function eval() is called from the outside.
+ */
+
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static long primary        (struct token **tp, struct token *trigger);
+static long unary          (struct token **tp, struct token *trigger);
+static long multiplicative (struct token **tp, struct token *trigger);
+static long additive       (struct token **tp, struct token *trigger);
+static long shift          (struct token **tp, struct token *trigger);
+static long relation       (struct token **tp, struct token *trigger);
+static long equality       (struct token **tp, struct token *trigger);
+static long and            (struct token **tp, struct token *trigger);
+static long excl_or        (struct token **tp, struct token *trigger);
+static long incl_or        (struct token **tp, struct token *trigger);
+static long log_and        (struct token **tp, struct token *trigger);
+static long log_or         (struct token **tp, struct token *trigger);
+
+#include "../preproc/pproto.h"
+
+/*
+ * <primary> ::= <identifier>
+ *               defined <identifier>
+ *               defined '(' <identifier> ')'
+ *               <number>
+ *               <character-constant>
+ *               '(' <conditional> ')'
+ */
+static long primary(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   struct token *t = NULL;
+   struct token *id = NULL;
+   long e1;
+   int i;
+   int is_hex_char;
+   char *s;
+
+   switch ((*tp)->tok_id) {
+      case Identifier:
+         /*
+          * Check for "defined", it is the only reserved word in this expression
+          *  evaluation (See ANSI C Standard).
+          */
+         if (strcmp((*tp)->image, "defined") == 0) {
+            nxt_non_wh(&t);
+            if (t->tok_id == '(') {
+               nxt_non_wh(&id);
+               nxt_non_wh(&t);
+               if (t == NULL || t->tok_id != ')')
+                  errt1(id, "')' missing in 'defined' expression");
+               free_t(t);
+               }
+            else
+               id = t;
+            if (id->tok_id != Identifier)
+               errt1(id, "'defined' must be followed by an identifier");
+            advance_tok(tp);
+            if (m_lookup(id) == NULL)
+               e1 = 0L;
+            else
+               e1 = 1L;
+            free_t(id);
+            }
+         else {
+            advance_tok(tp);
+            e1 = 0L;   /* undefined: all macros have been expanded */
+            }
+         return e1;
+
+      case PpNumber:
+         s = (*tp)->image;
+         e1 = 0L;
+         if (*s == '0') {
+            ++s;
+            if ((*s == 'x') || (*s == 'X')) {
+               /*
+                * Hex constant
+                */
+               ++s;
+               if (*s == '\0' || *s == 'u' || *s == 'U' || *s == 'l' ||
+                    *s == 'L')
+                  errt2(*tp, "invalid hex constant in condition of #",
+                     trigger->image);
+               while (*s != '\0' && *s != 'u' && *s != 'U' && *s != 'l' &&
+                    *s != 'L') {
+                  e1 <<= 4;
+                  if (*s >= '0' && *s <= '9')
+                     e1 |= *s - '0';
+                  else
+                     switch (*s) {
+                        case 'a': case 'A': e1 |= 10; break;
+                        case 'b': case 'B': e1 |= 11; break;
+                        case 'c': case 'C': e1 |= 12; break;
+                        case 'd': case 'D': e1 |= 13; break;
+                        case 'e': case 'E': e1 |= 14; break;
+                        case 'f': case 'F': e1 |= 15; break;
+                        default:
+                           errt2(*tp, "invalid hex constant in condition of #",
+                              trigger->image);
+                        }
+                  ++s;
+                  }
+               }
+            else {
+               /*
+                * Octal constant
+                */
+               while (*s != '\0' && *s != 'u' && *s != 'U' && *s != 'l' &&
+                    *s != 'L') {
+                  if (*s >= '0' && *s <= '7')
+                     e1 = (e1 << 3) | (*s - '0');
+                  else
+                     errt2(*tp, "invalid octal constant in condition of #",
+                        trigger->image);
+                  ++s;
+                  }
+               }
+            }
+         else {
+            /*
+             * Decimal constant
+             */
+            while (*s != '\0' && *s != 'u' && *s != 'U' && *s != 'l' &&
+                 *s != 'L') {
+               if (*s >= '0' && *s <= '9')
+                  e1 = e1 * 10 + (*s - '0');
+               else
+                  errt2(*tp, "invalid decimal constant in condition of #",
+                     trigger->image);
+               ++s;
+               }
+            }
+            advance_tok(tp);
+            /*
+             * Check integer suffix for validity
+             */
+            if (*s == '\0')
+               return e1;
+            else if (*s == 'u' || *s == 'U') {
+               ++s;
+               if (*s == '\0')
+                  return e1;
+               else if ((*s == 'l' || *s == 'L') && *++s == '\0')
+                  return e1;
+               }
+            else if (*s == 'l' || *s == 'L') {
+               ++s;
+               if (*s == '\0')
+                  return e1;
+               else if ((*s == 'u' || *s == 'U') && *++s == '\0')
+                  return e1;
+               }
+            errt2(*tp, "invalid integer constant in condition of #",
+               trigger->image);
+
+      case CharConst:
+      case LCharConst:
+         /*
+          * Wide characters are treated the same as characters. Only the
+          *  first byte of a multi-byte character is used.
+          */
+         s = (*tp)->image;
+         if (*s != '\\')
+            e1 = (long)*s;
+         else {
+            /*
+             * Escape sequence.
+             */
+            e1 = 0L;
+            ++s;
+            if (*s >= '0' && *s <= '7') {
+                for (i = 1; i <= 3 && *s >= '0' && *s <= '7'; ++i, ++s)
+                   e1 = (e1 << 3) | (*s - '0');
+                if (e1 != (long)(unsigned char)e1)
+                   errt1(*tp, "octal escape sequece larger than a character");
+                e1 = (long)(char)e1;
+                }
+            else switch (*s) {
+               case '\'': e1 = (long) '\''; break;
+               case '"':  e1 = (long) '"';  break;
+               case '?':  e1 = (long) '?';  break;
+               case '\\': e1 = (long) '\\'; break;
+               case 'a':  e1 = (long) Bell; break;
+               case 'b':  e1 = (long) '\b'; break;
+               case 'f':  e1 = (long) '\f'; break;
+               case 'n':  e1 = (long) '\n'; break;
+               case 'r':  e1 = (long) '\r'; break;
+               case 't':  e1 = (long) '\t'; break;
+               case 'v':  e1 = (long) '\v'; break;
+
+               case 'x':
+                  ++s;
+                  is_hex_char = 1;
+                  while (is_hex_char) {
+                     if (*s >= '0' && *s <= '9')
+                        e1 = (e1 << 4) | (*s - '0');
+                     else switch (*s) {
+                        case 'a': case 'A': e1 = (e1 << 4) | 10; break;
+                        case 'b': case 'B': e1 = (e1 << 4) | 11; break;
+                        case 'c': case 'C': e1 = (e1 << 4) | 12; break;
+                        case 'd': case 'D': e1 = (e1 << 4) | 13; break;
+                        case 'e': case 'E': e1 = (e1 << 4) | 14; break;
+                        case 'f': case 'F': e1 = (e1 << 4) | 15; break;
+                        default: is_hex_char = 0;
+                        }
+                     if (is_hex_char)
+                        ++s;
+                     if (e1 != (long)(unsigned char)e1)
+                        errt1(*tp,"hex escape sequece larger than a character");
+                     }
+                  e1 = (long)(char)e1;
+                  break;
+
+               default:
+                  e1 = (long) *s;
+               }
+            }
+         advance_tok(tp);
+         return e1;
+
+      case '(':
+         advance_tok(tp);
+         e1 = conditional(tp, trigger);
+         if ((*tp)->tok_id != ')')
+            errt2(*tp, "expected ')' in conditional of #", trigger->image);
+         advance_tok(tp);
+         return e1;
+
+      default:
+         errt2(*tp, "syntax error in condition of #", trigger->image);
+      }
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ * <unary> ::= <primary> |
+ *             '+' <unary> |
+ *             '-' <unary> |
+ *             '~' <unary> |
+ *             '!' <unary>
+ */
+static long unary(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   switch ((*tp)->tok_id) {
+      case '+':
+         advance_tok(tp);
+         return unary(tp, trigger);
+      case '-':
+         advance_tok(tp);
+         return -unary(tp, trigger);
+      case '~':
+         advance_tok(tp);
+         return ~unary(tp, trigger);
+      case '!':
+         advance_tok(tp);
+         return !unary(tp, trigger);
+      default:
+         return primary(tp, trigger);
+      }
+   }
+
+/*
+ * <multiplicative> ::= <unary> |
+ *                      <multiplicative> '*' <unary> |
+ *                      <multiplicative> '/' <unary> |
+ *                      <multiplicative> '%' <unary>
+ */
+static long multiplicative(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+   int tok_id;
+
+   e1 = unary(tp, trigger);
+   tok_id = (*tp)->tok_id;
+   while (tok_id == '*' || tok_id == '/' || tok_id == '%') {
+      advance_tok(tp);
+      e2 = unary(tp, trigger);
+      switch (tok_id) {
+         case '*':
+            e1 = (e1 * e2);
+            break;
+         case '/':
+            e1 = (e1 / e2);
+            break;
+         case '%':
+            e1 = (e1 % e2);
+            break;
+         }
+      tok_id = (*tp)->tok_id;
+      }
+   return e1;
+   }
+
+/*
+ * <additive> ::= <multiplicative> |
+ *                <additive> '+' <multiplicative> |
+ *                <additive> '-' <multiplicative>
+ */
+static long additive(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+   int tok_id;
+
+   e1 = multiplicative(tp, trigger);
+   tok_id = (*tp)->tok_id;
+   while (tok_id == '+' || tok_id == '-') {
+      advance_tok(tp);
+      e2 = multiplicative(tp, trigger);
+      if (tok_id == '+')
+         e1 = (e1 + e2);
+      else
+         e1 = (e1 - e2);
+      tok_id = (*tp)->tok_id;
+      }
+   return e1;
+   }
+
+/*
+ * <shift> ::= <additive> |
+ *             <shift> '<<' <additive> |
+ *             <shift> '>>' <additive>
+ */
+static long shift(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+   int tok_id;
+
+   e1 = additive(tp, trigger);
+   tok_id = (*tp)->tok_id;
+   while (tok_id == LShft || tok_id == RShft) {
+      advance_tok(tp);
+      e2 = additive(tp, trigger);
+      if (tok_id == LShft)
+         e1 = (e1 << e2);
+      else
+         e1 = (e1 >> e2);
+      tok_id = (*tp)->tok_id;
+      }
+   return e1;
+   }
+
+/*
+ * <relation> ::= <shift> |
+ *                <relation> '<' <shift> |
+ *                <relation> '<=' <shift> |
+ *                <relation> '>' <shift> |
+ *                <relation> '>=' <shift>
+ */
+static long relation(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+   int tok_id;
+
+   e1 = shift(tp, trigger);
+   tok_id = (*tp)->tok_id;
+   while (tok_id == '<' || tok_id == Leq || tok_id == '>' || tok_id == Geq) {
+      advance_tok(tp);
+      e2 = shift(tp, trigger);
+      switch (tok_id) {
+         case '<':
+            e1 = (e1 < e2);
+            break;
+         case Leq:
+            e1 = (e1 <= e2);
+            break;
+         case '>':
+            e1 = (e1 > e2);
+            break;
+         case Geq:
+            e1 = (e1 >= e2);
+            break;
+         }
+      tok_id = (*tp)->tok_id;
+      }
+   return e1;
+   }
+
+/*
+ * <equality> ::= <relation> |
+ *                <equality> '==' <relation> |
+ *                <equality> '!=' <relation>
+ */
+static long equality(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+   int tok_id;
+
+   e1 = relation(tp, trigger);
+   tok_id = (*tp)->tok_id;
+   while (tok_id == TokEqual || tok_id == Neq) {
+      advance_tok(tp);
+      e2 = relation(tp, trigger);
+      if (tok_id == TokEqual)
+         e1 = (e1 == e2);
+      else
+         e1 = (e1 != e2);
+      tok_id = (*tp)->tok_id;
+      }
+   return e1;
+   }
+
+/*
+ * <and> ::= <equality> |
+ *           <and> '&' <equality>
+ */
+static long and(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+
+   e1 = equality(tp, trigger);
+   while ((*tp)->tok_id == '&') {
+      advance_tok(tp);
+      e2 = equality(tp, trigger);
+      e1 = (e1 & e2);
+      }
+   return e1;
+   }
+
+/*
+ * <excl_or> ::= <and> |
+ *               <excl_or> '^' <and>
+ */
+static long excl_or(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+
+   e1 = and(tp, trigger);
+   while ((*tp)->tok_id == '^') {
+      advance_tok(tp);
+      e2 = and(tp, trigger);
+      e1 = (e1 ^ e2);
+      }
+   return e1;
+   }
+
+/*
+ * <incl_or> ::= <excl_or> |
+ *               <incl_or> '|' <excl_or>
+ */
+static long incl_or(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+
+   e1 = excl_or(tp, trigger);
+   while ((*tp)->tok_id == '|') {
+      advance_tok(tp);
+      e2 = excl_or(tp, trigger);
+      e1 = (e1 | e2);
+      }
+   return e1;
+   }
+
+/*
+ * <log_and> ::= <incl_or> |
+ *               <log_and> '&&' <incl_or>
+ */
+static long log_and(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+
+   e1 = incl_or(tp, trigger);
+   while ((*tp)->tok_id == And) {
+      advance_tok(tp);
+      e2 = incl_or(tp, trigger);
+      e1 = (e1 && e2);
+      }
+   return e1;
+   }
+
+/*
+ * <log_or> ::= <log_and> |
+ *              <log_or> '||' <log_and>
+ */
+static long log_or(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2;
+
+   e1 = log_and(tp, trigger);
+   while ((*tp)->tok_id == Or) {
+      advance_tok(tp);
+      e2 = log_and(tp, trigger);
+      e1 = (e1 || e2);
+      }
+   return e1;
+   }
+
+/*
+ * <conditional> ::= <log_or> |
+ *                   <log_or> '?' <conditional> ':' <conditional>
+ */
+long conditional(tp, trigger)
+struct token **tp;
+struct token *trigger;
+   {
+   long e1, e2, e3;
+
+   e1 = log_or(tp, trigger);
+   if ((*tp)->tok_id == '?') {
+      advance_tok(tp);
+      e2 = conditional(tp, trigger);
+      if ((*tp)->tok_id != ':')
+         errt2(*tp, "expected ':' in conditional of #", trigger->image);
+      advance_tok(tp);
+      e3 = conditional(tp, trigger);
+      return e1 ? e2 : e3;
+      }
+   else
+      return e1;
+   }
+
+/*
+ * eval - get the tokens for a conditional and evaluate it to 0 or 1.
+ *  trigger is the preprocessing directive that triggered the evaluation;
+ *  it is used for error messages.
+ */
+int eval(trigger)
+struct token *trigger;
+   {
+   struct token *t = NULL;
+   int result;
+
+   advance_tok(&t);
+   result = (conditional(&t, trigger) != 0L);
+   if (t->tok_id != PpDirEnd)
+      errt2(t, "expected end of condition of #", trigger->image);
+   free_t(t);
+   return result;
+   }
diff --git a/src/preproc/files.c b/src/preproc/files.c
new file mode 100644
index 0000000..07abf60
--- /dev/null
+++ b/src/preproc/files.c
@@ -0,0 +1,257 @@
+/*
+ * This file contains routines for setting up characters sources from
+ *  files. It contains code to handle the search for include files.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/pproto.h"
+
+#if CYGWIN
+   #include <limits.h>
+   #include <string.h>
+   #include <sys/cygwin.h>
+#endif					/* CYGWIN */
+
+#define IsRelPath(fname) (fname[0] != '/')
+
+static void file_src (char *fname, FILE *f);
+
+static char **incl_search; /* standard locations to search for header files */
+
+/*
+ * file_src - set up the structures for a characters source from a file,
+ *  putting the source on the top of the stack.
+ */
+static void file_src(fname, f)
+char *fname;
+FILE *f;
+   {
+   union src_ref ref;
+
+   #if CYGWIN
+      char posix_path[ _POSIX_PATH_MAX + 1 ];
+      cygwin_conv_to_posix_path( fname, posix_path );
+      fname = strdup( posix_path );
+   #endif				/* CYGWIN */
+
+   ref.cs = new_cs(fname, f, CBufSize);
+   push_src(CharSrc, &ref);
+   next_char = NULL;
+   fill_cbuf();
+   }
+
+/*
+ * source - Open the file named fname or use stdin if fname is "-". fname
+ *  is the first file from which to read input (that is, the outermost file).
+ */
+void source(fname)
+char *fname;
+   {
+   FILE *f;
+
+   if (strcmp(fname, "-") == 0)
+      file_src("<stdin>", stdin);
+   else {
+      if ((f = fopen(fname, "r")) == NULL)
+         err2("cannot open ", fname);
+      file_src(fname, f);
+      }
+   }
+
+/*
+ * include - open the file named fname and make it the current input file.
+ */
+void include(trigger, fname, system)
+struct token *trigger;
+char *fname;
+int system;
+   {
+   struct str_buf *sbuf;
+   char *s;
+   char *path;
+   char *end_prfx;
+   struct src *sp;
+   struct char_src *cs;
+   char **prefix;
+   FILE *f;
+
+   /*
+    * See if this is an absolute path name.
+    */
+   if (IsRelPath(fname)) {
+      sbuf = get_sbuf();
+      f = NULL;
+      if (!system) {
+         /*
+          * This is not a system include file, so search the locations
+          *  of the "ancestor files".
+          */
+         sp = src_stack;
+         while (f == NULL && sp != NULL) {
+            if (sp->flag == CharSrc) {
+               cs = sp->u.cs;
+               if (cs->f != NULL) {
+                  /*
+                   * This character source is a file.
+                   */
+                  end_prfx = NULL;
+                  for (s = cs->fname; *s != '\0'; ++s)
+                     if (*s == '/')
+                        end_prfx = s;
+                  if (end_prfx != NULL)
+                     for (s = cs->fname; s <= end_prfx; ++s)
+                        AppChar(*sbuf, *s);
+                  for (s = fname; *s != '\0'; ++s)
+                     AppChar(*sbuf, *s);
+                  path = str_install(sbuf);
+                  f = fopen(path, "r");
+                  }
+               }
+            sp = sp->next;
+            }
+         }
+      /*
+       * Search in the locations for the system include files.
+       */
+      prefix = incl_search;
+      while (f == NULL && *prefix != NULL) {
+         for (s = *prefix; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+         if (s > *prefix && s[-1] != '/')
+            AppChar(*sbuf, '/');
+         for (s = fname; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+         path = str_install(sbuf);
+         f = fopen(path, "r");
+         ++prefix;
+         }
+      rel_sbuf(sbuf);
+      }
+   else {                               /* The path is absolute. */
+      path = fname;
+      f = fopen(path, "r");
+      }
+
+   if (f == NULL)
+      errt2(trigger, "cannot open include file ", fname);
+   file_src(path, f);
+   }
+
+/*
+ * init_files - Initialize this module, setting up the search path for
+ *  system header files.
+ */
+void init_files(opt_lst, opt_args)
+char *opt_lst;
+char **opt_args;
+   {
+   int n_paths = 0;
+   int i, j;
+   char *s, *s1;
+
+   /*
+    *  Determine the number of standard locations to search for
+    *  header files and provide any declarations needed for the code
+    *  that establishes these search locations.
+    */
+
+   #if CYGWIN
+      char *incl_var;
+      static char *sysdir = "/usr/include";
+      static char *windir = "/usr/include/w32api";
+      n_paths = 2;
+   
+      incl_var = getenv("C_INCLUDE_PATH");
+      if (incl_var != NULL) {
+         /*
+          * Add one entry for evry non-empty, colon-separated string in incl_var.
+          */
+         char *dir_start, *dir_end;
+   
+         dir_start = incl_var;
+         while( ( dir_end = strchr( dir_start, ':' ) ) != NULL ) {
+            if (dir_end > dir_start) ++n_paths;
+            dir_start = dir_end + 1;
+            }
+         if ( *dir_start != '\0' )
+            ++n_paths;     /* One path after the final ':' */
+         }
+   #else				/* CYGWIN */
+      static char *sysdir = "/usr/include/";
+      n_paths = 1;
+   #endif				/* CYGWIN */
+
+   /*
+    * Count the number of -I options to the preprocessor.
+    */
+   for (i = 0; opt_lst[i] != '\0'; ++i)
+      if (opt_lst[i] == 'I')
+         ++n_paths;
+
+   /*
+    * Set up the array of standard locations to search for header files.
+    */
+   incl_search = alloc((n_paths + 1) * sizeof(char *));
+   j = 0;
+
+   /*
+    * Get the locations from the -I options to the preprocessor.
+    */
+   for (i = 0; opt_lst[i] != '\0'; ++i)
+      if (opt_lst[i] == 'I') {
+         s = opt_args[i];
+         s1 = alloc(strlen(s) + 1);
+         strcpy(s1, s);
+
+         #if CYGWIN
+            /*
+             * Run s1 through cygwin_conv_to_posix_path; if the posix path
+             * differs from s1, reset s1 to a copy of the posix path.
+             */
+            {
+               char posix_path[ _POSIX_PATH_MAX ];
+               cygwin_conv_to_posix_path( s1, posix_path );
+               if (strcmp( s1, posix_path ) != 0) {
+                  free( s1 );
+                  s1 = salloc( posix_path );
+                  }
+               }
+         #endif				/* CYGWIN */
+
+         incl_search[j++] = s1;
+         }
+
+   /*
+    *  Establish the standard locations to search after the -I options
+    *  on the preprocessor.
+    */
+   #if CYGWIN
+      if (incl_var != NULL) {
+         /*
+          * The C_INCLUDE_PATH components are carved out of a copy of incl_var.
+          * The colons after non-empty directory names are replaced by null
+          * chars, and the pointers to the start of these names are stored
+	  *  in inc_search.
+          */
+         char *dir_start, *dir_end;
+   
+         dir_start = salloc( incl_var );
+         while( ( dir_end = strchr( dir_start, ':' ) ) != NULL ) {
+            if (dir_end > dir_start) {
+               incl_search[j++] = dir_start;
+               *dir_end = '\0';
+               }
+            dir_start = dir_end + 1;
+            }
+         if ( *dir_start != '\0' )
+            incl_search[j++] = dir_start;
+         }
+   
+      /* Finally, add the system dir(s) */
+      incl_search[j++] = sysdir;
+      incl_search[j++] = windir;
+   #else
+      incl_search[n_paths - 1] = sysdir;
+   #endif				/* CYGWIN */
+
+   incl_search[n_paths] = NULL;
+   }
diff --git a/src/preproc/gettok.c b/src/preproc/gettok.c
new file mode 100644
index 0000000..87fe5f0
--- /dev/null
+++ b/src/preproc/gettok.c
@@ -0,0 +1,252 @@
+/*
+ * This files contains routines for getting the "next" token.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+#include "../preproc/pproto.h"
+
+/*
+ * next_tok - get the next raw token. No macros are expanded here (although
+ *  the tokens themselves may be the result of a macro expansion initiated
+ *  at a "higher" level). Only #line directives are processed here.
+ */
+struct token *next_tok()
+   {
+   struct token *t, *t1;
+   struct tok_lst *tlst;
+   struct char_src *cs;
+   struct str_buf *sbuf;
+   char *s;
+   char *fname;
+   int n;
+
+   if (src_stack->flag == DummySrc)
+      return NULL;    /* source stack is empty - end of input */
+
+   /*
+    * See if a directive pushed back any tokens.
+    */
+   if (src_stack->ntoks > 0)
+      return src_stack->toks[--src_stack->ntoks];
+
+   switch (src_stack->flag) {
+      case CharSrc:
+         /*
+          * Tokens from a raw character "stream".
+          */
+         t = tokenize();
+         if (t != NULL && src_stack->u.cs->f != NULL)
+            t->flag |= LineChk;
+         if (t != NULL && t->tok_id == PpLine) {
+            /*
+             * #line directives must be processed here so they are not
+             *  put in macros.
+             */
+            cs = src_stack->u.cs;
+            t1 = NULL;
+
+            /*
+             * Get the line number from the directive.
+             */
+            advance_tok(&t1);
+            if (t1->tok_id != PpNumber)
+               errt1(t1, "#line requires an integer argument");
+            n = 0;
+            for (s = t1->image; *s != '\0'; ++s) {
+               if (*s >= '0' && *s <= '9')
+                  n = 10 * n + (*s - '0');
+               else
+                  errt1(t1, "#line requires an integer argument");
+               }
+
+            /*
+             * Get the file name, if there is one, from the directive.
+             */
+            advance_tok(&t1);
+            fname = NULL;
+            if (t1->tok_id == StrLit) {
+               sbuf = get_sbuf();
+               for (s = t1->image; *s != '\0'; ++s) {
+                  if (s[0] == '\\' && (s[1] == '\\' || s[1] == '"'))
+                     ++s;
+                  AppChar(*sbuf, *s);
+                  }
+               fname = str_install(sbuf);
+               rel_sbuf(sbuf);
+               advance_tok(&t1);
+               }
+            if (t1->tok_id != PpDirEnd)
+               errt1(t1, "syntax error in #line");
+
+            /*
+             * Note the effect of the line directive in the character
+             *  source. Line number changes are handled as a relative
+             *  adjustments to the line numbers of following lines.
+             */
+            if (fname != NULL)
+               cs->fname = fname;
+            cs->line_adj = n - cs->line_buf[next_char - first_char + 1];
+            if (*next_char == '\n')
+               ++cs->line_adj;  /* the next lines contains no characters */
+
+            t = next_tok();     /* the caller does not see #line directives */
+            }
+         break;
+
+      case MacExpand:
+         /*
+          * Tokens from macro expansion.
+          */
+         t = mac_tok();
+         break;
+
+      case TokLst:
+         /*
+          * Tokens from a macro argument.
+          */
+         tlst = src_stack->u.tlst;
+         if (tlst == NULL)
+            t = NULL;
+         else {
+            t = copy_t(tlst->t);
+            src_stack->u.tlst = tlst->next;
+            }
+         break;
+
+      case PasteLsts:
+         /*
+          * Tokens from token Pasting.
+          */
+         return paste();
+      }
+
+   if (t == NULL) {
+      /*
+       * We have exhausted this entry on the source stack without finding
+       *  a token to return.
+       */
+      pop_src();
+      return next_tok();
+      }
+   else
+      return t;
+   }
+
+/*
+ * Get the next raw non-white space token, freeing token that the argument
+ *  used to point to.
+ */
+void nxt_non_wh(tp)
+struct token **tp;
+   {
+   register struct token *t;
+
+   t = next_tok();
+   while (t != NULL && t->tok_id == WhiteSpace) {
+      free_t(t);
+      t = next_tok();
+      }
+   free_t(*tp);
+   *tp = t;
+   }
+
+/*
+ * advance_tok - skip past white space after expanding macros and
+ *  executing preprocessor directives. This routine may only be
+ *  called from within a preprocessor directive because it assumes
+ *  it will not see EOF (the input routines insure that a terminating
+ *  new-line, and thus, for a directive, the PpDirEnd token, will be
+ *  seen immediately before EOF).
+ */
+void advance_tok(tp)
+struct token **tp;
+   {
+   struct token *t;
+
+   t = interp_dir();
+   while (t->tok_id == WhiteSpace) {
+      free_t(t);
+      t = interp_dir();
+      }
+   free_t(*tp);
+   *tp = t;
+   }
+
+/*
+ * merge_whsp - merge a sequence of white space tokens into one token,
+ *  returning it along with the next token. Whether these are raw or
+ *  processed tokens depends on the token source function, t_src.
+ */
+void merge_whsp(whsp, next_t, t_src)
+struct token **whsp;
+struct token **next_t;
+struct token *(*t_src)(void);
+   {
+   struct token *t1;
+   struct str_buf *sbuf;
+   int line = -1;
+   char *fname = "";
+   char *s;
+
+   free_t(*whsp);
+   t1 = (*t_src)();
+   if (t1 == NULL || t1->tok_id != WhiteSpace)
+      *whsp  = NULL;   /* no white space here */
+   else {
+      *whsp = t1;
+      t1 = (*t_src)();
+      if (t1 != NULL && t1->tok_id == WhiteSpace) {
+         if (whsp_image == NoSpelling) {
+            /*
+             * We don't care what the white space looks like, so
+             *  discard the rest of it.
+             */
+            while (t1 != NULL && t1->tok_id == WhiteSpace) {
+               free_t(t1);
+               t1 = (*t_src)();
+               }
+            }
+         else {
+            /*
+             * Must actually merge white space. Put it all white space
+             *  in a string buffer and use that as the image of the merged
+             *  token. The line number and file name of the new token
+             *  is that of the last token whose line number and file
+             *  name is important for generating #line directives in
+             *  the output.
+             */
+            sbuf = get_sbuf();
+            if ((*whsp)->flag & LineChk) {
+               line = (*whsp)->line;
+               fname = (*whsp)->fname;
+               }
+            for (s = (*whsp)->image; *s != '\0'; ++s) {
+               AppChar(*sbuf, *s);
+               if (*s == '\n' && line != -1)
+                  ++line;
+               }
+            while (t1 != NULL && t1->tok_id == WhiteSpace) {
+               if (t1->flag & LineChk) {
+                  line = t1->line;
+                  fname = t1->fname;
+                  }
+               for (s = t1->image; *s != '\0'; ++s) {
+                  AppChar(*sbuf, *s);
+                  if (*s == '\n' && line != -1)
+                     ++line;
+                  }
+               free_t(t1);
+               t1 = (*t_src)();
+               }
+            (*whsp)->image = str_install(sbuf);
+            rel_sbuf(sbuf);
+            if (t1 != NULL && !(t1->flag & LineChk) && line != -1) {
+               t1->flag |= LineChk;
+               t1->line = line;
+               t1->fname = fname;
+               }
+            }
+         }
+      }
+   *next_t = t1;
+   }
diff --git a/src/preproc/macro.c b/src/preproc/macro.c
new file mode 100644
index 0000000..d40ac36
--- /dev/null
+++ b/src/preproc/macro.c
@@ -0,0 +1,659 @@
+/*
+ * This file contains various functions for dealing with macros.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+#include "../preproc/pproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static struct macro     **m_find      (char *mname);
+static int            eq_id_lst   (struct id_lst *lst1, struct id_lst *lst2);
+static int            eq_tok_lst  (struct tok_lst *lst1, struct tok_lst *lst2);
+static int            parm_indx   (char *id, struct macro *m);
+static void            cpy_str     (char *ldelim, char *image,
+                                        char *rdelim, struct str_buf *sbuf);
+static struct token      *stringize   (struct token *trigger,
+                                        struct mac_expand *me);
+static struct paste_lsts *paste_parse (struct token *t,
+                                        struct mac_expand *me);
+static int               *cpy_image   (struct token *t, int *s);
+
+#define MacTblSz 149
+#define MHash(x) (((unsigned int)(unsigned long)(x)) % MacTblSz)
+
+static struct macro *m_table[MacTblSz];	/* hash table of macros */
+
+int max_recurse;
+
+/*
+ * Some string to put in the string table:
+ */
+static char *line_mac = "__LINE__";
+static char *file_mac = "__FILE__";
+static char *date_mac = "__DATE__";
+static char *time_mac = "__TIME__";
+static char *rcrs_mac = "__RCRS__";
+static char *defined = "defined";
+
+/*
+ * m_find - return return location of pointer to where macro belongs in
+ *  macro table. If the macro is not in the table, the pointer at the
+ *  location is NULL.
+ */
+static struct macro **m_find(mname)
+char *mname;
+   {
+   struct macro **mpp;
+
+   for (mpp = &m_table[MHash(mname)]; *mpp != NULL && (*mpp)->mname != mname;
+      mpp = &(*mpp)->next)
+      ;
+   return mpp;
+   }
+
+/*
+ * eq_id_lst - check to see if two identifier lists contain the same identifiers
+ *  in the same order.
+ */
+static int eq_id_lst(lst1, lst2)
+struct id_lst *lst1;
+struct id_lst *lst2;
+   {
+   if (lst1 == lst2)
+      return 1;
+   if (lst1 == NULL || lst2 == NULL)
+      return 0;
+   if (lst1->id != lst2->id)
+      return 0;
+   return eq_id_lst(lst1->next, lst2->next);
+   }
+
+/*
+ * eq_tok_lst - check to see if 2 token lists contain the same tokens
+ *  in the same order. All white space tokens are considered equal.
+ */
+static int eq_tok_lst(lst1, lst2)
+struct tok_lst *lst1;
+struct tok_lst *lst2;
+   {
+   if (lst1 == lst2)
+      return 1;
+   if (lst1 == NULL || lst2 == NULL)
+      return 0;
+   if (lst1->t->tok_id != lst2->t->tok_id)
+      return 0;
+   if (lst1->t->tok_id != WhiteSpace && lst1->t->tok_id != PpDirEnd &&
+        lst1->t->image != lst2->t->image)
+      return 0;
+   return eq_tok_lst(lst1->next, lst2->next);
+   }
+
+/*
+ * init_macro - initialize this module, setting up standard macros.
+ */
+void init_macro()
+   {
+   int i;
+   struct macro **mpp;
+   struct token *t;
+   time_t tv;
+   char *s, *tval;
+   static char *time_buf;
+   static char *date_buf;
+   static short first_time = 1;
+
+   if (first_time) {
+      first_time = 0;
+      /*
+       * Add names of standard macros to sting table.
+       */
+      line_mac = spec_str(line_mac);
+      file_mac = spec_str(file_mac);
+      date_mac = spec_str(date_mac);
+      time_mac = spec_str(time_mac);
+      rcrs_mac = spec_str(rcrs_mac);
+      defined = spec_str(defined);
+      }
+   else {
+      /*
+       * Free macro definitions from the file processed.
+       */
+      for (i = 0; i < MacTblSz; ++i)
+         free_m_lst(m_table[i]);
+      }
+
+   for (i = 0; i < MacTblSz; ++i)
+      m_table[i] = NULL;
+
+   /*
+    * __LINE__ and __FILE__ are macros that require special processing
+    *  when they are processed. Indicate that.
+    */
+   mpp = m_find(line_mac);
+   *mpp = new_macro(line_mac, SpecMac, 0, NULL, NULL);
+
+   mpp = m_find(file_mac);
+   *mpp = new_macro(file_mac, SpecMac, 0, NULL, NULL);
+
+   /*
+    * __TIME__ and __DATE__ must be initialized to the current time and
+    *  date.
+    */
+   time(&tv);
+   tval = ctime(&tv);
+   date_buf = alloc(12);
+   time_buf = alloc(9);
+   s = date_buf;
+   for (i = 4; i <= 10; ++i)
+      *s++ = tval[i];
+   for (i = 20; i <= 23; ++i)
+      *s++ = tval[i];
+   *s = '\0';
+   s = time_buf;
+   for (i = 11; i <= 18; ++i)
+      *s++ = tval[i];
+   *s = '\0';
+   date_buf = spec_str(date_buf);
+   time_buf = spec_str(time_buf);
+
+   t = new_token(StrLit, date_buf, "", 0);
+   mpp = m_find(date_mac);
+   *mpp = new_macro(date_mac, FixedMac, 0, NULL, new_t_lst(t));
+
+   t = new_token(StrLit, time_buf, "", 0);
+   mpp = m_find(time_mac);
+   *mpp = new_macro(time_mac, FixedMac, 0, NULL, new_t_lst(t));
+
+   /*
+    * __RCRS__ is a special macro to indicate the allowance of
+    *  recursive macros. It is not ANSI-standard. Initialize it
+    *  to "1".
+    */
+   mpp = m_find(rcrs_mac);
+   *mpp = new_macro(rcrs_mac, NoArgs, 0, NULL, new_t_lst(copy_t(one_tok)));
+   max_recurse = 1;
+   }
+
+/*
+ * m_install - install a macro.
+ */
+void m_install(mname, category, multi_line, prmlst, body)
+struct token *mname;	/* name of macro */
+int multi_line;		/* flag indicating if this is a multi-line macro */
+int category;		/* # parms, or NoArgs if it is object-like macro */
+struct id_lst *prmlst;	/* parameter list */
+struct tok_lst *body;	/* replacement list */
+   {
+   struct macro **mpp;
+   char *s;
+
+   if (mname->image == defined)
+      errt1(mname, "'defined' may not be the subject of #define");
+
+   /*
+    * The special macro __RCRS__ may only be defined as a single integer
+    *  token and must be an object-like macro.
+    */
+   if (mname->image == rcrs_mac) {
+      if (body == NULL || body->t->tok_id != PpNumber || body->next != NULL)
+         errt1(mname, "__RCRS__ must be a decimal integer");
+      if (category != NoArgs)
+         errt1(mname, "__RSCS__ may have no arguments");
+      max_recurse = 0;
+      for (s = body->t->image; *s != '\0'; ++s) {
+         if (*s >= '0' && *s <= '9')
+            max_recurse = max_recurse * 10 + (*s - '0');
+         else
+            errt1(mname, "__RCRS__ must be a decimal integer");
+         }
+      }
+
+   mpp = m_find(mname->image);
+   if (*mpp == NULL)
+      *mpp = new_macro(mname->image, category, multi_line, prmlst, body);
+    else {
+      /*
+       * The macro is already defined. Make sure it is identical (up to
+       *  white space) to this definition.
+       */
+      if (!((*mpp)->category == category && eq_id_lst((*mpp)->prmlst, prmlst) &&
+           eq_tok_lst((*mpp)->body, body)))
+         errt2(mname, "invalid redefinition of macro ", mname->image);
+      free_id_lst(prmlst);
+      free_t_lst(body);
+      }
+   }
+
+/*
+ * m_delete - delete a macro.
+ */
+void m_delete(mname)
+struct token *mname;
+   {
+   struct macro **mpp, *mp;
+
+   if (mname->image == defined)
+      errt1(mname, "'defined' may not be the subject of #undef");
+
+   /*
+    * Undefining __RCRS__ allows unlimited macro recursion (non-ANSI
+    *  standard feature.
+    */
+   if (mname->image == rcrs_mac)
+      max_recurse = -1;
+
+   /*
+    * Make sure undefining this macro is allowed, and free storage
+    *  associate with it.
+    */
+   mpp = m_find(mname->image);
+   if (*mpp != NULL) {
+      mp = *mpp;
+      if (mp->category == FixedMac || mp->category == SpecMac)
+         errt2(mname, mname->image, " may not be the subject of #undef");
+      *mpp = mp->next;
+      free_m(mp);
+      }
+   }
+
+/*
+ * m_lookup - lookup a macro name. Return pointer to macro, if it is defined;
+ *  return NULL, if it is not. This routine sets the definition for macros
+ *  whose definitions various from place to place.
+ */
+struct macro *m_lookup(id)
+struct token *id;
+   {
+   struct macro *m;
+   static char buf[20];
+
+   m = *m_find(id->image);
+   if (m != NULL && m->category == SpecMac)
+      if (m->mname == line_mac) {  /* __LINE___ */
+         sprintf(buf, "%d", id->line);
+         m->body = new_t_lst(new_token(PpNumber, buf, id->fname,
+            id->line));
+         }
+      else if (m->mname == file_mac) /* __FILE__ */
+         m->body = new_t_lst(new_token(StrLit, id->fname, id->fname,
+            id->line));
+   return m;
+   }
+
+/*
+ * parm_indx - see if a name is a paramter to the given macro.
+ */
+static int parm_indx(id, m)
+char *id;
+struct macro *m;
+   {
+   struct id_lst *idlst;
+   int i;
+
+   for (i = 0, idlst = m->prmlst; i < m->category; i++, idlst = idlst->next)
+      if (id == idlst->id)
+         return i;
+   return -1;
+   }
+
+/*
+ * cpy_str - copy a string into a string buffer, adding delimiters.
+ */
+static void cpy_str(ldelim, image, rdelim, sbuf)
+char *ldelim;
+char *image;
+char *rdelim;
+struct str_buf *sbuf;
+   {
+   register char *s;
+
+   for (s = ldelim; *s != '\0'; ++s)
+      AppChar(*sbuf, *s);
+
+   for (s = image; *s != '\0'; ++s) {
+      if (*s == '\\' || *s == '"')
+         AppChar(*sbuf, '\\');
+      AppChar(*sbuf, *s);
+      }
+
+   for (s = rdelim; *s != '\0'; ++s)
+      AppChar(*sbuf, *s);
+   }
+
+/*
+ * stringize - create a stringized version of a token.
+ */
+static struct token *stringize(trigger, me)
+struct token *trigger;
+struct mac_expand *me;
+   {
+   register struct token *t;
+   struct tok_lst *arg;
+   struct str_buf *sbuf;
+   char *s;
+   int indx;
+
+   /*
+    * Get the next token from the macro body. It must be a macro parameter;
+    *  retrieve the raw tokens for the corresponding argument.
+    */
+   if (me->rest_bdy == NULL)
+      errt1(trigger, "the # operator must have an argument");
+   t = me->rest_bdy->t;
+   me->rest_bdy = me->rest_bdy->next;
+   if (t->tok_id == Identifier)
+      indx = parm_indx(t->image, me->m);
+   else
+      indx = -1;
+   if (indx == -1)
+      errt1(t, "the # operator may only be applied to a macro argument");
+   arg = me->args[indx];
+
+   /*
+    * Copy the images for the argument tokens into a string buffer. Note
+    *  that the images of string and character literals lack quotes; these
+    *  must be escaped in the stringized value.
+    */
+   sbuf = get_sbuf();
+   while (arg != NULL) {
+      t = arg->t;
+      if (t->tok_id == WhiteSpace)
+         AppChar(*sbuf, ' ');
+      else if (t->tok_id == StrLit)
+         cpy_str("\\\"", t->image, "\\\"", sbuf);
+      else if (t->tok_id == LStrLit)
+         cpy_str("L\\\"", t->image, "\\\"", sbuf);
+      else if (t->tok_id == CharConst)
+         cpy_str("'", t->image, "'", sbuf);
+      else if (t->tok_id == LCharConst)
+         cpy_str("L'", t->image, "'", sbuf);
+      else
+         for (s = t->image; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+      arg = arg->next;
+      }
+
+   /*
+    * Created the token for the stringized argument.
+    */
+   t = new_token(StrLit, str_install(sbuf), trigger->fname, trigger->line);
+   t->flag |= trigger->flag & LineChk;
+   rel_sbuf(sbuf);
+   return t;
+   }
+
+/*
+ * paste_parse - parse an expression involving token pasting operators (and
+ *  stringizing operators). Return a list of token lists. Each token list
+ *  is from a token pasting operand, with operands that are macro parameters
+ *  replaced by their corresponding argument (this is why a list of tokens
+ *  is needed for each operand). Any needed stringizing is done as the list
+ *  is created.
+ */
+static struct paste_lsts *paste_parse(t, me)
+struct token *t;
+struct mac_expand *me;
+   {
+   struct token *t1;
+   struct token *trigger = NULL;
+   struct tok_lst *lst;
+   struct paste_lsts *plst;
+   int indx;
+
+   if (me->rest_bdy == NULL || me->rest_bdy->t->tok_id != PpPaste)
+      plst = NULL;  /* we have reached the end of the pasting expression */
+   else {
+      /*
+       * The next token is a pasting operator. Copy it an move on to the
+       *  operand.
+       */
+      trigger = copy_t(me->rest_bdy->t);
+      me->rest_bdy = me->rest_bdy->next;
+      if (me->rest_bdy == NULL)
+         errt1(t, "the ## operator must not appear at the end of a macro");
+      t1 = me->rest_bdy->t;
+      me->rest_bdy = me->rest_bdy->next;
+
+      /*
+       * See if the operand is a stringizing operation.
+       */
+      if (t1->tok_id == '#')
+         t1 = stringize(t1, me);
+      else
+         t1 = copy_t(t1);
+      plst = paste_parse(t1, me); /* get any further token pasting */
+      }
+
+   /*
+    * If the operand is a macro parameter, replace it by the corresponding
+    *  argument, otherwise make the operand into a 1-element token list.
+    */
+   indx = -1;
+   if (t->tok_id == Identifier)
+      indx = parm_indx(t->image, me->m);
+   if (indx == -1)
+      lst = new_t_lst(t);
+   else {
+      lst = me->args[indx];
+      free_t(t);
+      }
+
+   /*
+    * Ignore emtpy arguments when constructing the pasting list.
+    */
+   if (lst == NULL)
+      return plst;
+   else
+      return new_plsts(trigger, lst, plst);
+   }
+
+/*
+ * cpy_image - copy the image of a token into a character buffer adding
+ *  delimiters if it is a string or character literal.
+ */
+static int *cpy_image(t, s)
+struct token *t;
+int *s;          /* the string buffer can contain EOF */
+   {
+   register char *s1;
+
+   switch (t->tok_id) {
+      case StrLit:
+         *s++ = '"';
+         break;
+      case LStrLit:
+         *s++ = 'L';
+         *s++ = '"';
+         break;
+      case CharConst:
+         *s++ = '\'';
+         break;
+      case LCharConst:
+         *s++ = 'L';
+         *s++ = '\'';
+         break;
+      }
+
+   s1 = t->image;
+   while (*s1 != '\0')
+      *s++ = *s1++;
+
+   switch (t->tok_id) {
+      case StrLit:
+      case LStrLit:
+         *s++ = '"';
+         break;
+      case CharConst:
+      case LCharConst:
+         *s++ = '\'';
+         break;
+      }
+
+   return s;
+   }
+
+/*
+ * paste - return the next token from a source which pastes tokens. The
+ *   source may represent a series of token pasting operators.
+ */
+struct token *paste()
+   {
+   struct token *t;
+   struct token *t1;
+   struct token *trigger;
+   struct paste_lsts *plst;
+   union src_ref ref;
+   int i;
+   int *s;
+
+   plst = src_stack->u.plsts;
+
+   /*
+    * If the next token of the current list is not the one to be pasted,
+    *  just return it.
+    */
+   t = copy_t(plst->tlst->t);
+   plst->tlst = plst->tlst->next;
+   if (plst->tlst != NULL)
+      return t;
+
+   /*
+    * We have the last token from the current list. If there is another
+    *  list, this token must be pasted to the first token of that list.
+    *  Make the next list the current one and get its first token.
+    */
+   trigger = plst->trigger;
+   plst = plst->next;
+   free_plsts(src_stack->u.plsts);
+   src_stack->u.plsts = plst;
+   if (plst == NULL) {
+      pop_src();
+      return t;
+      }
+   t1 = next_tok();
+
+   /*
+    * Paste tokens by creating a character source with the images of the
+    *  two tokens concatenated.
+    */
+   ref.cs = new_cs(trigger->fname, NULL,
+      (int)strlen(t->image) + (int)strlen(t1->image) + 7);
+   push_src(CharSrc, &ref);
+   s = cpy_image(t, ref.cs->char_buf);
+   s = cpy_image(t1, s);
+   *s = EOF;
+
+   /*
+    * Treat all characters of the new source as if they come from the
+    *  location of the token pasting.
+    */
+   for (i = 0; i < (s - ref.cs->char_buf + 1); ++i)
+      *(ref.cs->line_buf) = trigger->line;
+   ref.cs->last_char = s;
+   ref.cs->dir_state = Reset;
+   first_char = ref.cs->char_buf;
+   next_char = first_char;
+   last_char = ref.cs->last_char;
+
+   return next_tok(); /* first token from pasted images */
+   }
+
+/*
+ * mac_tok - return the next token from a source which is a macro.
+ */
+struct token *mac_tok()
+   {
+   struct mac_expand *me;
+   register struct token *t, *t1;
+   struct paste_lsts *plst;
+   union src_ref ref;
+   int line_check;
+   int indx;
+   int line;
+   char *fname;
+
+   me = src_stack->u.me; /* macro, current position, and arguments */
+
+   /*
+    * Get the next token from the macro body.
+    */
+   if (me->rest_bdy == NULL)
+      return NULL;
+   t = me->rest_bdy->t;
+   me->rest_bdy = me->rest_bdy->next;
+
+   /*
+    * If this token is a stringizing operator, try stringizing the next
+    *  token.
+    */
+   if (t->tok_id == '#')
+      t = stringize(t, me);
+   else
+      t = copy_t(t);
+
+   if (me->rest_bdy != NULL && me->rest_bdy->t->tok_id == PpPaste) {
+      /*
+       * We have found token pasting. If there is a series of such operators,
+       *  make them all into one token pasting source and push it on
+       *  the source stack.
+       */
+      if (t->flag & LineChk) {
+         line_check = 1;
+         line = t->line;
+         fname = t->fname;
+         }
+      else
+         line_check = 0;
+      plst = paste_parse(t, me);
+      if (plst != NULL) {
+         ref.plsts = plst;
+         push_src(PasteLsts, &ref);
+         }
+      t1 = next_tok();
+      if (line_check && !(t1->flag & LineChk)) {
+         t1->flag |= LineChk;
+         t1->line = line;
+         t1->fname = fname;
+         }
+      return t1;
+      }
+   else if (t->tok_id == Identifier &&
+     (indx = parm_indx(t->image, me->m)) != -1) {
+      /*
+       * We have found a parameter. Push a token source for the corresponding
+       *  argument, that is, replace the parameter with its definition.
+       */
+      ref.tlst = me->exp_args[indx];
+      push_src(TokLst, &ref);
+      if (t->flag & LineChk) {
+         line = t->line;
+         fname = t->fname;
+         t1 = next_tok();
+         if (!(t1->flag & LineChk)) {
+            /*
+             * The parameter name token is significant with respect to
+             *  outputting #line directives but the first argument token
+             *  is not. Pretend the argument has the same line number as the
+             *  parameter name.
+             */
+            t1->flag |= LineChk;
+            t1->line = line;
+            t1->fname = fname;
+            }
+         free_t(t);
+         return t1;
+         }
+      else {
+         free_t(t);
+         return next_tok();
+         }
+      }
+   else {
+      /*
+       * This is an ordinary token, nothing further is needed here.
+       */
+      return t;
+      }
+   }
diff --git a/src/preproc/pchars.c b/src/preproc/pchars.c
new file mode 100644
index 0000000..5d1d00c
--- /dev/null
+++ b/src/preproc/pchars.c
@@ -0,0 +1,157 @@
+#include "../preproc/preproc.h"
+#include "../preproc/pproto.h"
+
+int *first_char;
+int *next_char;
+int *last_char;
+
+/*
+ * fill_cbuf - fill the current character buffer.
+ */
+void fill_cbuf()
+   {
+   register int c1, c2, c3;
+   register int *s;
+   register int *l;
+   int c;
+   int line;
+   int changes;
+   struct char_src *cs;
+   FILE *f;
+
+   cs = src_stack->u.cs;
+   f = cs->f;
+   s = cs->char_buf;
+   l = cs->line_buf;
+
+   if (next_char == NULL) {
+      /*
+       * Initial filling of buffer.
+       */
+      first_char = cs->char_buf;
+      last_char = first_char + cs->bufsize - 3;
+      cs->last_char = last_char;
+      line = 1;
+      /*
+       * Get initial read-ahead.
+       */
+      if ((c2 = getc(f)) != EOF)
+         c3 = getc(f);
+      }
+   else if (*next_char == EOF)
+      return;
+   else {
+      /*
+       * The calling routine needs at least 2 characters, so there is one
+       *  left in the buffer.
+       */
+      *s++= *next_char;
+      line = cs->line_buf[next_char - first_char];
+      *l++ = line;
+
+      /*
+       * Retrieve the 2 read-ahead characters that were saved the last
+       *  time the buffer was filled.
+       */
+      c2 = last_char[1];
+      c3 = last_char[2];
+      }
+
+   next_char = first_char;
+
+   /*
+    * Fill buffer from input file.
+    */
+   while (s <= last_char) {
+      c1 = c2;
+      c2 = c3;
+      c3 = getc(f);
+
+      /*
+       * The first phase of input translation is done here: trigraph
+       *  translation and the deletion of backslash-newline pairs.
+       */
+      changes = 1;
+      while (changes) {
+         changes = 0;
+         /*
+          * check for trigraphs
+          */
+         if (c1 == '?' && c2 == '?') {
+            c = ' ';
+            switch (c3) {
+               case '=':
+                  c = '#';
+                  break;
+               case '(':
+                  c = '[';
+                  break;
+               case '/':
+                  c = '\\';
+                  break;
+               case ')':
+                  c = ']';
+                  break;
+               case '\'':
+                  c = '^';
+                  break;
+               case '<':
+                  c = '{';
+                  break;
+               case '!':
+                  c = '|';
+                  break;
+               case '>':
+                  c = '}';
+                  break;
+               case '-':
+                  c = '~';
+                  break;
+               }
+            /*
+             * If we found a trigraph, use it and refill the 2-character
+             *  read-ahead.
+             */
+            if (c != ' ') {
+               c1 = c;
+               if ((c2 = getc(f)) != EOF)
+                  c3 = getc(f);
+               changes = 1;
+               }
+            }
+
+         /*
+          * delete backslash-newline pairs
+          */
+         if (c1 == '\\' && c2 == '\n') {
+            ++line;
+            if ((c1 = c3) != EOF)
+               if ((c2 = getc(f)) != EOF)
+                  c3 = getc(f);
+            changes = 1;
+            }
+         }
+      if (c1 == EOF) {
+         /*
+          * If last character in file is not a new-line, insert one.
+          */
+         if (s == first_char || s[-1] != '\n')
+            *s++ = '\n';
+         *s = EOF;
+         last_char = s;
+         cs->last_char = last_char;
+         return;
+         }
+      if (c1 == '\n')
+         ++line;
+      *s++ = c1;   /* put character in buffer */
+      *l++ = line;
+      }
+
+   /*
+    * Save the 2 character read-ahead in the reserved space at the end
+    *  of the buffer.
+    */
+   last_char[1] = c2;
+   last_char[2] = c3;
+   }
diff --git a/src/preproc/perr.c b/src/preproc/perr.c
new file mode 100644
index 0000000..9986111
--- /dev/null
+++ b/src/preproc/perr.c
@@ -0,0 +1,157 @@
+/*
+ * The functions in this file print error messages.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/pproto.h"
+extern char *progname;
+
+/*
+ * Prototypes for static functions.
+ */
+static void rm_files (void);
+
+
+/*
+ * File list.
+ */
+struct finfo_lst {
+   char *name;                  /* file name */
+   FILE *file;                  /* file */
+   struct finfo_lst *next;      /* next entry in list */
+   };
+
+static struct finfo_lst *file_lst = NULL;
+
+/*
+ * errt1 - error message in one string, location indicated by a token.
+ */
+void errt1(t, s)
+struct token *t;
+char *s;
+   {
+   errfl1(t->fname, t->line, s);
+   }
+
+/*
+ * errfl1 - error message in one string, location given by file and line.
+ */
+void errfl1(f, l, s)
+char *f;
+int l;
+char *s;
+   {
+   fflush(stdout);
+   fprintf(stderr, "%s: File %s; Line %d: %s\n", progname, f, l, s);
+   rm_files();
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * err1 - error message in one string, no location given
+ */
+void err1(s)
+char *s;
+   {
+   fflush(stdout);
+   fprintf(stderr, "%s: %s\n", progname, s);
+   rm_files();
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * errt2 - error message in two strings, location indicated by a token.
+ */
+void errt2(t, s1, s2)
+struct token *t;
+char *s1;
+char *s2;
+   {
+   errfl2(t->fname, t->line, s1, s2);
+   }
+
+/*
+ * errfl2 - error message in two strings, location given by file and line.
+ */
+void errfl2(f, l, s1, s2)
+char *f;
+int l;
+char *s1;
+char *s2;
+   {
+   fflush(stdout);
+   fprintf(stderr, "%s: File %s; Line %d: %s%s\n", progname, f, l, s1, s2);
+   rm_files();
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * err2 - error message in two strings, no location given
+ */
+void err2(s1, s2)
+char *s1;
+char *s2;
+   {
+   fflush(stdout);
+   fprintf(stderr, "%s: %s%s\n", progname, s1, s2);
+   rm_files();
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * errt3 - error message in three strings, location indicated by a token.
+ */
+void errt3(t, s1, s2, s3)
+struct token *t;
+char *s1;
+char *s2;
+char *s3;
+   {
+   errfl3(t->fname, t->line, s1, s2, s3);
+   }
+
+/*
+ * errfl3 - error message in three strings, location given by file and line.
+ */
+void errfl3(f, l, s1, s2, s3)
+char *f;
+int l;
+char *s1;
+char *s2;
+char *s3;
+   {
+   fflush(stdout);
+   fprintf(stderr, "%s: File %s; Line %d: %s%s%s\n", progname, f, l,
+       s1, s2, s3);
+   rm_files();
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * addrmlst - add a file name to the list of files to be removed if
+ *   an error occurs.
+ */
+void addrmlst(fname, f)
+char *fname;
+FILE *f;
+   {
+   struct finfo_lst *id;
+
+   id = NewStruct ( finfo_lst );
+   id->name = fname;
+   id->file = f;
+   id->next = file_lst;
+   file_lst = id;
+   }
+
+/*
+ * rm_files - remove files that must be cleaned up in the event of an
+ *   error.
+ */
+static void rm_files()
+   {
+   while (file_lst != NULL) {
+      fclose ( file_lst->file );
+      remove(file_lst->name);
+      file_lst = file_lst->next;
+      }
+   }
diff --git a/src/preproc/pinit.c b/src/preproc/pinit.c
new file mode 100644
index 0000000..9f64cb0
--- /dev/null
+++ b/src/preproc/pinit.c
@@ -0,0 +1,251 @@
+/*
+ * This file contains functions used to initialize the preprocessor,
+ *  particularly those for establishing implementation-dependent standard
+ *  macro definitions.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+#include "../preproc/pproto.h"
+
+static void define_opt   (char *s, int len, struct token *dflt);
+static void do_directive (char *s);
+static void mac_opts     (char *opt_lst, char **opt_args);
+static void undef_opt    (char *s, int len);
+
+struct src dummy;
+
+/*
+ * init_preproc - initialize all parts of the preprocessor, establishing
+ *  the primary file as the current source of tokens.
+ */
+void init_preproc(fname, opt_lst, opt_args)
+char *fname;
+char *opt_lst;
+char **opt_args;
+   {
+
+   init_str();                      /* initialize string table */
+   init_tok();                      /* initialize tokenizer */
+   init_macro();                    /* initialize macro table */
+   init_files(opt_lst, opt_args);   /* initialize standard header locations */
+   dummy.flag = DummySrc;           /* marker at bottom of source stack */
+   dummy.ntoks = 0;
+   src_stack = &dummy;
+   mac_opts(opt_lst, opt_args);     /* process options for predefined macros */
+   source(fname);                   /* establish primary source file */
+   }
+
+/*
+ * mac_opts - handle options which affect what predefined macros are in
+ *  effect when preprocessing starts.  The options may be on the command
+ *  line.  Also establish predefined macros.
+ */
+static void mac_opts(opt_lst, opt_args)
+char *opt_lst;
+char **opt_args;
+   {
+   int i;
+
+   /*
+    *  Establish predefined macros.
+    */
+   #if CYGWIN
+      do_directive("#define __CYGWIN32__\n");
+      do_directive("#define __CYGWIN__\n");
+      do_directive("#define __unix__\n");
+      do_directive("#define __unix\n");
+      do_directive("#define _WIN32\n");
+      do_directive("#define __WIN32\n");
+      do_directive("#define __WIN32__\n");
+   #else				/* CYGWIN */
+      do_directive("#define unix 1\n");
+      do_directive(PPInit);   /* defines that vary between Unix systems */
+   #endif				/* CYGWIN*/
+
+   /*
+    * look for options that affect macro definitions (-U, -D, etc).
+    */
+   for (i = 0; opt_lst[i] != '\0'; ++i)
+      switch(opt_lst[i]) {
+         case 'U':
+            /*
+             * Undefine and predefined identifier.
+             */
+            undef_opt(opt_args[i], (int)strlen(opt_args[i]));
+            break;
+
+         case 'D':
+            /*
+             * Define an identifier. Use "1" if no defining string is given.
+             */
+            define_opt(opt_args[i], (int)strlen(opt_args[i]), one_tok);
+            break;
+         }
+   }
+
+/*
+ * str_src - establish a string, given by a character pointer and a length,
+ *  as the current source of tokens.
+ */
+void str_src(src_name, s, len)
+char *src_name;
+char *s;
+int len;
+   {
+   union src_ref ref;
+   int *ip1, *ip2;
+
+   /*
+    * Create a character source with a large enought buffer for the string.
+    */
+   ref.cs = new_cs(src_name, NULL, len + 1);
+   push_src(CharSrc, &ref);
+   ip1 = ref.cs->char_buf;
+   ip2 = ref.cs->line_buf;
+   while (len-- > 0) {
+     *ip1++ = *s++;    /* copy string to source buffer */
+     *ip2++ = 0;       /* characters are from "line 0" */
+     }
+   *ip1 = EOF;
+   *ip2 = 0;
+   ref.cs->next_char = ref.cs->char_buf;
+   ref.cs->last_char = ip1;
+   first_char = ref.cs->char_buf;
+   next_char = first_char;
+   last_char = ref.cs->last_char;
+   }
+
+/*
+ * do_directive - take a character string containing preprocessor
+ *  directives separated by new-lines and execute them. This done
+ *  by preprocessing the string.
+ */
+static void do_directive(s)
+char *s;
+   {
+   str_src("<initialization>", s, (int)strlen(s));
+   while (interp_dir() != NULL)
+      ;
+   }
+
+/*
+ * undef_opt - take the argument to a -U option and, if it is valid,
+ *  undefine it.
+ */
+static void undef_opt(s, len)
+char *s;
+int len;
+   {
+   struct token *mname;
+   int i;
+
+   /*
+    * The name is needed in the form of a token. Use the preprocessor
+    *  to tokenize it.
+    */
+   str_src("<options>", s, len);
+   mname = next_tok();
+   if (mname == NULL || mname->tok_id != Identifier ||
+     next_tok() != NULL) {
+      fprintf(stderr, "invalid argument to -U option: ");
+      for (i = 0; i < len; ++i)
+         putc(s[i], stderr);    /* show offending argument */
+      putc('\n', stderr);
+      show_usage();
+      }
+   m_delete(mname);
+   }
+
+/*
+ * define_opt - take an argument to a -D option and, if it is valid, perform
+ *  the requested definition.
+ */
+static void define_opt(s, len, dflt)
+char *s;
+int len;
+struct token *dflt;
+   {
+   struct token *mname;
+   struct token *t;
+   struct tok_lst *body;
+   struct tok_lst **ptlst, **trail_whsp;
+   int i;
+
+   /*
+    * The argument to -D must be tokenized.
+    */
+   str_src("<options>", s, len);
+
+   /*
+    * Find the macro name.
+    */
+   mname = next_tok();
+   if (mname == NULL || mname->tok_id != Identifier) {
+      fprintf(stderr, "invalid argument to -D option: ");
+      for (i = 0; i < len; ++i)
+         putc(s[i], stderr);
+      putc('\n', stderr);
+      show_usage();
+      }
+
+   /*
+    * Determine if the name is followed by '='.
+    */
+   if (chk_eq_sign()) {
+      /*
+       * Macro body is given, strip leading white space
+       */
+      t = next_tok();
+      if (t != NULL && t->tok_id == WhiteSpace) {
+         free_t(t);
+         t = next_tok();
+         }
+
+
+      /*
+       * Construct the token list for body of macro. Keep track of trailing
+       *  white space so it can be deleted.
+       */
+      body = NULL;
+      ptlst = &body;
+      trail_whsp = NULL;
+      while (t != NULL) {
+         t->flag &= ~LineChk;
+         (*ptlst) = new_t_lst(t);
+         if (t->tok_id == WhiteSpace)
+            trail_whsp = ptlst;
+         else
+            trail_whsp = NULL;
+         ptlst = &(*ptlst)->next;
+         t = next_tok();
+         }
+
+      /*
+       * strip trailing white space
+       */
+      if (trail_whsp != NULL) {
+         free_t_lst(*trail_whsp);
+         *trail_whsp = NULL;
+         }
+      }
+   else {
+      /*
+       * There is no '=' after the macro name; use the supplied
+       *  default value for the macro definition.
+       */
+      if (next_tok() == NULL)
+         if (dflt == NULL)
+            body = NULL;
+         else
+            body = new_t_lst(copy_t(dflt));
+      else {
+         fprintf(stderr, "invalid argument to -D option: ");
+         for (i = 0; i < len; ++i)
+            putc(s[i], stderr);
+         putc('\n', stderr);
+         show_usage();
+         }
+      }
+
+   m_install(mname, NoArgs, 0, NULL, body); /* install macro definition */
+   }
diff --git a/src/preproc/pmain.c b/src/preproc/pmain.c
new file mode 100644
index 0000000..9cc721a
--- /dev/null
+++ b/src/preproc/pmain.c
@@ -0,0 +1,109 @@
+#include "../preproc/preproc.h"
+#include "../preproc/pproto.h"
+
+char *progname = "pp";
+
+/*
+ * Establish command-line options.
+ */
+static char *ostr = "+CPD:I:U:o:";
+static char *options =
+   "[-C] [-P] [-Dname[=[text]]] [-Uname] [-Ipath] [-ofile] [files]";
+
+extern line_cntrl;
+
+/*
+ * getopt() variables
+ */
+extern int optind;		/* index into parent argv vector */
+extern int optopt;		/* character checked for validity */
+extern char *optarg;		/* argument associated with option */
+
+int main(argc, argv)
+int argc;
+char **argv;
+   {
+   int c;
+   char *opt_lst;
+   char **opt_args;
+   int nopts;
+   FILE *out_file;
+
+   /*
+    * By default, keep the image of white space, but replace each comment
+    *  by a space. By default, output #line directives.
+    */
+   whsp_image = NoComment;
+   line_cntrl = 1;
+
+   /*
+    * The number of options that must be passed on to other phases
+    *  of the preprocessor are at most as large as the entire option
+    *  list.
+    */
+   opt_lst = alloc(argc);
+   opt_args = alloc(argc * sizeof (char *));
+   nopts = 0;
+   out_file = stdout;
+
+   /*
+    * Process options.
+    */
+   while ((c = getopt(argc, argv, ostr)) != EOF)
+      switch (c) {
+
+         case 'C':  /* -C - retan comments */
+            whsp_image = FullImage;
+            break;
+
+         case 'P': /* -P - do not output #line directives */
+            line_cntrl = 0;
+            break;
+
+         case 'D': /* -D<id><definition> - predefine an identifier */
+         case 'I': /* -I<path> - location to search for standard header files */
+         case 'U': /* -U<id> - undefine predefined identifier */
+            opt_lst[nopts] = c;
+            opt_args[nopts] = optarg;
+            ++nopts;
+            break;
+
+         case 'o': /* -o<file> - write output to this file */
+            out_file = fopen(optarg, "w");
+            if (out_file == NULL)
+               err2("cannot open output file ", optarg);
+            break;
+
+         default:
+            show_usage();
+         }
+
+   opt_lst[nopts] = '\0';
+
+   /*
+    * Scan file name arguments. If there are none, process standard input,
+    *  indicated by the name "-".
+    */
+   if (optind == argc) {
+      init_preproc("-", opt_lst, opt_args);
+      output(out_file);
+      }
+   else {
+      while (optind < argc)  {
+         init_preproc(argv[optind], opt_lst, opt_args);
+         output(out_file);
+         optind++;
+         }
+      }
+
+   return EXIT_SUCCESS;
+   }
+
+/*
+ * Print an error message if called incorrectly.
+ */
+void show_usage()
+   {
+   fprintf(stderr, "usage: %s %s\n", progname, options);
+   exit(EXIT_FAILURE);
+   }
diff --git a/src/preproc/pmem.c b/src/preproc/pmem.c
new file mode 100644
index 0000000..c6f812e
--- /dev/null
+++ b/src/preproc/pmem.c
@@ -0,0 +1,339 @@
+/*
+ * This file does most of the memory management.
+ */
+
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+
+struct src *src_stack = NULL;  /* stack of token sources */
+
+#include "../preproc/pproto.h"
+
+/*
+ * new_macro - allocate a new entry for the macro symbol table.
+ */
+struct macro *new_macro(mname, category, multi_line, prmlst, body)
+char *mname;
+int category;
+int multi_line;
+struct id_lst *prmlst;
+struct tok_lst *body;
+   {
+   struct macro *mp;
+
+   mp = NewStruct(macro);
+   mp->mname = mname;
+   mp->category = category;
+   mp->multi_line = multi_line;
+   mp->prmlst = prmlst;
+   mp->body = body;
+   mp->ref_cnt = 1;
+   mp->recurse = 0;
+   mp->next = NULL;
+   return mp;
+   }
+
+/*
+ * new_token - allocate a new token.
+ */
+struct token *new_token(id, image, fname, line)
+int id;
+char *image;
+char *fname;
+int line;
+   {
+   struct token *t;
+
+   t = NewStruct(token);
+   t->tok_id = id;
+   t->image = image;
+   t->fname = fname;
+   t->line = line;
+   t->flag = 0;
+   return t;
+   }
+
+/*
+ * copy_t - make a copy of a token.
+ */
+struct token *copy_t(t)
+struct token *t;
+   {
+   struct token *t1;
+
+   if (t == NULL)
+      return NULL;
+
+   t1 = NewStruct(token);
+   *t1 = *t;
+   return t1;
+   }
+
+/*
+ * new_t_lst - allocate a new element for a token list.
+ */
+struct tok_lst *new_t_lst(tok)
+struct token *tok;
+   {
+   struct tok_lst *tlst;
+
+   tlst = NewStruct(tok_lst);
+   tlst->t = tok;
+   tlst->next = NULL;
+   return tlst;
+   }
+
+/*
+ * new_id_lst - allocate a new element for an identifier list.
+ */
+struct id_lst *new_id_lst(id)
+char *id;
+   {
+   struct id_lst *ilst;
+
+   ilst = NewStruct(id_lst);
+   ilst->id = id;
+   ilst->next = NULL;
+   return ilst;
+   }
+
+/*
+ * new_cs - allocate a new structure for a source of tokens created from
+ *  characters.
+ */
+struct char_src *new_cs(fname, f, bufsize)
+char *fname;
+FILE *f;
+int bufsize;
+   {
+   struct char_src *cs;
+
+   cs = NewStruct(char_src);
+   cs->char_buf = alloc(bufsize * sizeof(int));
+   cs->line_buf = alloc(bufsize * sizeof(int));
+   cs->bufsize = bufsize;
+   cs->fname = fname;
+   cs->f = f;
+   cs->line_adj = 0;
+   cs->tok_sav = NULL;
+   cs->dir_state = CanStart;
+
+   return cs;
+   }
+
+/*
+ * new_me - allocate a new structure for a source of tokens derived
+ *  from macro expansion.
+ */
+struct mac_expand *new_me(m, args, exp_args)
+struct macro *m;
+struct tok_lst **args;
+struct tok_lst **exp_args;
+   {
+   struct mac_expand *me;
+
+   me = NewStruct(mac_expand);
+   me->m = m;
+   me->args = args;
+   me->exp_args = exp_args;
+   me->rest_bdy = m->body;
+   return me;
+   }
+
+/*
+ * new_plsts - allocate a element for a list of token lists used as
+ *  as source of tokens derived from a sequence of token pasting
+ *  operations.
+ */
+struct paste_lsts *new_plsts(trigger, tlst, plst)
+struct token *trigger;
+struct tok_lst *tlst;
+struct paste_lsts *plst;
+   {
+   struct paste_lsts *plsts;
+
+   plsts = NewStruct(paste_lsts);
+   plsts->trigger = trigger;
+   plsts->tlst = tlst;
+   plsts->next = plst;
+   return plsts;
+   }
+
+/*
+ * get_sbuf - dynamically allocate a string buffer.
+ */
+struct str_buf *get_sbuf()
+   {
+   struct str_buf *sbuf;
+
+   sbuf = NewStruct(str_buf);
+   init_sbuf(sbuf);
+   return sbuf;
+   }
+
+/*
+ * push_src - push an entry on the stack of tokens sources. This entry
+ *  becomes the current source.
+ */
+void push_src(flag, ref)
+int flag;
+union src_ref *ref;
+   {
+   struct src *sp;
+
+   sp = NewStruct(src);
+   sp->flag = flag;
+   sp->cond = NULL;
+   sp->u = *ref;
+   sp->ntoks = 0;
+
+   if (src_stack->flag == CharSrc)
+      src_stack->u.cs->next_char = next_char;
+   sp->next = src_stack;
+   src_stack = sp;
+   }
+
+/*
+ * free_t - free a token.
+ */
+void free_t(t)
+struct token *t;
+   {
+   if (t != NULL)
+      free((char *)t);
+   }
+
+/*
+ * free_t_lst - free a token list.
+ */
+void free_t_lst(tlst)
+struct tok_lst *tlst;
+   {
+   if (tlst == NULL)
+      return;
+   free_t(tlst->t);
+   free_t_lst(tlst->next);
+   free((char *)tlst);
+   }
+
+/*
+ * free_id_lst - free an identifier list.
+ */
+void free_id_lst(ilst)
+struct id_lst *ilst;
+   {
+   if (ilst == NULL)
+       return;
+   free_id_lst(ilst->next);
+   free((char *)ilst);
+   }
+
+/*
+ * free_m - if there are no more pointers to this macro entry, free it
+ *  and other associated storage.
+ */
+void free_m(m)
+struct macro *m;
+   {
+   if (--m->ref_cnt != 0)
+      return;
+   free_id_lst(m->prmlst);
+   free_t_lst(m->body);
+   free((char *)m);
+   }
+
+/*
+ * free_m_lst - free a hash chain of macro symbol table entries.
+ */
+void free_m_lst(m)
+struct macro *m;
+   {
+   if (m == NULL)
+      return;
+   free_m_lst(m->next);
+   free_m(m);
+   }
+
+/*
+ * free_plsts - free an entry from a list of token lists used in
+ *  token pasting.
+ */
+void free_plsts(plsts)
+struct paste_lsts *plsts;
+   {
+   free((char *)plsts);
+   }
+
+/*
+ * rel_sbuf - free a string buffer.
+ */
+void rel_sbuf(sbuf)
+struct str_buf *sbuf;
+   {
+   free((char *)sbuf);
+   }
+
+/*
+ * pop_src - pop the top entry from the stack of tokens sources.
+ */
+void pop_src()
+   {
+   struct src *sp;
+   struct char_src *cs;
+   struct mac_expand *me;
+   int i;
+
+   if (src_stack->flag == DummySrc)
+      return; /* bottom of stack */
+
+   sp = src_stack;
+   src_stack = sp->next; /* pop */
+
+   /*
+    * If the new current source is a character source, reload global
+    *  variables used in tokenizing the characters.
+    */
+   if (src_stack->flag == CharSrc) {
+      first_char = src_stack->u.cs->char_buf;
+      next_char = src_stack->u.cs->next_char;
+      last_char = src_stack->u.cs->last_char;
+      }
+
+   /*
+    * Make sure there is no unclosed conditional compilation in the
+    *  source we are poping.
+    */
+   if (sp->cond != NULL)
+      errt2(sp->cond->t, "no matching #endif for #", sp->cond->t->image);
+
+   /*
+    * Free any storage that the stack entry still references.
+    */
+   switch (sp->flag) {
+      case CharSrc:
+         cs = sp->u.cs;
+         if (cs->f != NULL)
+            fclose(cs->f);
+         free((char *)cs);
+         break;
+      case MacExpand:
+         me = sp->u.me;
+         if (me->args != NULL) {
+            for (i = 0; i < me->m->category; i++) {
+               free_t_lst(me->args[i]);
+               free_t_lst(me->exp_args[i]);
+               }
+            free((char *)me->args);
+            free((char *)me->exp_args);
+            }
+         --me->m->recurse;
+         free_m(me->m);
+         free((char *)me);
+         break;
+      }
+
+   /*
+    * Free the stack entry.
+    */
+   free((char *)sp);
+   }
diff --git a/src/preproc/pout.c b/src/preproc/pout.c
new file mode 100644
index 0000000..4f5fc32
--- /dev/null
+++ b/src/preproc/pout.c
@@ -0,0 +1,230 @@
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+#include "../preproc/pproto.h"
+
+int line_cntrl;
+
+/*
+ * output - output preprocessed tokens for the current file.
+ */
+void output(out_file)
+FILE *out_file;
+   {
+   struct token *t, *t1;
+   struct token *saved_whsp;
+   char *fname;
+   char *s;
+   int line;
+   int nxt_line;
+   int trail_nl;  /* flag: trailing character in output is a new-line */
+   int  blank_ln;  /* flag: output ends with blank line */
+
+   fname = "";
+   line = -1;
+
+   /*
+    * Suppress an initial new-line in the output.
+    */
+   trail_nl = 1;
+   blank_ln = 1;
+
+   while ((t = preproc()) != NULL) {
+      if (t->flag & LineChk) {
+         /*
+          * This token is significant with respect to outputting #line
+          *  directives.
+          */
+         nxt_line = t->line;
+         if (fname != t->fname  || line != nxt_line) {
+            /*
+             * We need a #line directive. Make sure it is preceeded by a
+             *  blank line.
+             */
+            if (!trail_nl) {
+               putc('\n', out_file);
+               ++line;
+               trail_nl = 1;
+               }
+            if (!blank_ln && (line != nxt_line || fname != t->fname)) {
+               putc('\n', out_file);
+               ++line;
+               blank_ln = 1;
+               }
+            /*
+             * Eliminate extra new-lines from the subsequent text before
+             *  inserting line directive. This make the output look better.
+             *  The line number for the directive will change if new-lines
+             *  are eliminated.
+             */
+            saved_whsp = NULL;
+            s = t->image;
+            while (t->tok_id == WhiteSpace && (*s == ' ' || *s == '\n' ||
+                 *s == '\t')) {
+               if (*s == '\n') {
+                  /*
+                   * Discard any white space before the new-line and update
+                   *  the line number.
+                   */
+                  free_t(saved_whsp);
+                  saved_whsp = NULL;
+                  t->image = s + 1;
+                  ++t->line;
+                  ++nxt_line;
+                  }
+               ++s;
+               if (*s == '\0') {
+                  /*
+                   * The end of the current white space token has been
+                   *  reached, see if the next token is also white space.
+                   */
+                  free_t(saved_whsp);
+                  t1 = preproc();
+                  if (t1 == NULL) {
+                     /*
+                      * We are at the end of the input. Don't output
+                      *  a #line directive, just make sure the output
+                      *  ends with a new-line.
+                      */
+                     free_t(t);
+                     if (!trail_nl)
+                        putc('\n', out_file);
+                     return;
+                     }
+                  /*
+                   * The previous token may contain non-new-line white
+                   *  space, if the new token is on the same line, save
+                   *  that previous token in case we want to print the
+                   *  white space (this will correctly indent the new
+                   *  token).
+                   */
+                  if (*(t->image) != '\0' && t->line == t1->line &&
+                       t->fname == t1->fname)
+                     saved_whsp = t;
+                  else {
+                     free_t(t);
+                     saved_whsp = NULL;
+                     }
+                  t = t1;
+                  s = t->image;
+                  nxt_line = t->line;
+                  }
+               }
+            if (line_cntrl) {
+               /*
+                * We are supposed to insert #line directives where needed.
+                *  However, one or two blank lines look better when they
+                *  are enough to reestablish the correct line number.
+                */
+               if (fname != t->fname  || line > nxt_line ||
+                    line + 2 < nxt_line) {
+                  /*
+                   * Normally a blank line is put after the #line
+                   *  directive; However, this requires decrementing
+                   *  the line number and a line number of 0 is not
+                   *  valid.
+                   */
+                  if (nxt_line > 1)
+                     fprintf(out_file, "#line %d \"", nxt_line - 1);
+                  else
+                     fprintf(out_file, "#line %d \"", nxt_line);
+                  for (s = t->fname; *s != '\0'; ++s) {
+                     if (*s == '"' || *s == '\\')
+                        putc('\\',out_file);
+                     putc(*s, out_file);
+                     }
+                  fprintf(out_file, "\"\n");
+                  if (nxt_line > 1)
+                     fprintf(out_file, "\n"); /* blank line after directive */
+                  trail_nl = 1;
+                  blank_ln = 1;
+                  }
+               else  /* adjust line number with blank lines */
+                  while (line < nxt_line) {
+                     putc('\n', out_file);
+                     ++line;
+                     if (trail_nl)
+                        blank_ln = 1;
+                     trail_nl = 1;
+                     }
+               }
+            /*
+             * See if we need to indent the next token with white space
+             *  saved while eliminating extra new-lines.
+             */
+            if (saved_whsp != NULL) {
+               fprintf(out_file, "%s", saved_whsp->image);
+               free_t(saved_whsp);
+               if (trail_nl) {
+                  blank_ln = 1;
+                  trail_nl = 0;
+                  }
+               }
+            line = t->line;
+            fname = t->fname;
+            }
+         }
+
+      /*
+       * Print the image of the token.
+       */
+      if (t->tok_id == WhiteSpace) {
+         /*
+          * Keep track of trailing blank lines and new-lines. This
+          *  information is used to make the insertion of #line
+          *  directives more intelligent and to insure that the output
+          *  file ends with a new-line.
+          */
+         for (s = t->image; *s != '\0'; ++s) {
+            putc(*s, out_file);
+            switch (*s) {
+               case '\n':
+                  if (trail_nl)
+                     blank_ln = 1;
+                  trail_nl = 1;
+                  ++line;
+                  break;
+
+               case ' ':
+               case '\t':
+                  if (trail_nl)
+                     blank_ln = 1;
+                  trail_nl = 0;
+                  break;
+
+               default:
+                  trail_nl = 0;
+               }
+            }
+         }
+      else {
+         /*
+          * Add delimiters to string and character literals.
+          */
+         switch (t->tok_id) {
+            case StrLit:
+               fprintf(out_file, "\"%s\"", t->image);
+               break;
+            case LStrLit:
+               fprintf(out_file, "L\"%s\"", t->image);
+               break;
+            case CharConst:
+               fprintf(out_file, "'%s'", t->image);
+               break;
+            case LCharConst:
+               fprintf(out_file, "L'%s'", t->image);
+               break;
+            default:
+               fprintf(out_file, "%s", t->image);
+            }
+         trail_nl = 0;
+         blank_ln = 0;
+         }
+      free_t(t);
+      }
+
+   /*
+    * Make sure output file ends with a new-line.
+    */
+   if (!trail_nl)
+      putc('\n', out_file);
+   }
diff --git a/src/preproc/pproto.h b/src/preproc/pproto.h
new file mode 100644
index 0000000..492b7cb
--- /dev/null
+++ b/src/preproc/pproto.h
@@ -0,0 +1,64 @@
+void            addrmlst     (char *fname, FILE *f);
+void            advance_tok  (struct token **tp);
+int                chk_eq_sign  (void);
+long               conditional  (struct token **tp, struct token *trigger);
+struct token      *copy_t       (struct token *t);
+void            err1         (char *s);
+void            err2         (char *s1, char *s2);
+void            errfl1       (char *f, int l, char *s);
+void            errfl2       (char *f, int l, char *s1, char *s2);
+void            errfl3       (char *f, int l, char *s1, char *s2, char *s3);
+void            errt1        (struct token *t, char *s);
+void            errt2        (struct token *t, char *s1, char *s2);
+void            errt3        (struct token *t, char *s1, char *s2, char *s3);
+int                eval         (struct token *trigger);
+void            fill_cbuf    (void);
+void            free_id_lst  (struct id_lst *ilst);
+void            free_plsts   (struct paste_lsts *plsts);
+void            free_m       (struct macro *m);
+void            free_m_lst   (struct macro *m);
+void            free_t       (struct token *t);
+void            free_t_lst   (struct tok_lst *tlst);
+struct str_buf    *get_sbuf     (void);
+void            include      (struct token *trigger, char *fname, int start);
+void	init_files	(char *opt_lst,char * *opt_args);
+void	init_files	(char *opt_lst,char * *opt_args);
+void            init_macro   (void);
+void            init_preproc (char *fname, char *opt_lst, char **opt_args);
+void            init_sys     (char *fname, int argc, char *argv[]);
+void            init_tok     (void);
+struct token      *interp_dir   (void);
+struct token      *mac_tok      (void);
+void            merge_whsp   (struct token **whsp, struct token **next_t,
+                                  struct token *(*t_src)(void));
+void            m_delete     (struct token *mname);
+void            m_install    (struct token *mname, int category,
+                                  int multi_line, struct id_lst *prmlst,
+                                  struct tok_lst *body);
+struct macro      *m_lookup     (struct token *mname);
+struct char_src   *new_cs       (char *fname, FILE *f, int bufsize);
+struct id_lst     *new_id_lst   (char *id);
+struct macro      *new_macro    (char *mname, int category,
+                                  int multi_line, struct id_lst *prmlst,
+                                  struct tok_lst *body);
+struct mac_expand *new_me       (struct macro *m, struct tok_lst **args,
+                                   struct tok_lst **exp_args);
+struct paste_lsts *new_plsts    (struct token *trigger,
+                                  struct tok_lst *tlst,
+                                  struct paste_lsts *plst);
+struct token      *new_token    (int id, char *image, char *fname,
+                                  int line);
+struct tok_lst    *new_t_lst    (struct token *tok);
+struct token      *next_tok     (void);
+void            nxt_non_wh   (struct token **tp);
+void            output       (FILE *out_file);
+struct token      *paste        (void);
+void            pop_src      (void);
+struct token      *preproc      (void);
+void            push_src     (int flag, union src_ref *ref);
+void            rel_sbuf     (struct str_buf *sbuf);
+int                rt_state     (int tok_id);
+void            show_usage   (void);
+void            source       (char *fname);
+void            str_src      (char *src_name, char *s, int len);
+struct token      *tokenize     (void);
diff --git a/src/preproc/preproc.c b/src/preproc/preproc.c
new file mode 100644
index 0000000..01fb97c
--- /dev/null
+++ b/src/preproc/preproc.c
@@ -0,0 +1,991 @@
+/*
+ * The functions in this file handle preprocessing directives, macro
+ *  calls, and string concatenation.
+ */
+#include "../preproc/preproc.h"
+#include "../preproc/ptoken.h"
+#include "../preproc/pproto.h"
+
+/*
+ * Prototypes for static functions.
+ */
+static void start_select (struct token *t);
+static void end_select   (struct token *t);
+static void incl_file    (struct token *t);
+static void define       (struct token *t);
+static int     expand       (struct token *t, struct macro *m);
+static void toks_to_str  (struct str_buf *sbuf, struct token *t);
+
+/*
+ * start_select - handle #if, #ifdef, #ifndef
+ */
+static void start_select(t)
+struct token *t;
+   {
+   struct token *t1;
+   struct tok_lst *tlst;
+   int condition;
+   int nesting;
+
+   /*
+    * determine if condition is true.
+    */
+   if (t->tok_id == PpIf)
+      condition = eval(t);  /* #if - evaluate expression */
+   else {
+      /*
+       * #ifdef or #ifndef - see if an identifier is defined.
+       */
+      t1 = NULL;
+      nxt_non_wh(&t1);
+      if (t1->tok_id != Identifier)
+         errt2(t1, "identifier must follow #", t->image);
+      condition = (m_lookup(t1) == NULL) ? 0 : 1;
+      if (t->tok_id == PpIfndef)
+         condition = !condition;
+      free_t(t1);
+      t1 = next_tok();
+      if (t1->tok_id != PpDirEnd)
+         errt2(t1, "expecting end of line following argument to #", t->image);
+      free_t(t1);
+      }
+
+   /*
+    * look for the branch of the conditional inclusion to take or #endif.
+    */
+   nesting = 0;
+   while (!condition) {
+      t1 = next_tok();
+      if (t1 == NULL)
+        errt2(t, "no matching #endif for #", t->image);
+      switch (t1->tok_id) {
+         case PpIf:
+         case PpIfdef:
+         case PpIfndef:
+            /*
+             * Nested #if, #ifdef, or #ifndef in a branch of a conditional
+             *  that is being discarded. Contunue discarding until the
+             *  nesting level returns to 0.
+             */
+            ++nesting;
+            break;
+
+         case PpEndif:
+            /*
+             * #endif found. See if this is this the end of a nested
+             *  conditional or the end of the conditional we are processing.
+             */
+            if (nesting > 0)
+              --nesting;
+            else {
+               /*
+                * Discard any extraneous tokens on the end of the directive.
+                */
+               while (t->tok_id != PpDirEnd) {
+                  free_t(t);
+                  t = next_tok();
+                  }
+               free_t(t);
+               free_t(t1);
+               return;
+               }
+            break;
+
+         case PpElif:
+            /*
+             * #elif found. If this is not a nested conditional, see if
+             *   it has a true condition.
+             */
+            if (nesting == 0) {
+               free_t(t);
+               t = t1;
+               t1 = NULL;
+               condition = eval(t);
+               }
+            break;
+
+         case PpElse:
+            /*
+             * #else found. If this is not a nested conditional, take
+             *  this branch.
+             */
+            if (nesting == 0) {
+               free_t(t);
+               t = t1;
+               t1 = next_tok();
+               /*
+                * Discard any extraneous tokens on the end of the directive.
+                */
+               while (t1->tok_id != PpDirEnd) {
+                  free_t(t1);
+                  t1 = next_tok();
+                  }
+               condition = 1;
+               }
+         }
+      free_t(t1);
+      }
+   tlst = new_t_lst(t);
+   tlst->next = src_stack->cond;
+   src_stack->cond = tlst;
+   }
+
+/*
+ * end_select - handle #elif, #else, and #endif
+ */
+static void end_select(t)
+struct token *t;
+   {
+   struct tok_lst *tlst;
+   struct token *t1;
+   int nesting;
+
+   /*
+    * Make sure we are processing conditional compilation and pop it
+    *  from the list of conditional nesting.
+    */
+   tlst = src_stack->cond;
+   if (tlst == NULL)
+      errt2(t, "invalid context for #", t->image);
+   src_stack->cond = tlst->next;
+   tlst->next = NULL;
+   free_t_lst(tlst);
+
+   /*
+    * We are done with the selected branch for the conditional compilation.
+    *  Skip to the matching #endif (if we are not already there). Don't
+    *  be confused by nested conditionals.
+    */
+   nesting = 0;
+   t1 = copy_t(t);
+   while (t1->tok_id != PpEndif || nesting > 0) {
+      switch (t1->tok_id) {
+         case PpIf:
+         case PpIfdef:
+         case PpIfndef:
+            ++nesting;
+            break;
+
+         case PpEndif:
+            --nesting;
+         }
+      free_t(t1);
+      t1 = next_tok();
+      if (t1 == NULL)
+        errt2(t, "no matching #endif for #", t->image);
+      }
+   free_t(t);
+
+   /*
+    * Discard any extraneous tokens on the end of the #endif directive.
+    */
+   while (t1->tok_id != PpDirEnd) {
+      free_t(t1);
+      t1 = next_tok();
+      }
+   free_t(t1);
+   return;
+   }
+
+/*
+ * incl_file - handle #include
+ */
+static void incl_file(t)
+struct token *t;
+   {
+   struct token *file_tok, *t1;
+   struct str_buf *sbuf;
+   char *s;
+   char *fname;
+   int line;
+
+   file_tok = NULL;
+   advance_tok(&file_tok);
+
+   /*
+    * Determine what form the head file name takes.
+    */
+   if (file_tok->tok_id != StrLit && file_tok->tok_id != PpHeader) {
+      /*
+       * see if macro expansion created a name of the form <...>
+       */
+      t1 = file_tok;
+      s = t1->image;
+      fname = t1->fname;
+      line = t1->line;
+      if (*s != '<')
+         errt1(t1, "invalid include file syntax");
+      ++s;
+
+      /*
+       * Gather into a string buffer the characters from subsequent tokens
+       *  until the closing '>' is found, then create a "header" token
+       *  from it.
+       */
+      sbuf = get_sbuf();
+      while (*s != '>') {
+         while (*s != '\0' && *s != '>')
+            AppChar(*sbuf, *s++);
+         if (*s == '\0') {
+            switch (t1->tok_id) {
+               case StrLit:
+               case LStrLit:
+                  AppChar(*sbuf, '"');
+                  break;
+               case CharConst:
+               case LCharConst:
+                  AppChar(*sbuf, '\'');
+                  break;
+               }
+            free_t(t1);
+            t1 = interp_dir();
+            switch (t1->tok_id) {
+               case StrLit:
+                  AppChar(*sbuf, '"');
+                  break;
+               case LStrLit:
+                  AppChar(*sbuf, 'L');
+                  AppChar(*sbuf, '"');
+                  break;
+               case CharConst:
+                  AppChar(*sbuf, '\'');
+                  break;
+               case LCharConst:
+                  AppChar(*sbuf, 'L');
+                  AppChar(*sbuf, '\'');
+                  break;
+               case PpDirEnd:
+                  errt1(t1, "invalid include file syntax");
+               }
+            if (t1->tok_id == WhiteSpace)
+               AppChar(*sbuf, ' ');
+            else
+               s = t1->image;
+            }
+         }
+      if (*++s != '\0')
+         errt1(t1, "invalid include file syntax");
+      free_t(t1);
+      file_tok = new_token(PpHeader, str_install(sbuf), fname, line);
+      rel_sbuf(sbuf);
+      }
+
+   t1 = interp_dir();
+   if (t1->tok_id != PpDirEnd)
+      errt1(t1, "invalid include file syntax");
+   free_t(t1);
+
+   /*
+    * Add the file to the top of the token source stack.
+    */
+   if (file_tok->tok_id == StrLit)
+      include(t, file_tok->image, 0);
+   else
+      include(t, file_tok->image, 1);
+   free_t(file_tok);
+   free_t(t);
+   }
+
+/*
+ * define - handle #define and #begdef
+ */
+static void define(t)
+struct token *t;
+   {
+   struct token *mname;   /* name of macro */
+   int category;	  /* NoArgs for object-like macro, else number params */
+   int multi_line;
+   struct id_lst *prmlst; /* parameter list */
+   struct tok_lst *body;  /* replacement list */
+   struct token *t1;
+   struct id_lst **pilst;
+   struct tok_lst **ptlst;
+   int nesting;
+
+   /*
+    * Get the macro name.
+    */
+   mname = NULL;
+   nxt_non_wh(&mname);
+   if (mname->tok_id != Identifier)
+      errt2(mname, "syntax error in #", t->image);
+
+   /*
+    * Determine if this macro takes arguments.
+    */
+   prmlst = NULL;
+   t1 = next_tok();
+   if (t1->tok_id == '(') {
+      /*
+       * function like macro - gather parameter list
+       */
+      pilst = &prmlst;
+      nxt_non_wh(&t1);
+      if (t1->tok_id == Identifier) {
+         category = 1;
+         (*pilst) = new_id_lst(t1->image);
+         pilst = &(*pilst)->next;
+         nxt_non_wh(&t1);
+         while (t1->tok_id == ',') {
+            nxt_non_wh(&t1);
+            if (t1->tok_id != Identifier)
+               errt1(t1, "a parameter to a macro must be an identifier");
+            ++category;
+            (*pilst) = new_id_lst(t1->image);
+            pilst = &(*pilst)->next;
+            nxt_non_wh(&t1);
+            }
+         }
+      else
+         category = 0;
+      if (t1->tok_id != ')')
+         errt2(t1, "syntax error in #", t->image);
+      free_t(t1);
+      t1 = next_tok();
+      }
+   else
+      category = NoArgs; /* object-like macro */
+
+   /*
+    * Gather the body of the macro.
+    */
+   body = NULL;
+   ptlst = &body;
+   if (t->tok_id == PpDefine) {  /* #define */
+      multi_line = 0;
+      /*
+       * strip leading white space
+       */
+      while (t1->tok_id == WhiteSpace) {
+         free_t(t1);
+         t1 = next_tok();
+         }
+
+      while (t1->tok_id != PpDirEnd) {
+         /*
+          * Expansion of this type of macro does not trigger #line directives.
+          */
+         t1->flag &= ~LineChk;
+
+         (*ptlst) = new_t_lst(t1);
+         ptlst = &(*ptlst)->next;
+         t1 = next_tok();
+         }
+      }
+   else {
+      /*
+       *  #begdef
+       */
+      multi_line = 1;
+      if (t1->tok_id != PpDirEnd)
+         errt1(t1, "expecting new-line at end of #begdef");
+      free_t(t1);
+
+      /*
+       * Gather tokens until #enddef. Nested #begdef-#enddefs are put
+       *  in this macro and not processed until the macro is expanded.
+       */
+      nesting = 0;
+      t1 = next_tok();
+      while (t1 != NULL && (nesting > 0 || t1->tok_id != PpEnddef)) {
+         if (t1->tok_id == PpBegdef)
+            ++nesting;
+         else if (t1->tok_id == PpEnddef)
+            --nesting;
+         (*ptlst) = new_t_lst(t1);
+         ptlst = &(*ptlst)->next;
+         t1 = next_tok();
+         }
+      if (t1 == NULL)
+         errt1(t, "unexpected end-of-file in #begdef");
+      free_t(t1);
+      t1 = next_tok();
+      if (t1->tok_id != PpDirEnd)
+         errt1(t1, "expecting new-line at end of #enddef");
+      }
+   free_t(t1);
+   free_t(t);
+
+   /*
+    * Install the macro in the macro symbol table.
+    */
+   m_install(mname, category, multi_line, prmlst, body);
+   free_t(mname);
+   }
+
+/*
+ * expand - add expansion of macro to source stack.
+ */
+static int expand(t, m)
+struct token *t;
+struct macro *m;
+   {
+   struct token *t1 = NULL;
+   struct token *t2;
+   struct token *whsp = NULL;
+   union src_ref ref;
+   struct tok_lst **args, **exp_args;
+   struct tok_lst **tlp, **trail_whsp;
+   struct src *stack_sav;
+   int nparm;
+   int narg;
+   int paren_nest;
+   int line;
+   char *fname;
+
+   ++m->ref_cnt;
+
+   args = NULL;
+   exp_args = NULL;
+   if (m->category >= 0) {
+      /*
+       * This macro requires an argument list. Gather it, if there is one.
+       */
+      nparm = m->category;
+      narg = 0;
+      merge_whsp(&whsp, &t1, next_tok);
+      if (t1 == NULL || t1->tok_id != '(') {
+         /*
+          * There is no argument list. Do not expand the macro, just push
+          *  back the tokens we read ahead.
+          */
+         if (t1 != NULL)
+            src_stack->toks[src_stack->ntoks++] = t1;
+         if (whsp != NULL)
+            src_stack->toks[src_stack->ntoks++] = whsp;
+         --m->ref_cnt;
+         return 0;
+         }
+      free_t(whsp);
+
+      /*
+       * See how many arguments we expect.
+       */
+      if (nparm == 0)
+         nxt_non_wh(&t1);
+      else {
+         /*
+          * Allocate an array for both raw and macro-expanded token lists
+          *  for the arguments.
+          */
+         args = alloc(nparm * sizeof(struct tok_lst *));
+         exp_args = alloc(nparm * sizeof(struct tok_lst *));
+
+         /*
+          * Gather the tokens for each argument.
+          */
+         paren_nest = 0;
+         for ( ; narg < nparm && t1 != NULL && t1->tok_id != ')'; ++narg) {
+            /*
+             * Strip leading white space from the argument.
+             */
+            nxt_non_wh(&t1);
+            tlp = &args[narg];  /* location of raw token list for this arg */
+            *tlp = NULL;
+            trail_whsp = NULL;
+            /*
+             * Gather tokens for this argument.
+             */
+            while (t1 != NULL && (paren_nest > 0 || (t1->tok_id != ',' &&
+                 t1->tok_id != ')'))) {
+               if (t1->tok_id == '(')
+                  ++paren_nest;
+               if (t1->tok_id == ')')
+                  --paren_nest;
+               t1->flag &= ~LineChk;
+
+               /*
+                * Link this token into the list for the argument. If this
+                *  might be trailing white space, remember where the pointer
+                *  to it is so it can be discarded later.
+                */
+               *tlp = new_t_lst(t1);
+               if (t1->tok_id == WhiteSpace) {
+                  if (trail_whsp == NULL)
+                     trail_whsp = tlp;
+                  }
+               else
+                  trail_whsp = NULL;
+               tlp = &(*tlp)->next;
+               t1 = next_tok();
+               }
+            /*
+             * strip trailing white space
+             */
+            if (trail_whsp != NULL) {
+               free_t_lst(*trail_whsp);
+               *trail_whsp = NULL;
+               }
+
+            /*
+             * Create a macro expanded token list for the argument. This is
+             *  done by establishing a separate preprocessing context with
+             *  a new source stack. The current stack must be be saved and
+             *  restored.
+             */
+            tlp = &exp_args[narg]; /* location of expanded token list for arg */
+            *tlp = NULL;
+            if (src_stack->flag == CharSrc)
+               src_stack->u.cs->next_char = next_char; /* save state */
+            stack_sav = src_stack;
+            src_stack = &dummy;
+            ref.tlst = args[narg];
+            push_src(TokLst, &ref); /* initial stack is list of raw tokens */
+            /*
+             * Get macro expanded tokens.
+             */
+            for (t2 = interp_dir(); t2 != NULL; t2 = interp_dir()) {
+               *tlp = new_t_lst(t2);
+               tlp = &(*tlp)->next;
+               }
+            src_stack = stack_sav;
+            if (src_stack->flag == CharSrc) {
+               /*
+                * Restore global state for tokenizing.
+                */
+               first_char = src_stack->u.cs->char_buf;
+               next_char = src_stack->u.cs->next_char;
+               last_char = src_stack->u.cs->last_char;
+               }
+            }
+         }
+      if (t1 == NULL)
+         errt2(t, "unexpected end-of-file in call to macro ", t->image);
+      if (t1->tok_id != ')')
+         errt2(t1, "too many arguments for macro call to ", t->image);
+      if (narg < nparm)
+         errt2(t1, "too few arguments for macro call to ", t->image);
+      free_t(t1);
+      }
+
+   ++m->recurse;
+   ref.me = new_me(m, args, exp_args);
+   push_src(MacExpand, &ref);
+   /*
+    * Don't loose generation of #line directive before regular
+    *  macros, if there should be one.
+    */
+   if (!m->multi_line && (t->flag & LineChk)) {
+      line = t->line;
+      fname = t->fname;
+      t1 = next_tok();
+      if (t1 != NULL) {
+         if (!(t1->flag & LineChk)) {
+            t1->flag |= LineChk;
+            t1->line = line;
+            t1->fname = fname;
+            }
+         src_stack->toks[src_stack->ntoks++] = t1;
+         }
+      }
+   return 1;
+   }
+
+/*
+ * toks_to_str - put in a buffer the string image of tokens up to the end of
+ *    of a preprocessor directive.
+ */
+static void toks_to_str(sbuf, t)
+struct str_buf *sbuf;
+struct token *t;
+   {
+   char *s;
+
+   while (t->tok_id != PpDirEnd) {
+      if (t->tok_id == WhiteSpace)
+         AppChar(*sbuf, ' ');
+      else {
+         if (t->tok_id == LCharConst || t->tok_id == LStrLit)
+            AppChar(*sbuf, 'L');
+         if (t->tok_id == CharConst || t->tok_id == LCharConst)
+            AppChar(*sbuf, '\'');
+         else if (t->tok_id == StrLit || t->tok_id == LStrLit)
+            AppChar(*sbuf, '"');
+         for (s = t->image; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+         if (t->tok_id == CharConst || t->tok_id == LCharConst)
+            AppChar(*sbuf, '\'');
+         else if (t->tok_id == StrLit || t->tok_id == LStrLit)
+            AppChar(*sbuf, '"');
+         }
+      free_t(t);
+      t = next_tok();
+      }
+   free_t(t);
+   }
+
+/*
+ * interp_dir - interpret preprocessing directives and recognize macro calls.
+ */
+struct token *interp_dir()
+   {
+   struct token *t, *t1;
+   struct macro *m;
+   struct str_buf *sbuf;
+   char *s;
+
+   /*
+    * See if the caller pushed back any tokens
+    */
+   if (src_stack->ntoks > 0)
+      return src_stack->toks[--src_stack->ntoks];
+
+   for (;;) {
+      t = next_tok();
+      if (t == NULL)
+          return NULL;
+
+      switch (t->tok_id) {
+         case PpIf:          /* #if */
+         case PpIfdef:       /* #ifdef */
+         case PpIfndef:      /* #endif */
+            start_select(t);
+            break;
+
+         case PpElif:        /* #elif */
+         case PpElse:        /* #else */
+         case PpEndif:       /* #endif */
+            end_select(t);
+            break;
+
+         case PpInclude:     /* #include */
+            incl_file(t);
+            break;
+
+         case PpDefine:      /* #define */
+         case PpBegdef:      /* #begdef */
+            define(t);
+            break;
+
+         case PpEnddef:      /* #endif, but we have not seen an #begdef */
+            errt1(t, "invalid context for #enddef");
+
+         case PpUndef:       /* #undef */
+            /*
+             * Get the identifier and delete it from the macro symbol table.
+             */
+            t1 = NULL;
+            nxt_non_wh(&t1);
+            if (t1->tok_id != Identifier)
+               errt1(t1, "#undef requires an identifier argument");
+            m_delete(t1);
+            free_t(t1);
+            t1 = next_tok();
+            if (t1->tok_id != PpDirEnd)
+               errt1(t1, "syntax error for #undef");
+            free_t(t1);
+            free_t(t);
+            break;
+
+         case PpLine:        /* #line */
+            /* this directive is handled in next_tok() */
+            break;
+
+         case PpError:       /* #error */
+            /*
+             * Create an error message out of the rest of the tokens
+             *  in this directive.
+             */
+            sbuf = get_sbuf();
+            t1 = NULL;
+            nxt_non_wh(&t1);
+            toks_to_str(sbuf, t1);
+            errt1(t, str_install(sbuf));
+            break;
+
+         case PpPragma:       /* #pramga */
+         case PpSkip:
+            /*
+             * Ignore all pragmas and all non-ANSI directives that need not
+             *   be passed to the caller.
+             */
+            t1 = next_tok();
+            while (t1->tok_id != PpDirEnd) {
+               free_t(t1);
+               t1 = next_tok();
+               }
+            free_t(t);
+            free_t(t1);
+            break;
+
+         case PpKeep:
+            /*
+             * This is a directive special to an application using
+             *  this preprocessor. Pass it on to the application.
+             */
+            sbuf = get_sbuf();
+            AppChar(*sbuf, '#');
+            for (s = t->image; *s != '\0'; ++s)
+               AppChar(*sbuf, *s);
+            toks_to_str(sbuf, next_tok());
+            t->image = str_install(sbuf);
+            rel_sbuf(sbuf);
+            return t;
+
+         case PpNull:         /* # */
+            free_t(t);
+            free_t(next_tok());   /* must be PpDirEnd */
+            break;
+
+         default:
+            /*
+             * This is not a directive, see if it is a macro name.
+             */
+            if (t->tok_id == Identifier && !(t->flag & NoExpand) &&
+                 (m = m_lookup(t)) != NULL) {
+               if (max_recurse < 0 || m->recurse < max_recurse) {
+                  if (expand(t, m))
+                     free_t(t);
+                  else
+                     return t;
+                  }
+               else {
+                  t->flag |= NoExpand;
+                  return t;
+                  }
+               }
+            else
+               return t; /* nothing special, just return it */
+         }
+      }
+   }
+
+/*
+ * See if compiler used to build the preprocessor recognizes '\a'
+ *  as the bell character.
+ */
+
+#if '\a' == Bell
+
+   #define TokSrc interp_dir
+
+#else					/* '\a' == Bell */
+
+   #define TokSrc check_bell
+
+   /*
+    * fix_bell - replace \a characters which correct octal escape sequences.
+    */
+   static char *fix_bell(s)
+   register char *s;
+      {
+      struct str_buf *sbuf;
+
+      sbuf = get_sbuf();
+      while (*s != '\0') {
+         AppChar(*sbuf, *s);
+         if (*s == '\\') {
+            ++s;
+            if (*s == 'a') {
+               AppChar(*sbuf, '0' + ((Bell >> 6) & 7));
+               AppChar(*sbuf, '0' + ((Bell >> 3) & 7));
+               AppChar(*sbuf, '0' + (Bell & 7));
+               }
+            else
+               AppChar(*sbuf, *s);
+            }
+         ++s;
+         }
+      s = str_install(sbuf);
+      rel_sbuf(sbuf);
+      return s;
+      }
+
+   /*
+    * check_bell - check for \a in character and string constants. This is only
+    *  used with compilers which don't give the standard interpretation to \a.
+    */
+   static struct token *check_bell()
+      {
+      struct token *t;
+      register char *s;
+
+      t = interp_dir();
+      if (t == NULL)
+         return NULL;
+      switch (t->tok_id) {
+         case StrLit:
+         case LStrLit:
+         case CharConst:
+         case LCharConst:
+            s = t->image;
+            while (*s != '\0') {
+              if (*s == '\\') {
+                 if (*++s == 'a') {
+                    /*
+                     * There is at least one \a to replace.
+                     */
+                    t->image = fix_bell(t->image);
+                    break;
+                    }
+                 }
+              ++s;
+              }
+         }
+      return t;
+      }
+
+#endif					/* '\a' == Bell */
+
+/*
+ * preproc - return the next fully preprocessed token.
+ */
+struct token *preproc()
+   {
+   struct token *t1, *whsp, *t2, *str;
+   struct str_buf *sbuf;
+   int i;
+   char *escape_seq;
+   char *s;
+   char hex_char;
+   int is_hex_char;
+
+   t1 = TokSrc();
+   if (t1 == NULL)
+      return NULL;  /* end of file */
+
+   /*
+    * Concatenate adjacent strings. There is a potential problem if the
+    *  first string ends in a octal or hex constant and the second string
+    *  starts with a corresponding digit. For example the strings "\12"
+    *  and  "7" should be concatenated to produce the 2 character string
+    *  "\0127" not the one character string "\127". When such a situation
+    *  arises, the last character of the first string is converted to a
+    *  canonical 3-digit octal form.
+    */
+   if (t1->tok_id == StrLit || t1->tok_id == LStrLit) {
+      /*
+       * See what the next non-white space token is, but don't discard any
+       *  white space yet.
+       */
+      whsp = NULL;
+      merge_whsp(&whsp, &t2, TokSrc);
+      if (t2 != NULL && (t2->tok_id == StrLit || t2->tok_id == LStrLit)) {
+         /*
+          * There are at least two adjacent string literals, concatenate them.
+          */
+         sbuf = get_sbuf();
+         str = copy_t(t1);
+         while (t2 != NULL && (t2->tok_id == StrLit || t2->tok_id == LStrLit)) {
+            s = t1->image;
+            while (*s != '\0') {
+               if (*s == '\\') {
+                  AppChar(*sbuf, *s);
+                  ++s;
+                  if (*s == 'x') {
+                     /*
+                      * Hex escape sequence.
+                      */
+                     hex_char = 0;
+                     escape_seq = s;
+                     ++s;
+                     is_hex_char = 1;
+                     while (is_hex_char) {
+                        if (*s >= '0' && *s <= '9')
+                           hex_char = (hex_char << 4) | (*s - '0');
+                        else switch (*s) {
+                           case 'a': case 'A':
+                              hex_char = (hex_char << 4) | 10;
+                              break;
+                           case 'b': case 'B':
+                              hex_char = (hex_char << 4) | 11;
+                              break;
+                           case 'c': case 'C':
+                              hex_char = (hex_char << 4) | 12;
+                              break;
+                           case 'd': case 'D':
+                              hex_char = (hex_char << 4) | 13;
+                              break;
+                           case 'e': case 'E':
+                              hex_char = (hex_char << 4) | 14;
+                              break;
+                           case 'f': case 'F':
+                              hex_char = (hex_char << 4) | 15;
+                              break;
+                           default: is_hex_char = 0;
+                           }
+                        if (is_hex_char)
+                           ++s;
+                        }
+                     /*
+                      * If this escape sequence is at the end of the
+                      *  string and the next string starts with a
+                      *  hex digit, use the canonical form, otherwise
+                      *  use it as is.
+                      */
+                     if (*s == '\0' && isxdigit(t2->image[0])) {
+                        AppChar(*sbuf, ((hex_char >> 6) & 03) + '0');
+                        AppChar(*sbuf, ((hex_char >> 3) & 07) + '0');
+                        AppChar(*sbuf, (hex_char        & 07) + '0');
+                        }
+                     else
+                        while (escape_seq != s)
+                           AppChar(*sbuf, *escape_seq++);
+                     }
+                  else if (*s >= '0' && *s <= '7') {
+                     /*
+                      * Octal escape sequence.
+                      */
+                     escape_seq = s;
+                     i = 1;
+                     while (i <= 3 && *s >= '0' && *s <= '7') {
+                        ++i;
+                        ++s;
+                        }
+                     /*
+                      * If this escape sequence is at the end of the
+                      *  string and the next string starts with an
+                      *  octal digit, extend it to 3 digits, otherwise
+                      *  use it as is.
+                      */
+                     if (*s == '\0' && t2->image[0] >= '0' &&
+                           t2->image[0] <= '7' && i <= 3) {
+                        AppChar(*sbuf, '0');
+                        if (i <= 2)
+                           AppChar(*sbuf, '0');
+                        }
+                     while (escape_seq != s)
+                        AppChar(*sbuf, *escape_seq++);
+                     }
+                  }
+               else {
+                  /*
+                   * Not an escape sequence, just copy the character to the
+                   *  buffer.
+                   */
+                  AppChar(*sbuf, *s);
+                  ++s;
+                  }
+               }
+            free_t(t1);
+            t1 = t2;
+
+            /*
+             * Get the next non-white space token, saving any skipped
+             *  white space.
+             */
+            merge_whsp(&whsp, &t2, TokSrc);
+            }
+
+         /*
+          * Copy the image of the last token into the buffer, creating
+          *  the image for the concatenated token.
+          */
+         for (s = t1->image; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+         str->image = str_install(sbuf);
+         free_t(t1);
+         t1 = str;
+         rel_sbuf(sbuf);
+         }
+
+      /*
+       * Push back any look-ahead tokens.
+       */
+      if (t2 != NULL)
+         src_stack->toks[src_stack->ntoks++] = t2;
+      if (whsp != NULL)
+         src_stack->toks[src_stack->ntoks++] = whsp;
+      }
+   return t1;
+   }
diff --git a/src/preproc/preproc.h b/src/preproc/preproc.h
new file mode 100644
index 0000000..8cc495f
--- /dev/null
+++ b/src/preproc/preproc.h
@@ -0,0 +1,202 @@
+#include "../h/gsupport.h"
+
+/*
+ * If Bell is not defined, determine the default value for the "bell"
+ *   character.
+ */
+#ifndef Bell
+#define Bell '\a'
+#endif					/* Bell */
+
+#define CBufSize 256  /* size of buffer for file input */
+
+/*
+ * Identification numbers for tokens for which there are no definitions
+ *   generated from a C grammar by yacc.
+ */
+#define WhiteSpace 1001   /* white space */
+#define PpNumber   1002   /* number (integer or real) */
+#define PpIf       1003   /* #if */
+#define PpElse     1004   /* #else */
+#define PpIfdef    1005   /* #ifdef */
+#define PpIfndef   1006   /* #ifndef */
+#define PpElif     1007   /* #elif */
+#define PpEndif    1008   /* #endif */
+#define PpInclude  1009   /* #include */
+#define PpDefine   1010   /* #define */
+#define PpUndef    1011   /* #undef */
+#define PpLine     1012   /* #line */
+#define PpError    1013   /* #error */
+#define PpPragma   1014   /* #pragma */
+#define PpPaste    1015   /* ## */
+#define PpDirEnd   1016   /* new-line terminating a directive */
+#define PpHeader   1017   /* <...> from #include */
+#define PpBegdef   1018   /* #begdef */
+#define PpEnddef   1019   /* #enddef */
+#define PpNull     1020   /* # */
+#define PpKeep     1021   /* directive specific to an application, pass along */
+#define PpSkip     1022   /* directive specific to an application discard */
+#define Invalid    9999   /* marker */
+
+extern char *progname; /* name of this program: for error messages */
+extern int line_cntrl; /* flag: are line directives needed in the output */
+
+/*
+ * whsp_image determines whether the spelling of white space is not retained,
+ *   is retained with each comment replaced by a space, or the full spelling
+ *   of white space and comments is retained.
+ */
+#define NoSpelling 0
+#define NoComment  1
+#define FullImage  2
+
+extern int whsp_image;
+
+extern int max_recurse;        /* how much recursion is allows in macros */
+extern struct token *zero_tok; /* token "0" */
+extern struct token *one_tok;  /* token "1" */
+
+extern int *first_char;        /* first character in tokenizing buffer */
+extern int *next_char;         /* next character in tokenizing buffer */
+extern int *last_char;         /* last character in tokenizing buffer */
+
+/*
+ * Entry in array of preprocessor directive names.
+ */
+struct rsrvd_wrd {
+   char *s;         /* name (without the #) */
+   int tok_id;      /* token id of directive */
+   };
+
+/*
+ * token flags:
+ */
+#define LineChk  0x1   /* A line directive may be needed in the output */
+#define NoExpand 0x2   /* Don't macro expand this identifier */
+
+/*
+ * Token.
+ */
+struct token {
+   int tok_id;		/* token identifier */
+   char *image;		/* string image of token */
+   char *fname;         /* file name of origin */
+   int line;            /* line number of origin */
+   int flag;            /* token flag, see above */
+   };
+
+/*
+ * Token list.
+ */
+struct tok_lst {
+   struct token *t;      /* token */
+   struct tok_lst *next; /* next entry in list */
+   };
+
+/*
+ * Identifier list.
+ */
+struct id_lst {
+   char *id;            /* identifier */
+   struct id_lst *next; /* next entry in list */
+   };
+
+/*
+ * a macro, m, falls into one of several categores:
+ *   those with arguments                - m.category = # args >= 0
+ *   those with no arguments             - m.category = NoArgs
+ *   those that may not be chaged        - m.category = FixedMac
+ *   those that require special handling - m.category = SpecMac
+ */
+#define NoArgs   -1
+#define FixedMac -2
+#define SpecMac  -3
+
+struct macro {
+   char *mname;
+   int category;
+   int multi_line;
+   struct id_lst *prmlst;
+   struct tok_lst *body;
+   int ref_cnt;
+   int recurse;
+   struct macro *next;
+   };
+
+/*
+ * states for recognizing preprocessor directives
+ */
+#define Reset    1
+#define CanStart 2   /* Just saw a new-line, look for a directive */
+#define Within   3   /* Next new-line ends directive */
+
+/*
+ * Information for a source of tokens created from a character stream.
+ *  The characters may come from a file, or they be in a prefilled buffer.
+ */
+struct char_src {
+   FILE *f;               /* file, if the chars come directly from a file */
+   char *fname;		  /* name of file */
+   int bufsize;		  /* size of character buffer */
+   int *char_buf;         /* pointer to character buffer */
+   int *line_buf;	  /* buffer of lines characters come from */
+   int *next_char;	  /* next unprocessed character in buffer */
+   int *last_char;	  /* last character in buffer */
+   int line_adj;	  /* line adjustment caused by #line directive */
+   int dir_state;	  /* state w.r.t. recognizing directives */
+   struct token *tok_sav; /* used to save token after look ahead */
+   };
+
+/*
+ * Information for a source of tokens dirived from expanding a macro.
+ */
+struct mac_expand {
+   struct macro *m;	      /* the macro being expanded */
+   struct tok_lst **args;     /* list of arguments for macro call */
+   struct tok_lst **exp_args; /* list of expanded arguments for macro call */
+   struct tok_lst *rest_bdy;  /* position within the body of the macro */
+   };
+
+/*
+ * Elements in a list of token lists used for token pasting.
+ */
+struct paste_lsts {
+   struct token *trigger;   /* the token pasting operator */
+   struct tok_lst *tlst;    /* the token list */
+   struct paste_lsts *next; /* the next element in the list of lists */
+};
+
+/*
+ * Pointers to various token sources.
+ */
+union src_ref {
+   struct char_src *cs;      /* source is tokenized characters */
+   struct mac_expand *me;    /* source is macro expansion */
+   struct tok_lst *tlst;     /* source is token list (a macro argument) */
+   struct paste_lsts *plsts; /* source is token lists for token pasting */
+   };
+
+/*
+ * Types of token sources:
+ */
+#define CharSrc   0     /* tokenized characters */
+#define MacExpand 1     /* macro expansion */
+#define TokLst    2     /* token list */
+#define PasteLsts 4	/* paste last token of 1st list to first of 2nd */
+#define DummySrc  5     /* base of stack */
+
+#define NTokSav  2      /* maximum number of tokens that can be pushed back */
+
+struct src {
+   int flag;			/* indicate what kind of source it is */
+   struct tok_lst *cond;	/* list of nested conditionals in effect */
+   struct token *toks[NTokSav];	/* token push-back stack for preproc() */
+   int ntoks;			/* number of tokens on stack */
+   struct src *next;		/* link for creating stack */
+   union src_ref u;             /* pointer to specific kind of source */
+   };
+
+extern struct src dummy;       /* base of stack */
+
+extern struct src *src_stack;  /* source stack */
+
diff --git a/src/preproc/ptoken.h b/src/preproc/ptoken.h
new file mode 100644
index 0000000..35cf2b3
--- /dev/null
+++ b/src/preproc/ptoken.h
@@ -0,0 +1,48 @@
+/*
+ * The #defines for tokens can be overridden by a -DTokDotH=... compiler
+ *  option. This specifies a file containing token #defines and is useful
+ *  for creating an embedded preprocessor where token definitions are
+ *  generated by yacc from a grammar.
+ *
+ * Otherwise, the default token definitions are RTT's; if NoRTT is
+ *  defined, then this file's definitions are used.
+ */
+#ifdef TokDotH
+#include TokDotH
+#else					/* TokDotH */
+#ifndef NoRTT
+#include "../rtt/ltoken.h"
+#else					/* RTT */
+/*
+ * These are the numbers for tokens (other than single characters) returned
+ *   by the preproccesor and seen by a yacc parser for a C grammar.
+ */
+#define And 257
+#define AndAsgn 258
+#define Arrow 259
+#define CharConst 260
+#define Decr 261
+#define DivAsgn 262
+#define Ellipsis 263
+#define TokEqual 264
+#define Geq 265
+#define Identifier 266
+#define Incr 267
+#define LCharConst 268
+#define LShft 269
+#define LShftAsgn 270
+#define LStrLit 271
+#define Leq 272
+#define MinusAsgn 273
+#define ModAsgn 274
+#define MultAsgn 275
+#define Neq 276
+#define Or 277
+#define OrAsgn 278
+#define PlusAsgn 279
+#define RShft 280
+#define RShftAsgn 281
+#define StrLit 282
+#define XorAsgn 283
+#endif					/* NoRTT */
+#endif					/* TokDotH */
diff --git a/src/rtt/Makefile b/src/rtt/Makefile
new file mode 100644
index 0000000..db6445e
--- /dev/null
+++ b/src/rtt/Makefile
@@ -0,0 +1,87 @@
+#  Makefile for the Icon run-time translator, rtt,
+#  which is used to build the Icon run-time system.
+
+include ../../Makedefs
+
+
+ROBJS = rttparse.o rttmain.o rttlex.o rttsym.o rttnode.o rttout.o rttmisc.o\
+	  rttdb.o rttinlin.o rttilc.o
+
+PP_DIR = ../preproc/
+P_DOT_H = $(PP_DIR)preproc.h $(PP_DIR)pproto.h ltoken.h ../h/mproto.h\
+        ../h/define.h ../h/config.h ../h/typedefs.h\
+        ../h/cstructs.h ../h/cpuconf.h
+POBJS = pout.o pchars.o  perr.o pmem.o  bldtok.o macro.o preproc.o\
+	evaluate.o files.o gettok.o pinit.o
+
+COBJS = ../common/getopt.o ../common/time.o ../common/filepart.o \
+	  ../common/identify.o ../common/strtbl.o ../common/alloc.o \
+	  ../common/rtdb.o ../common/munix.o ../common/literals.o
+
+OBJ = $(ROBJS) $(POBJS) $(COBJS)
+
+
+rtt:	$(OBJ)
+	$(CC) $(LDFLAGS) -o rtt $(OBJ)
+	cp rtt ../../bin
+	strip ../../bin/rtt$(EXE)
+
+library:	$(OBJ)
+		rm -rf rtt.a
+		ar qc rtt.a $(OBJ)
+
+$(COBJS):
+	cd ../common; $(MAKE)
+
+$(ROBJS): rtt.h rtt1.h rttproto.h $(P_DOT_H)
+
+rttdb.o: ../h/version.h
+rttparse.o : ../h/gsupport.h ../h/config.h ../h/cstructs.h \
+	../h/mproto.h ../h/typedefs.h ../h/cpuconf.h ../h/define.h
+
+pout.o: $(PP_DIR)pout.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)pout.c 
+
+pchars.o: $(PP_DIR)pchars.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)pchars.c 
+
+perr.o: $(PP_DIR)perr.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)perr.c
+
+pmem.o: $(PP_DIR)pmem.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)pmem.c
+
+bldtok.o: $(PP_DIR)bldtok.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)bldtok.c
+
+macro.o: $(PP_DIR)macro.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)macro.c
+
+preproc.o: $(PP_DIR)preproc.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)preproc.c
+
+evaluate.o: $(PP_DIR)evaluate.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)evaluate.c
+
+files.o: $(PP_DIR)files.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)files.c
+
+gettok.o: $(PP_DIR)gettok.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)gettok.c
+
+pinit.o: $(PP_DIR)pinit.c $(P_DOT_H)
+	$(CC) -c $(CFLAGS) $(PP_DIR)pinit.c
+
+#
+# The following entry is commented out because it is not normally
+# necessary to recreate rttparse.c and ltoken.h unless the grammar
+# in rttgram.y for the run-time langauge is changed. Recreating these
+# files is not normally a part of the installation process. Note that
+# on some systems, yacc may not have large enough internal tables to
+# translate this grammar.
+#
+#rttparse.c ltoken.h: rttgram.y
+#	yacc -d rttgram.y
+#	fgrep -v -x "extern char *malloc(), *realloc();" y.tab.c > rttparse.c
+#	rm y.tab.c
+#	mv y.tab.h ltoken.h
diff --git a/src/rtt/ltoken.h b/src/rtt/ltoken.h
new file mode 100644
index 0000000..d426fcf
--- /dev/null
+++ b/src/rtt/ltoken.h
@@ -0,0 +1,117 @@
+
+typedef union  {
+   struct token *t;
+   struct node *n;
+   long i;
+   } YYSTYPE;
+extern YYSTYPE yylval;
+# define Identifier 257
+# define StrLit 258
+# define LStrLit 259
+# define FltConst 260
+# define DblConst 261
+# define LDblConst 262
+# define CharConst 263
+# define LCharConst 264
+# define IntConst 265
+# define UIntConst 266
+# define LIntConst 267
+# define ULIntConst 268
+# define Arrow 269
+# define Incr 270
+# define Decr 271
+# define LShft 272
+# define RShft 273
+# define Leq 274
+# define Geq 275
+# define TokEqual 276
+# define Neq 277
+# define And 278
+# define Or 279
+# define MultAsgn 280
+# define DivAsgn 281
+# define ModAsgn 282
+# define PlusAsgn 283
+# define MinusAsgn 284
+# define LShftAsgn 285
+# define RShftAsgn 286
+# define AndAsgn 287
+# define XorAsgn 288
+# define OrAsgn 289
+# define Sizeof 290
+# define Intersect 291
+# define OpSym 292
+# define Typedef 293
+# define Extern 294
+# define Static 295
+# define Auto 296
+# define TokRegister 297
+# define Tended 298
+# define TokChar 299
+# define TokShort 300
+# define Int 301
+# define TokLong 302
+# define Signed 303
+# define Unsigned 304
+# define Float 305
+# define Doubl 306
+# define Const 307
+# define Volatile 308
+# define Void 309
+# define TypeDefName 310
+# define Struct 311
+# define Union 312
+# define TokEnum 313
+# define Ellipsis 314
+# define Case 315
+# define Default 316
+# define If 317
+# define Else 318
+# define Switch 319
+# define While 320
+# define Do 321
+# define For 322
+# define Goto 323
+# define Continue 324
+# define Break 325
+# define Return 326
+# define Runerr 327
+# define Is 328
+# define Cnv 329
+# define Def 330
+# define Exact 331
+# define Empty_type 332
+# define IconType 333
+# define Component 334
+# define Variable 335
+# define Any_value 336
+# define Named_var 337
+# define Struct_var 338
+# define C_Integer 339
+# define Arith_case 340
+# define C_Double 341
+# define C_String 342
+# define Tmp_string 343
+# define Tmp_cset 344
+# define Body 345
+# define End 346
+# define TokFunction 347
+# define Keyword 348
+# define Operator 349
+# define Underef 350
+# define Declare 351
+# define Suspend 352
+# define Fail 353
+# define Inline 354
+# define Abstract 355
+# define Store 356
+# define TokType 357
+# define New 358
+# define All_fields 359
+# define Then 360
+# define Type_case 361
+# define Of 362
+# define Len_case 363
+# define Constant 364
+# define Errorfail 365
+# define IfStmt 366
diff --git a/src/rtt/rtt.h b/src/rtt/rtt.h
new file mode 100644
index 0000000..78ac812
--- /dev/null
+++ b/src/rtt/rtt.h
@@ -0,0 +1,2 @@
+#include "ltoken.h"
+#include "rtt1.h"
diff --git a/src/rtt/rtt1.h b/src/rtt/rtt1.h
new file mode 100644
index 0000000..76779c7
--- /dev/null
+++ b/src/rtt/rtt1.h
@@ -0,0 +1,187 @@
+#include "../preproc/preproc.h"
+#include "../preproc/pproto.h"
+
+#define IndentInc 3
+#define MaxCol 80
+
+#define Max(x,y)        ((x)>(y)?(x):(y))
+
+/*
+ * cfile is used to create a list of cfiles created from a source file.
+ */
+struct cfile {
+   char *name;
+   struct cfile *next;
+   };
+
+/*
+ * srcfile is an entry of dependants of a source file.
+ */
+struct srcfile {
+   char *name;
+   struct cfile *dependents;
+   struct srcfile *next;
+   };
+
+#define ForceNl() nl = 1;
+extern int nl;  /* flag: a new-line is needed in the output */
+
+/*
+ * The lexical analyzer recognizes 3 states. Operators are treated differently
+ *  in each state.
+ */
+#define DfltLex  0    /* Covers most input. */
+#define OpHead   1    /* In head of an operator definition. */
+#define TypeComp 2    /* In abstract type computation */
+
+extern int lex_state;      /* state of operator recognition */
+extern char *compiler_def; /* #define for COMPILER */
+extern FILE *out_file;     /* output file */
+extern int def_fnd;        /* C input defines something concrete */
+extern char *inclname;     /* include file to be included by C compiler */
+extern int iconx_flg;      /* flag: indicate that iconx style code is needed */
+extern int enable_out;     /* enable output of C code */
+extern char *largeints;    /* "Largeints" or "NoLargeInts" */
+
+/*
+ * The symbol table is used by the lexical analyser to decide whether an
+ *  identifier is an ordinary identifier, a typedef name, or a reserved
+ *  word. It is used by the parse tree builder to decide whether an
+ *  identifier is an ordinary C variable, a tended variable, a parameter
+ *  to a run-time routine, or the special variable "result".
+ */
+struct sym_entry {
+   int tok_id;	       /* Ident, TokType, or identification of reserved word */
+   char *image;		/* image of symbol */
+   int id_type;		/* OtherDcl, TndDesc, TndStr, TndBlk, Label, RtParm,
+                           DrfPrm, RsltLoc */
+   union {
+      struct {			/* RtParm: */
+         int param_num;		/*   parameter number */
+         int cur_loc;		/*   PrmTend, PrmCStr, PrmInt, or PrmDbl */
+         int non_tend;		/*   non-tended locations used */
+         int parm_mod;          /*   something may have modified it */
+         struct sym_entry *next;
+         } param_info;
+      struct {                  /* TndDesc, TndStr, TndBlk: */
+         struct node *init;     /*   initial value from declaration */
+         char *blk_name;	/*   TndBlk: struct name of block */
+         struct sym_entry *next;
+         } tnd_var;
+      struct {			/* OtherDcl from "declare {...}": */
+         struct node *tqual;	/*   storage class, type qualifier list */
+         struct node *dcltor;	/*   declarator */
+         struct node *init;     /*   initial value from declaration */
+         struct sym_entry *next;
+         } declare_var;
+      int typ_indx;             /* index into arrays of type information */
+      word lbl_num;             /* label number used in in-line code */
+      int referenced;		/* RsltLoc: is referenced */
+      } u;
+   int t_indx;		/* index into tended array */
+   int il_indx;		/* index used in in-line code */
+   int nest_lvl;	/* 0 - reserved word, 1 - global, >= 2 - local */
+   int may_mod;         /* may be modified in particular piece of code */
+   int ref_cnt;
+   struct sym_entry *next;
+   };
+
+/*
+ * Path-specific parameter information must be saved and merged for
+ *  branching and joining of paths.
+ */
+struct parminfo {
+   int cur_loc;
+   int parm_mod;
+   };
+
+/*
+ * A list is maintained of information needed to initialize tended descriptors.
+ */
+struct init_tend {
+   int t_indx;         /* index into tended array */
+   int init_typ;       /* TndDesc, TndStr, TndBlk */
+   struct node *init;  /* initial value from declaration */
+   int nest_lvl;            /* level of nesting of current use of tended slot */
+   int in_use;              /* tended slot is being used in current scope */
+   struct init_tend *next;
+   };
+
+
+extern int op_type;                /* Function, Keyword, Operator, or OrdFunc */
+extern char lc_letter;             /* f = function, o = operator, k = keyword */
+extern char uc_letter;             /* F = function, O = operator, K = keyword */
+extern char prfx1;                 /* 1st char of unique prefix for operation */
+extern char prfx2;                 /* 2nd char of unique prefix for operation */
+extern char *fname;                /* current source file name */
+extern int line;                   /* current source line number */
+extern struct implement *cur_impl; /* data base entry for current operator */
+extern struct token *comment;      /* descriptive comment for current oper */
+extern int n_tmp_str;              /* total number of string buffers needed */
+extern int n_tmp_cset;             /* total number of cset buffers needed */
+extern int nxt_sbuf;               /* index of next string buffer */
+extern int nxt_cbuf;               /* index of next cset buffer */
+extern struct sym_entry *params;   /* current list of parameters */
+extern struct sym_entry *decl_lst; /* declarations from "declare {...}" */
+extern struct init_tend *tend_lst; /* list of allocated tended slots */
+extern char *str_rslt;             /* string "result" in string table */
+extern word lbl_num;               /* next unused label number */
+extern struct sym_entry *v_len;    /* symbol entry for size of varargs */
+extern int il_indx;                /* next index into data base symbol table */
+
+/*
+ * lvl_entry keeps track of what is happening at a level of nested declarations.
+ */
+struct lvl_entry {
+   int nest_lvl;
+   int kind_dcl;	/* IsTypedef, TndDesc, TndStr, TndBlk, or OtherDcl */
+   char *blk_name;      /* for TndBlk, the struct name of the block */
+   int parms_done;      /* level consists of parameter list which is complete */
+   struct sym_entry *tended; /* symbol table entries for tended variables */
+   struct lvl_entry *next;
+   };
+
+extern struct lvl_entry *dcl_stk; /* stack of declaration contexts */
+
+extern int fnc_ret;  /* RetInt, RetDbl, RetNoVal, or RetSig for current func */
+
+#define NoAbstr  -1001 /* no abstract return statement has been encountered */
+#define SomeType -1002 /* assume returned value is consistent with abstr ret */
+extern int abs_ret; /* type from abstract return statement */
+
+/*
+ * Definitions for use in parse tree nodes.
+ */
+
+#define PrimryNd  1 /* simply a token */
+#define PrefxNd   2 /* a prefix expression */
+#define PstfxNd   3 /* a postfix expression */
+#define BinryNd   4 /* a binary expression (not necessarily infix) */
+#define TrnryNd   5 /* an expression with 3 subexpressions */
+#define QuadNd    6 /* an expression with 4 subexpressions */
+#define LstNd     7 /* list of declaration parts */
+#define CommaNd   8 /* arg lst, declarator lst, or init lst, not comma op */
+#define StrDclNd  9 /* structure field declaration */
+#define PreSpcNd 10 /* prefix expression that needs a space after it */
+#define ConCatNd 11 /* two ajacent pieces of code with no other syntax */
+#define SymNd    12 /* a symbol (identifier) node */
+#define ExactCnv 13 /* (exact)integer or (exact)C_integer conversion */
+#define CompNd   14 /* compound statement */
+#define AbstrNd  15 /* abstract type computation */
+#define IcnTypNd 16 /* name of an Icon type */
+
+#define NewNode(size) (struct node *)alloc(\
+    sizeof(struct node) + (size-1) * sizeof(union field))
+
+union field {
+   struct node *child;
+   struct sym_entry *sym;   /* used with SymNd & CompNd*/
+   };
+
+struct node {
+   int nd_id;
+   struct token *tok;
+   union field u[1]; /* actual size varies with node type */
+   };
+
+#include "rttproto.h"
diff --git a/src/rtt/rttdb.c b/src/rtt/rttdb.c
new file mode 100644
index 0000000..22368fe
--- /dev/null
+++ b/src/rtt/rttdb.c
@@ -0,0 +1,1440 @@
+/*
+ * rttdb.c - routines to read, manipulate, and write the data base of
+ *  information about run-time routines.
+ */
+
+#include "rtt.h"
+#include "../h/version.h"
+
+#define DHSize 47
+#define MaxLine 80
+
+/*
+ * prototypes for static functions.
+ */
+static void max_pre   (struct implement **tbl, char *pre);
+static int     name_cmp  (char *p1, char *p2);
+static int     op_cmp    (char *p1, char *p2);
+static void prt_dpnd  (FILE *db);
+static void prt_impls (FILE *db, char *sect, struct implement **tbl,
+                           int num, struct implement **sort_ary, int (*com)());
+static int     prt_c_fl  (FILE *db, struct cfile *clst, int line_left);
+static int     put_case  (FILE *db, struct il_code *il);
+static void put_ilc   (FILE *db, struct il_c *ilc);
+static void put_inlin (FILE *db, struct il_code *il);
+static void put_ret   (FILE *db, struct il_c *ilc);
+static void put_typcd (FILE *db, int typcd);
+static void put_var   (FILE *db, int code, struct il_c *ilc);
+static void ret_flag  (FILE *db, int flag, int may_fthru);
+static int     set_impl  (struct token *name, struct implement **tbl,
+                           int num_impl, char *pre);
+static void set_prms  (struct implement *ptr);
+static int     src_cmp   (char *p1, char *p2);
+
+static struct implement *bhash[IHSize];	/* hash area for built-in func table */
+static struct implement *ohash[IHSize]; /* hash area for operator table */
+static struct implement *khash[IHSize];	/* hash area for keyword table */
+
+static struct srcfile *dhash[DHSize];	/* hash area for file dependencies */
+
+static int num_fnc;		/* number of function in data base */
+static int num_op = 0;		/* number of operators in data base */
+static int num_key;		/* number of keywords in data base */
+static int num_src = 0;		/* number of source files in dependencies */
+
+static char fnc_pre[2];		/* next prefix available for functions */
+static char op_pre[2];		/* next prefix available for operators */
+static char key_pre[2];		/* next prefix available for keywords */
+
+static long min_rs;		/* min result sequence of current operation */
+static long max_rs;		/* max result sequence of current operation */
+static int rsm_rs;		/* '+' at end of result sequencce of cur. oper. */
+
+static int newdb = 0;		/* flag: this is a new data base */
+struct token *comment;		/* comment associated with current operation */
+struct implement *cur_impl;	/* data base entry for current operation */
+
+/*
+ * loaddb - load data base.
+ */
+void loaddb(dbname)
+char *dbname;
+   {
+   char *op;
+   struct implement *ip;
+   unsigned hashval;
+   int i;
+   char *srcname;
+   char *c_name;
+   struct srcfile *sfile;
+
+
+   /*
+    * Initialize internal data base.
+    */
+   for (i = 0; i < IHSize; i++) {
+       bhash[i] = NULL;   /* built-in function table */
+       ohash[i] = NULL;   /* operator table */
+       khash[i] = NULL;   /* keyword table */
+       }
+   for (i = 0; i < DHSize; i++)
+       dhash[i] = NULL;   /* dependency table */
+
+   /*
+    * Determine if this is a new data base or an existing one.
+    */
+   if (iconx_flg || !db_open(dbname, &largeints))
+      newdb = 1;
+   else {
+
+      /*
+       * Read information about built-in functions.
+       */
+      num_fnc = db_tbl("functions", bhash);
+
+      /*
+       * Read information about operators.
+       */
+      db_chstr("", "operators");    /* verify and skip "operators" */
+
+      while ((op = db_string()) != NULL) {
+         /*
+          * Read header information for the operator.
+           */
+         if ((ip = db_impl('O')) == NULL)
+            db_err2(1, "no implementation information for operator", op);
+         ip->op = op;
+
+         /*
+          * Read the descriptive comment and in-line code for the operator,
+          *  then put the entry in the hash table.
+          */
+         db_code(ip);
+         hashval = (int)IHasher(op);
+         ip->blink = ohash[hashval];
+         ohash[hashval] = ip;
+         db_chstr("", "end");         /* verify and skip "end" */
+         ++num_op;
+         }
+      db_chstr("", "endsect");       /* verify and skip "endsect" */
+
+      /*
+       * Read information about keywords.
+       */
+      num_key = db_tbl("keywords", khash);
+
+      /*
+       * Read C file/source dependency information.
+       */
+      db_chstr("", "dependencies");  /* verify and skip "dependencies" */
+
+      while ((srcname = db_string()) != NULL) {
+         sfile = src_lkup(srcname);
+         while ((c_name = db_string()) != NULL)
+            add_dpnd(sfile, c_name);
+         db_chstr("", "end");         /* verify and skip "end" */
+         }
+      db_chstr("", "endsect");        /* verify and skip "endsect" */
+
+      db_close();
+      }
+
+   /*
+    * Determine the next available operation prefixes by finding the
+    *  maximum prefixes currently in use.
+    */
+   max_pre(bhash, fnc_pre);
+   max_pre(ohash, op_pre);
+   max_pre(khash, key_pre);
+   }
+
+/*
+ * max_pre - find the maximum prefix in an implemetation table and set the
+ *  prefix array to the next value.
+ */
+static void max_pre(tbl, pre)
+struct implement **tbl;
+char *pre;
+   {
+   register struct implement *ptr;
+   unsigned hashval;
+   int empty = 1;
+   char dmy_pre[2];
+
+   pre[0] = '0';
+   pre[1] = '0';
+   for (hashval = 0; hashval < IHSize; ++hashval)
+      for (ptr = tbl[hashval]; ptr != NULL; ptr = ptr->blink) {
+         empty = 0;
+         /*
+          * Determine if this prefix is larger than any found so far.
+          */
+         if (cmp_pre(ptr->prefix, pre) > 0) {
+            pre[0] = ptr->prefix[0];
+            pre[1] = ptr->prefix[1];
+            }
+         }
+   if (!empty)
+      nxt_pre(dmy_pre, pre, 2);
+   }
+
+
+/*
+ * src_lkup - return pointer to dependency information for the given
+ *   source file.
+ */
+struct srcfile *src_lkup(srcname)
+char *srcname;
+   {
+   unsigned hashval;
+   struct srcfile *sfile;
+
+   /*
+    * See if the source file is already in the dependancy section of
+    *  the data base.
+    */
+   hashval = (unsigned int)(unsigned long)srcname % DHSize;
+   for (sfile = dhash[hashval]; sfile != NULL && sfile->name != srcname;
+        sfile = sfile->next)
+      ;
+
+   /*
+    * If an entry for the source file was not found, create one.
+    */
+   if (sfile == NULL) {
+      sfile = NewStruct(srcfile);
+      sfile->name = srcname;
+      sfile->dependents = NULL;
+      sfile->next = dhash[hashval];
+      dhash[hashval] = sfile;
+      ++num_src;
+      }
+   return sfile;
+   }
+
+/*
+ * add_dpnd - add the given source/dependency relation to the dependency
+ *   table.
+ */
+void add_dpnd(sfile, c_name)
+struct srcfile *sfile;
+char *c_name;
+   {
+   struct cfile *cf;
+
+   cf = NewStruct(cfile);
+   cf->name = c_name;
+   cf->next = sfile->dependents;
+   sfile->dependents = cf;
+   }
+
+/*
+ * clr_dpnd - delete all dependencies for the given source file.
+ */
+void clr_dpnd(srcname)
+char *srcname;
+   {
+   src_lkup(srcname)->dependents = NULL;
+   }
+
+/*
+ * dumpdb - write the updated data base.
+ */
+void dumpdb(dbname)
+char *dbname;
+   {
+   #ifdef Rttx
+      fprintf(stdout,
+         "rtt was compiled to only support the intepreter, use -x\n");
+      exit(EXIT_FAILURE);
+   #else				/* Rttx */
+   FILE *db;
+   struct implement **sort_ary;
+   int ary_sz;
+   int i;
+
+   db = fopen(dbname, "wb");
+   if (db == NULL)
+      err2("cannot open data base for output:", dbname);
+   if(newdb)
+      fprintf(stdout, "creating new data base: %s\n", dbname);
+
+   /*
+    * The data base starts with a version number associated with this
+    *   version of rtt and an indication of whether LargeInts was
+    *   defined during the build.
+    */
+   fprintf(db, "%s %s\n\n", DVersion, largeints);
+
+   fprintf(db, "\ntypes\n\n");          /* start of type code section */
+   for (i = 0; i < num_typs; ++i)
+      fprintf(db, "   T%d: %s\n", i, icontypes[i].id);
+   fprintf(db, "\n$endsect\n\n");       /* end of section for type codes */
+
+   fprintf(db, "\ncomponents\n\n");     /* start of component code section */
+   for (i = 0; i < num_cmpnts; ++i)
+      fprintf(db, "   C%d: %s\n", i, typecompnt[i].id);
+   fprintf(db, "\n$endsect\n\n");       /* end of section for component codes */
+
+   /*
+    * Allocate an array for sorting operation entries. It must be
+    *   large enough to hold functions, operators, or keywords.
+    */
+   ary_sz = Max(num_fnc, num_op);
+   ary_sz = Max(ary_sz, num_key);
+   if (ary_sz > 0)
+      sort_ary = alloc(ary_sz * sizeof(struct implement*));
+   else
+      sort_ary = NULL;
+
+   /*
+    * Sort and print to the data base the enties for each of the
+    *   three operation sections.
+    */
+   prt_impls(db, "functions", bhash, num_fnc, sort_ary, name_cmp);
+   prt_impls(db, "\noperators", ohash, num_op, sort_ary, op_cmp);
+   prt_impls(db, "\nkeywords", khash, num_key, sort_ary, name_cmp);
+   if (ary_sz > 0)
+      free((char *)sort_ary);
+
+   /*
+    * Print the dependancy information to the data base.
+    */
+   prt_dpnd(db);
+   if (fclose(db) != 0)
+     err2("cannot close ", dbname);
+   #endif				/* Rttx */
+   }
+
+#ifndef Rttx
+/*
+ * prt_impl - sort and print to the data base the enties from one
+ *   of the operation tables.
+ */
+static void prt_impls(db, sect, tbl, num, sort_ary, cmp)
+FILE *db;
+char *sect;
+struct implement **tbl;
+int num;
+struct implement **sort_ary;
+int (*cmp)();
+   {
+   int i;
+   int j;
+   unsigned hashval;
+   struct implement *ip;
+
+   /*
+    * Each operation section begins with the section name.
+    */
+   fprintf(db, "%s\n\n", sect);
+
+   /*
+    * Sort the table entries before printing.
+    */
+   if (num > 0) {
+      i = 0;
+      for (hashval = 0; hashval < IHSize; ++hashval)
+         for (ip = tbl[hashval]; ip != NULL; ip = ip->blink)
+            sort_ary[i++] = ip;
+      qsort((char *)sort_ary, num, sizeof(struct implement *), cmp);
+      }
+
+   /*
+    * Output each entry to the data base.
+    */
+   for (i = 0; i < num; ++i) {
+      ip = sort_ary[i];
+
+      /*
+       * Operators have operator symbols.
+       */
+      if (ip->op != NULL)
+         fprintf(db, "%s\t", ip->op);
+
+      /*
+       * Print the operation name, the unique prefix used to generate
+       *   C function names, and the number of parameters to the operation.
+       */
+      fprintf(db, "%s\t%c%c %d(", ip->name, ip->prefix[0], ip->prefix[1],
+         ip->nargs);
+
+      /*
+       * For each parameter, write and indication of whether a dereferenced
+       *   value, 'd', and/or and undereferenced value, 'u', is needed.
+       */
+      for (j = 0; j < ip->nargs; ++j) {
+         if (j > 0)
+            fprintf(db, ",");
+         if (ip->arg_flgs[j] & RtParm)
+            fprintf(db, "u");
+         if (ip->arg_flgs[j] & DrfPrm)
+            fprintf(db, "d");
+         }
+
+      /*
+       * Indicate if the last parameter represents the tail of a
+       *   variable length argument list.
+       */
+      if (ip->nargs > 0 && ip->arg_flgs[ip->nargs - 1] & VarPrm)
+         fprintf(db, "v");
+      fprintf(db, ")\t{");
+
+      /*
+       * Print the min and max result sequence length.
+       */
+      if (ip->min_result != NoRsltSeq) {
+         fprintf(db, "%ld,", ip->min_result);
+         if (ip->max_result == UnbndSeq)
+            fprintf(db, "*");
+         else
+            fprintf(db, "%ld", ip->max_result);
+         if (ip->resume)
+            fprintf(db, "+");
+         }
+      fprintf(db, "} ");
+
+      /*
+       * Print the return/suspend/fail/fall-through flag and an indication
+       *   of whether the operation explicitly uses the result location
+       *   (as opposed to an implicit use via return or suspend).
+       */
+      ret_flag(db, ip->ret_flag, 0);
+      if (ip->use_rslt)
+         fprintf(db, "t ");
+      else
+         fprintf(db, "f ");
+
+      /*
+       * Print the descriptive comment associated with the operation.
+       */
+      fprintf(db, "\n\"%s\"\n", ip->comment);
+
+      /*
+       * Print information about tended declarations from the declare
+       *  statement. The number of tended variables is printed followed
+       *  by an entry for each variable. Each entry consists of the
+       *  type of the declaration
+       *
+       *     struct descrip  -> desc
+       *     char *          -> str
+       *     struct b_xxx *  -> blkptr b_xxx
+       *     union block *   -> blkptr *
+       *
+       *  followed by the C code for the initializer (nil indicates none).
+       */
+      fprintf(db, "%d ", ip->ntnds);
+      for (j = 0; j < ip->ntnds; ++j) {
+         switch (ip->tnds[j].var_type) {
+            case TndDesc:
+               fprintf(db, "desc ");
+               break;
+            case TndStr:
+               fprintf(db, "str ");
+               break;
+            case TndBlk:
+               fprintf(db, "blkptr ");
+               if (ip->tnds[j].blk_name == NULL)
+                  fprintf(db, "* ");
+               else
+                  fprintf(db, "%s ", ip->tnds[j].blk_name);
+               break;
+            }
+         put_ilc(db, ip->tnds[j].init);
+         }
+
+      /*
+       * Print information about non-tended declarations from the declare
+       *  statement. The number of variables is printed followed by an
+       *  entry for each variable. Each entry consists of the variable
+       *  name followed by the complete C code for the declaration.
+       */
+      fprintf(db, "\n%d ", ip->nvars);
+      for (j = 0; j < ip->nvars; ++j) {
+         fprintf(db, "%s ", ip->vars[j].name);
+         put_ilc(db, ip->vars[j].dcl);
+         }
+      fprintf(db, "\n");
+
+      /*
+       * Output the "executable" code (includes abstract code) for the
+       *   operation.
+       */
+      put_inlin(db, ip->in_line);
+      fprintf(db, "\n$end\n\n");    /* end of operation entry */
+      }
+   fprintf(db, "$endsect\n\n");     /* end of section for operation type */
+   }
+
+/*
+ * put_inlin - put in-line code into the data base file. This is the
+ *   code used by iconc to perform type infernence for the operation
+ *   and to generate a tailored version of the operation.
+ */
+static void put_inlin(db, il)
+FILE *db;
+struct il_code *il;
+   {
+   int i;
+   int num_cases;
+   int indx;
+
+   /*
+    * RTL statements are handled by this function. Other functions
+    *  are called for C code.
+    */
+   if (il == NULL) {
+      fprintf(db, "nil ");
+      return;
+      }
+
+   switch (il->il_type) {
+      case IL_Const:
+         /*
+          * Constant keyword.
+          */
+         fprintf(db, "const ");
+         put_typcd(db, il->u[0].n);              /* type  code */
+         fputs(il->u[1].s, db); fputc(' ', db);  /* literal */
+         break;
+      case IL_If1:
+         /*
+          * if-then statment.
+          */
+         fprintf(db, "if1 ");
+         put_inlin(db, il->u[0].fld);            /* condition */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[1].fld);            /* then clause */
+         break;
+      case IL_If2:
+         /*
+          * if-then-else statment.
+          */
+         fprintf(db, "if2 ");
+         put_inlin(db, il->u[0].fld);            /* condition */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[1].fld);            /* then clause */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[2].fld);            /* else clause */
+         break;
+      case IL_Tcase1:
+         /*
+          * type_case statement with no default clause.
+          */
+         fprintf(db, "tcase1 ");
+         put_case(db, il);
+         break;
+      case IL_Tcase2:
+         /*
+          * type_case statement with a default clause.
+          */
+         fprintf(db, "tcase2 ");
+         indx = put_case(db, il);
+         fprintf(db, "\n");
+         put_inlin(db, il->u[indx].fld);         /* default */
+         break;
+      case IL_Lcase:
+         /*
+          * len_case statement.
+          */
+         fprintf(db, "lcase ");
+         num_cases = il->u[0].n;
+         fprintf(db, "%d ", num_cases);
+         indx = 1;
+         for (i = 0; i < num_cases; ++i) {
+            fprintf(db, "\n%d ", il->u[indx++].n);    /* selection number */
+            put_inlin(db, il->u[indx++].fld);        /* action */
+            }
+         fprintf(db, "\n");
+         put_inlin(db, il->u[indx].fld);             /* default */
+         break;
+      case IL_Acase:
+         /*
+          * arith_case statement.
+          */
+         fprintf(db, "acase ");
+         put_inlin(db, il->u[0].fld);               /* first variable */
+         put_inlin(db, il->u[1].fld);               /* second variable */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[2].fld);               /* C_integer action */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[3].fld);               /* integer action */
+         fprintf(db, "\n");
+         put_inlin(db, il->u[4].fld);               /* C_double action */
+         break;
+      case IL_Err1:
+         /*
+          * runerr with no value argument.
+          */
+         fprintf(db, "runerr1 ");
+         fprintf(db, "%d ", il->u[0].n);      /* error number */
+         break;
+      case IL_Err2:
+         /*
+          * runerr with a value argument.
+          */
+         fprintf(db, "runerr2 ");
+         fprintf(db, "%d ", il->u[0].n);      /* error number */
+         put_inlin(db, il->u[1].fld);          /* variable */
+         break;
+      case IL_Lst:
+         /*
+          * "glue" to string statements together.
+          */
+         fprintf(db, "lst ");
+         put_inlin(db, il->u[0].fld);
+         fprintf(db, "\n");
+         put_inlin(db, il->u[1].fld);
+         break;
+      case IL_Bang:
+         /*
+          * ! operator from type checking.
+          */
+         fprintf(db, "! ");
+         put_inlin(db, il->u[0].fld);
+         break;
+      case IL_And:
+         /*
+          * && operator from type checking.
+          */
+         fprintf(db, "&& ");
+         put_inlin(db, il->u[0].fld);
+         put_inlin(db, il->u[1].fld);
+         break;
+      case IL_Cnv1:
+         /*
+          * cnv:<dest-type>(<source>)
+          */
+         fprintf(db, "cnv1 ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         put_inlin(db, il->u[1].fld);    /* source */
+         break;
+      case IL_Cnv2:
+         /*
+          * cnv:<dest-type>(<source>,<destination>)
+          */
+         fprintf(db, "cnv2 ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         put_inlin(db, il->u[1].fld);    /* source */
+         put_ilc(db, il->u[2].c_cd);     /* destination */
+         break;
+      case IL_Def1:
+         /*
+          * def:<dest-type>(<source>,<default-value>)
+          */
+         fprintf(db, "def1 ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         put_inlin(db, il->u[1].fld);    /* source */
+         put_ilc(db, il->u[2].c_cd);     /* default value */
+         break;
+      case IL_Def2:
+         /*
+          * def:<dest-type>(<source>,<default-value>,<destination>)
+          */
+         fprintf(db, "def2 ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         put_inlin(db, il->u[1].fld);    /* source */
+         put_ilc(db, il->u[2].c_cd);     /* default value */
+         put_ilc(db, il->u[3].c_cd);     /* destination */
+         break;
+      case IL_Is:
+         /*
+          * is:<type-name>(<variable>)
+          */
+         fprintf(db, "is ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         put_inlin(db, il->u[1].fld);    /* variable */
+         break;
+      case IL_Var:
+         /*
+          * A variable.
+          */
+         fprintf(db, "%d ", il->u[0].n);    /* symbol table index */
+         break;
+      case IL_Subscr:
+         /*
+          * A subscripted variable.
+          */
+         fprintf(db, "[ ");
+         fprintf(db, "%d ", il->u[0].n);    /* symbol table index */
+         fprintf(db, "%d ", il->u[1].n);    /* subscripting index */
+         break;
+      case IL_Block:
+         /*
+          * A block of in-line code.
+          */
+         fprintf(db, "block ");
+         if (il->u[0].n)
+            fprintf(db, "t ");              /* execution can fall through */
+         else
+            fprintf(db, "_ ");              /* execution cannot fall through */
+          /*
+           * Output a symbol table of tended variables.
+           */
+         fprintf(db, "%d ", il->u[1].n);    /* number of local tended */
+         for (i = 2; i - 2 < il->u[1].n; ++i)
+             switch (il->u[i].n) {
+                case TndDesc:
+                   fprintf(db, "desc ");
+                   break;
+                case TndStr:
+                   fprintf(db, "str ");
+                   break;
+                case TndBlk:
+                   fprintf(db, "blkptr ");
+                   break;
+                }
+         put_ilc(db, il->u[i].c_cd);         /* body of block */
+         break;
+      case IL_Call:
+         /*
+          * A call to a body function.
+          */
+         fprintf(db, "call ");
+
+         /*
+          * Each body function has a 3rd prefix character to distingish
+          *  it from other functions for the operation.
+          */
+         fprintf(db, "%c ", (char)il->u[1].n);
+
+         /*
+          * A body function that would only return one possible signal
+          *   need return none. In which case, it can directly return a
+          *   C integer or double directly rather than using a result
+          *   descriptor location. Indicate what it does.
+          */
+         switch (il->u[2].n) {
+            case RetInt:
+               fprintf(db, "i ");  /* directly return integer */
+               break;
+            case RetDbl:
+               fprintf(db, "d ");  /* directly return double */
+               break;
+            case RetNoVal:
+               fprintf(db, "n ");  /* return nothing directly */
+               break;
+            case RetSig:
+               fprintf(db, "s ");  /* return a signal */
+               break;
+            }
+
+         /*
+          * Output the return/suspend/fail/fall-through flag.
+          */
+         ret_flag(db, il->u[3].n, 1);
+
+         /*
+          * Indicate whether the body function expects to have
+          *   an explicit result location passed to it.
+          */
+         if (il->u[4].n)
+            fprintf(db, "t ");
+         else
+            fprintf(db, "f ");
+
+         fprintf(db, "%d ", il->u[5].n);    /* num string bufs */
+         fprintf(db, "%d ", il->u[6].n);    /* num cset bufs */
+         i = il->u[7].n;
+         fprintf(db, "%d ", i);             /* num args */
+         indx = 8;
+         /*
+          * output prototype paramater declarations and actual arguments.
+          */
+         i *= 2;
+         while (i--)
+            put_ilc(db, il->u[indx++].c_cd);
+         break;
+      case IL_Abstr:
+         /*
+          * Abstract type computation.
+          */
+         fprintf(db, "abstr ");
+         put_inlin(db, il->u[0].fld);    /* side effects */
+         put_inlin(db, il->u[1].fld);    /* return type */
+         break;
+      case IL_VarTyp:
+         /*
+          * type(<parameter>)
+          */
+         fprintf(db, "vartyp ");
+         put_inlin(db, il->u[0].fld);    /* variable */
+         break;
+      case IL_Store:
+         /*
+          * store[<type>]
+          */
+         fprintf(db, "store ");
+         put_inlin(db, il->u[0].fld);    /* type to be "dereferenced "*/
+         break;
+      case IL_Compnt:
+         /*
+          * <type>.<component>
+          */
+         fprintf(db, ". ");
+         put_inlin(db, il->u[0].fld);    /* type */
+         if (il->u[1].n == CM_Fields)
+             fprintf(db, "f ");          /* special case record fields */
+         else
+             fprintf(db, "C%d ", (int)il->u[1].n); /* component table index */
+         break;
+      case IL_TpAsgn:
+         /*
+          * store[<variable-type>] = <value-type>
+          */
+         fprintf(db, "= ");
+         put_inlin(db, il->u[0].fld);    /* variable type */
+         put_inlin(db, il->u[1].fld);    /* value type */
+         break;
+      case IL_Union:
+         /*
+          * <type 1> ++ <type 2>
+          */
+         fprintf(db, "++ ");
+         put_inlin(db, il->u[0].fld);
+         put_inlin(db, il->u[1].fld);
+         break;
+      case IL_Inter:
+         /*
+          * <type 1> ** <type 2>
+          */
+         fprintf(db, "** ");
+         put_inlin(db, il->u[0].fld);
+         put_inlin(db, il->u[1].fld);
+         break;
+      case IL_New:
+         /*
+          * new <type-name>(<type 1> , ...)
+          */
+         fprintf(db, "new ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         i = il->u[1].n;
+         fprintf(db, "%d ", i);          /* num args */
+         indx = 2;
+         while (i--)
+            put_inlin(db, il->u[indx++].fld);
+         break;
+      case IL_IcnTyp:
+         /*
+          * <type-name>
+          */
+         fprintf(db, "typ ");
+         put_typcd(db, il->u[0].n);      /* type code */
+         break;
+      }
+   }
+
+/*
+ * put_case - put the cases of a type_case statement into the data base file.
+ */
+static int put_case(db, il)
+FILE *db;
+struct il_code *il;
+   {
+   int *typ_vect;
+   int i, j;
+   int num_cases;
+   int num_types;
+   int indx;
+
+   put_inlin(db, il->u[0].fld);               /* expression being checked */
+   num_cases = il->u[1].n;                    /* number of cases */
+   fprintf(db, "%d ", num_cases);
+   indx = 2;
+   for (i = 0; i < num_cases; ++i) {
+      num_types = il->u[indx++].n;             /* number of types in case */
+      fprintf(db, "\n%d ", num_types);
+      typ_vect = il->u[indx++].vect;          /* vector of type codes */
+      for (j = 0; j < num_types; ++j)
+         put_typcd(db, typ_vect[j]);          /* type code */
+      put_inlin(db, il->u[indx++].fld);       /* action */
+      }
+   return indx;
+   }
+
+/*
+ * put_typcd - convert a numeric type code into an alpha type code and
+ *  put it in the data base file.
+ */
+static void put_typcd(db, typcd)
+FILE *db;
+int typcd;
+   {
+   if (typcd >= 0)
+      fprintf(db, "T%d ", typcd);
+   else {
+      switch (typcd) {
+         case TypAny:
+            fprintf(db, "a ");	   /* any_value */
+            break;
+         case TypEmpty:
+            fprintf(db, "e ");	   /* empty_type */
+            break;
+         case TypVar:
+            fprintf(db, "v ");	   /* variable */
+            break;
+         case TypCInt:
+            fprintf(db, "ci ");    /* C_integer */
+            break;
+         case TypCDbl:
+            fprintf(db, "cd ");    /* C_double */
+            break;
+         case TypCStr:
+            fprintf(db, "cs ");    /* C_string */
+            break;
+         case TypEInt:
+            fprintf(db, "ei ");    /* (exact)integer) */
+            break;
+         case TypECInt:
+            fprintf(db, "eci ");   /* (exact)C_integer */
+            break;
+         case TypTStr:
+            fprintf(db, "ts ");    /* tmp_string */
+            break;
+         case TypTCset:
+            fprintf(db, "tc ");    /* tmp_cset */
+            break;
+         case RetDesc:
+            fprintf(db, "d ");     /* plain descriptor on return/suspend */
+            break;
+         case RetNVar:
+            fprintf(db, "nv ");    /* named_var */
+            break;
+         case RetSVar:
+            fprintf(db, "sv ");    /* struct_var */
+            break;
+         case RetNone:
+            fprintf(db, "rn ");   /* preset result location on return/suspend */
+            break;
+         }
+      }
+   }
+
+/*
+ * put_ilc - put in-line C code in the data base file.
+ */
+static void put_ilc(db, ilc)
+FILE *db;
+struct il_c *ilc;
+   {
+   /*
+    * In-line C code is either "nil" or code bracketed by $c $e.
+    *   The bracketed code consists of text for C code plus special
+    *   constructs starting with $. Control structures have been
+    *   translated into gotos in the form of special constructs
+    *   (note that case statements are not supported in in-line code).
+    */
+   if (ilc == NULL) {
+      fprintf(db, "nil ");
+      return;
+      }
+   fprintf(db, "$c ");
+   while (ilc != NULL) {
+      switch(ilc->il_c_type) {
+         case ILC_Ref:
+            put_var(db, 'r', ilc);   /* non-modifying reference to variable */
+            break;
+         case ILC_Mod:
+            put_var(db, 'm', ilc);   /* modifying reference to variable */
+            break;
+         case ILC_Tend:
+            put_var(db, 't', ilc);   /* variable declared tended */
+            break;
+         case ILC_SBuf:
+            fprintf(db, "$sb ");     /* string buffer for tmp_string */
+            break;
+         case ILC_CBuf:
+            fprintf(db, "$cb ");     /* cset buffer for tmp_cset */
+            break;
+         case ILC_Ret:
+            fprintf(db, "$ret ");    /* return statement */
+            put_ret(db, ilc);
+            break;
+         case ILC_Susp:
+            fprintf(db, "$susp ");   /* suspend statement */
+            put_ret(db, ilc);
+            break;
+         case ILC_Fail:
+            fprintf(db, "$fail ");   /* fail statement */
+            break;
+         case ILC_EFail:
+            fprintf(db, "$efail ");  /* errorfail statement */
+            break;
+         case ILC_Goto:
+            fprintf(db, "$goto %d ", ilc->n);  /* goto label */
+            break;
+         case ILC_CGto:
+            fprintf(db, "$cgoto ");            /* conditional goto */
+            put_ilc(db, ilc->code[0]);         /* condition (with $c $e) */
+            fprintf(db, "%d ", ilc->n);        /* label */
+            break;
+         case ILC_Lbl:
+            fprintf(db, "$lbl %d ", ilc->n);   /* label */
+            break;
+         case ILC_LBrc:
+            fprintf(db, "${ ");                /* start of C block with dcls */
+            break;
+         case ILC_RBrc:
+            fprintf(db, "$} ");                /* end of C block with dcls */
+            break;
+         case ILC_Str:
+            fprintf(db, "%s", ilc->s);         /* C code as plain text */
+            break;
+         }
+      ilc = ilc->next;
+      }
+   fprintf(db, " $e ");
+   }
+
+/*
+ * put_var - output in-line C code for a variable.
+ */
+static void put_var(db, code, ilc)
+FILE *db;
+int code;
+struct il_c *ilc;
+   {
+   fprintf(db, "$%c", code);  /* 'r': non-mod ref, 'm': mod ref, 't': tended */
+   if (ilc->s != NULL)
+      fprintf(db, "%s", ilc->s);  /* access into descriptor */
+   if (ilc->n == RsltIndx)
+      fprintf(db, "r ");          /* this is "result" */
+   else
+      fprintf(db, "%d ", ilc->n); /* offset into a symbol table */
+   }
+
+/*
+ * ret_flag - put a return/suspend/fail/fall-through flag in the data base
+ *  file.
+ */
+static void ret_flag(db, flag, may_fthru)
+FILE *db;
+int flag;
+int may_fthru;
+   {
+   if (flag & DoesFail)
+      fprintf(db, "f");      /* can fail */
+   else
+      fprintf(db, "_");      /* cannot fail */
+   if (flag & DoesRet)
+      fprintf(db, "r");      /* can return */
+   else
+      fprintf(db, "_");      /* cannot return */
+   if (flag & DoesSusp)
+      fprintf(db, "s");      /* can suspend */
+   else
+      fprintf(db, "_");      /* cannot suspend */
+   if (flag & DoesEFail)
+      fprintf(db, "e");      /* can do error conversion */
+   else
+      fprintf(db, "_");      /* cannot do error conversion */
+   if (may_fthru)            /* body functions only: */
+      if (flag & DoesFThru)
+         fprintf(db, "t");      /* can fall through */
+      else
+         fprintf(db, "_");      /* cannot fall through */
+  fprintf(db, " ");
+  }
+
+/*
+ * put_ret - put the body of a return/suspend statement in the data base.
+ */
+static void put_ret(db, ilc)
+FILE *db;
+struct il_c *ilc;
+   {
+   int i;
+
+   /*
+    * Output the type of descriptor constructor on the return/suspend,
+    *  then output the the number of arguments to the constructor, and
+    *  the arguments themselves.
+    */
+   put_typcd(db, ilc->n);
+   for (i = 0; i < 3 && ilc->code[i] != NULL; ++i)
+       ;
+   fprintf(db, "%d ", i);
+   for (i = 0; i < 3 && ilc->code[i] != NULL; ++i)
+       put_ilc(db, ilc->code[i]);
+   }
+
+/*
+ * name_cmp - compare implementation structs by name; function used as
+ *  an argument to qsort().
+ */
+static int name_cmp(p1, p2)
+char *p1;
+char *p2;
+   {
+   register struct implement *ip1;
+   register struct implement *ip2;
+
+   ip1 = *(struct implement **)p1;
+   ip2 = *(struct implement **)p2;
+   return strcmp(ip1->name, ip2->name);
+   }
+
+/*
+ * op_cmp - compare implementation structs by operator and number of args;
+ *   function used as an argument to qsort().
+ */
+static int op_cmp(p1, p2)
+char *p1;
+char *p2;
+   {
+   register int cmp;
+   register struct implement *ip1;
+   register struct implement *ip2;
+
+   ip1 = *(struct implement **)p1;
+   ip2 = *(struct implement **)p2;
+
+   cmp = strcmp(ip1->op, ip2->op);
+   if (cmp == 0)
+      return ip1->nargs - ip2->nargs;
+   else
+      return cmp;
+   }
+
+/*
+ * prt_dpnd - print dependency information to the data base.
+ */
+static void prt_dpnd(db)
+FILE *db;
+   {
+   struct srcfile **sort_ary;
+   struct srcfile *sfile;
+   unsigned hashval;
+   int line_left;
+   int num;
+   int i;
+
+   fprintf(db, "\ndependencies\n\n");  /* start of dependency section */
+
+   /*
+    * sort the dependency information by source file name.
+    */
+   num = 0;
+   if (num_src > 0) {
+      sort_ary = alloc(num_src * sizeof(struct srcfile *));
+      for (hashval = 0; hashval < DHSize; ++hashval)
+         for (sfile = dhash[hashval]; sfile != NULL; sfile = sfile->next)
+            sort_ary[num++] = sfile;
+      qsort((char *)sort_ary, num, sizeof(struct srcfile *),
+         (int (*)())src_cmp);
+      }
+
+   /*
+    * For each source file with dependents, output the source file
+    *  name followed by the list of dependent files. The list is
+    *  terminated with "end".
+    */
+   for (i = 0; i < num; ++i) {
+      sfile = sort_ary[i];
+      if (sfile->dependents != NULL) {
+         fprintf(db, "%-12s  ", sfile->name);
+         line_left = prt_c_fl(db, sfile->dependents, MaxLine - 14);
+         if (line_left - 4 < 0)
+            fprintf(db, "\n            ");
+         fprintf(db, "$end\n");
+         }
+      }
+   fprintf(db, "\n$endsect\n");  /* end of dependency section */
+   if (num_src > 0)
+      free((char *)sort_ary);
+   }
+
+/*
+ * src_cmp - compare srcfile structs; function used as an argument to qsort().
+ */
+static int src_cmp(p1, p2)
+char *p1;
+char *p2;
+   {
+   register struct srcfile *sp1;
+   register struct srcfile *sp2;
+
+   sp1 = *(struct srcfile **)p1;
+   sp2 = *(struct srcfile **)p2;
+   return strcmp(sp1->name, sp2->name);
+   }
+
+/*
+ * prt_c_fl - print list of C files in reverse order.
+ */
+static int prt_c_fl(db, clst, line_left)
+FILE *db;
+struct cfile *clst;
+int line_left;
+   {
+   int len;
+
+   if (clst == NULL)
+      return line_left;
+   line_left = prt_c_fl(db, clst->next, line_left);
+
+   /*
+    * If this will exceed the line length, print a new-line and some
+    *  leading white space.
+    */
+   len = strlen(clst->name) + 1;
+   if (line_left - len < 0) {
+      fprintf(db, "\n              ");
+      line_left = MaxLine - 14;
+      }
+   fprintf(db, "%s ", clst->name);
+   return line_left - len;
+   }
+#endif					/* Rttx */
+
+/*
+ * full_lst - print a full list of all files produced by translations
+ *  as represented in the dependencies section of the data base.
+ */
+void full_lst(fname)
+char *fname;
+   {
+   unsigned hashval;
+   struct srcfile *sfile;
+   struct cfile *clst;
+   struct fileparts *fp;
+   FILE *f;
+
+   f = fopen(fname, "w");
+   if (f == NULL)
+      err2("cannot open ", fname);
+   for (hashval = 0; hashval < DHSize; ++hashval)
+      for (sfile = dhash[hashval]; sfile != NULL; sfile = sfile->next)
+         for (clst = sfile->dependents; clst != NULL; clst = clst->next) {
+            /*
+             * Remove the suffix from the name before printing.
+             */
+            fp = fparse(clst->name);
+            fprintf(f, "%s\n", fp->name);
+            }
+   if (fclose(f) != 0)
+      err2("cannot close ", fname);
+   }
+
+/*
+ * impl_fnc - find or create implementation struct for function currently
+ *  being parsed.
+ */
+void impl_fnc(name)
+struct token *name;
+   {
+   /*
+    * Set the global operation type for later use. If this is a
+    *  new function update the number of them.
+    */
+   op_type = TokFunction;
+   num_fnc = set_impl(name, bhash, num_fnc, fnc_pre);
+   }
+
+/*
+ * impl_key - find or create implementation struct for keyword currently
+ *  being parsed.
+ */
+void impl_key(name)
+struct token *name;
+   {
+   /*
+    * Set the global operation type for later use. If this is a
+    *  new keyword update the number of them.
+    */
+   op_type = Keyword;
+   num_key = set_impl(name, khash, num_key, key_pre);
+   }
+
+/*
+ * set_impl - lookup a function or keyword in a hash table and update the
+ *  entry, creating the entry if needed.
+ */
+static int set_impl(name, tbl, num_impl, pre)
+struct token *name;
+struct implement **tbl;
+int num_impl;
+char *pre;
+   {
+   register struct implement *ptr;
+   char *name_s;
+   unsigned hashval;
+
+   /*
+    * we only need the operation name and not the entire token.
+    */
+   name_s = name->image;
+   free_t(name);
+
+   /*
+    * If the operation is not in the hash table, put it there.
+    */
+   if ((ptr = db_ilkup(name_s, tbl)) == NULL) {
+      ptr = NewStruct(implement);
+      hashval = IHasher(name_s);
+      ptr->blink = tbl[hashval];
+      ptr->oper_typ = ((op_type == TokFunction) ? 'F' : 'K');
+      nxt_pre(ptr->prefix, pre, 2);    /* allocate a unique prefix */
+      ptr->name = name_s;
+      ptr->op = NULL;
+      tbl[hashval] = ptr;
+      ++num_impl;
+      }
+
+   cur_impl = ptr;   /* put entry in global variable for later access */
+
+   /*
+    * initialize the entry based on global information set during parsing.
+    */
+   set_prms(ptr);
+   ptr->min_result = min_rs;
+   ptr->max_result = max_rs;
+   ptr->resume = rsm_rs;
+   ptr->ret_flag = 0;
+   if (comment == NULL)
+      ptr->comment = "";
+   else {
+      ptr->comment = comment->image;
+      free_t(comment);
+      comment = NULL;
+      }
+   ptr->ntnds = 0;
+   ptr->tnds = NULL;
+   ptr->nvars = 0;
+   ptr->vars = NULL;
+   ptr->in_line = NULL;
+   ptr->iconc_flgs = 0;
+   return num_impl;
+   }
+
+/*
+ * set_prms - set the parameter information of an implementation based on
+ *   the params list constructed during parsing.
+ */
+static void set_prms(ptr)
+struct implement *ptr;
+   {
+   struct sym_entry *sym;
+   int nargs;
+   int i;
+
+   /*
+    * Create an array of parameter flags for the operation. The flag
+    * indicates the deref/underef and varargs status for each parameter.
+    */
+   if (params == NULL) {
+      ptr->nargs = 0;
+      ptr->arg_flgs = NULL;
+      }
+   else {
+      /*
+       * The parameters are in reverse order, so the number of the parameters
+       *  can be determined by the number assigned to the first one on the
+       *  list.
+       */
+      nargs = params->u.param_info.param_num + 1;
+      ptr->nargs = nargs;
+      ptr->arg_flgs = alloc(nargs * sizeof(int));
+      for (i = 0; i < nargs; ++i)
+         ptr->arg_flgs[i] = 0;
+      for (sym = params; sym != NULL; sym = sym->u.param_info.next)
+         ptr->arg_flgs[sym->u.param_info.param_num] |= sym->id_type;
+      }
+   }
+
+/*
+ * impl_op - find or create implementation struct for operator currently
+ *  being parsed.
+ */
+void impl_op(op_sym, name)
+struct token *op_sym;
+struct token *name;
+   {
+   register struct implement *ptr;
+   char *op;
+   int nargs;
+   unsigned hashval;
+
+   /*
+    * The operator symbol is needed but not the entire token.
+    */
+   op = op_sym->image;
+   free_t(op_sym);
+
+   /*
+    * The parameters are in reverse order, so the number of the parameters
+    *  can be determined by the number assigned to the first one on the
+    *  list.
+    */
+   if (params == NULL)
+      nargs = 0;
+   else
+      nargs = params->u.param_info.param_num + 1;
+
+   /*
+    * Locate the operator in the hash table; it must match both the
+    *  operator symbol and the number of arguments. If the operator is
+    *  not there, create an entry.
+    */
+   hashval = IHasher(op);
+   ptr = ohash[hashval];
+   while (ptr != NULL && (ptr->op != op || ptr->nargs != nargs))
+      ptr = ptr->blink;
+   if (ptr == NULL) {
+      ptr = NewStruct(implement);
+      ptr->blink = ohash[hashval];
+      ptr->oper_typ = 'O';
+      nxt_pre(ptr->prefix, op_pre, 2);   /* allocate a unique prefix */
+      ptr->op = op;
+      ohash[hashval] = ptr;
+      ++num_op;
+      }
+
+   /*
+    * Put the entry and operation type in global variables for
+    *  later access.
+    */
+   cur_impl = ptr;
+   op_type = Operator;
+
+   /*
+    * initialize the entry based on global information set during parsing.
+    */
+   ptr->name = name->image;
+   free_t(name);
+   set_prms(ptr);
+   ptr->min_result = min_rs;
+   ptr->max_result = max_rs;
+   ptr->resume = rsm_rs;
+   ptr->ret_flag = 0;
+   if (comment == NULL)
+      ptr->comment = "";
+   else {
+      ptr->comment = comment->image;
+      free_t(comment);
+      comment = NULL;
+      }
+   ptr->ntnds = 0;
+   ptr->tnds = NULL;
+   ptr->nvars = 0;
+   ptr->vars = NULL;
+   ptr->in_line = NULL;
+   ptr->iconc_flgs = 0;
+   }
+
+/*
+ * set_r_seq - save result sequence information for updating the
+ *  operation entry.
+ */
+void set_r_seq(min, max, resume)
+long min;
+long max;
+int resume;
+   {
+   if (min == UnbndSeq)
+      min = 0;
+   min_rs = min;
+   max_rs = max;
+   rsm_rs = resume;
+   }
+
diff --git a/src/rtt/rttgram.y b/src/rtt/rttgram.y
new file mode 100644
index 0000000..bf47752
--- /dev/null
+++ b/src/rtt/rttgram.y
@@ -0,0 +1,1101 @@
+/*
+ * Grammar for RTL. The C portion of the grammar is based on
+ *  the ANSI Draft Standard - 3rd review.
+ */
+
+%{
+#include "rtt1.h"
+#define YYMAXDEPTH 250
+%}
+
+%union {
+   struct token *t;
+   struct node *n;
+   long i;
+   }
+
+%token <t> Identifier StrLit LStrLit FltConst DblConst LDblConst
+%token <t> CharConst LCharConst IntConst UIntConst LIntConst ULIntConst
+%token <t> Arrow Incr Decr LShft RShft Leq Geq Equal Neq
+%token <t> And Or MultAsgn DivAsgn ModAsgn PlusAsgn
+%token <t> MinusAsgn LShftAsgn RShftAsgn AndAsgn
+%token <t> XorAsgn OrAsgn Sizeof Intersect OpSym
+
+%token <t> Typedef Extern Static Auto Register Tended
+%token <t> Char Short Int Long Signed Unsigned Float Doubl Const Volatile
+%token <t> Void TypeDefName Struct Union Enum Ellipsis
+
+%token <t> Case Default If Else Switch While Do For Goto Continue Break Return
+
+%token <t> '%' '&' '(' ')' '*' '+' ',' '-' '.' '/' '{' '|' '}' '~' '[' ']'
+%token <t> '^' ':' ';' '<' '=' '>' '?' '!' '@' '\\'
+
+%token <t> Runerr Is Cnv Def Exact Empty_type IconType Component Variable
+%token <t> Any_value Named_var Struct_var C_Integer Arith_case
+%token <t> C_Double C_String Tmp_string Tmp_cset Body End Function Keyword
+%token <t> Operator Underef Declare Suspend Fail Inline Abstract Store
+%token <t> Type New All_fields Then Type_case Of Len_case Constant Errorfail
+
+%type <t> unary_op assign_op struct_or_union typedefname
+%type <t> identifier op_name key_const union attrb_name
+
+%type <n> any_ident storage_class_spec type_qual
+%type <n> primary_expr postfix_expr arg_expr_lst unary_expr cast_expr
+%type <n> multiplicative_expr additive_expr shift_expr relational_expr
+%type <n> equality_expr and_expr exclusive_or_expr inclusive_or_expr
+%type <n> logical_and_expr logical_or_expr conditional_expr assign_expr
+%type <n> expr opt_expr constant_expr opt_constant_expr dcltion
+%type <n> typ_dcltion_specs dcltion_specs type_ind type_storcl_tqual_lst
+%type <n> storcl_tqual_lst init_dcltor_lst no_tdn_init_dcltor_lst init_dcltor
+%type <n> no_tdn_init_dcltor type_spec stnd_type struct_or_union_spec
+%type <n> struct_dcltion_lst struct_dcltion struct_dcltion_specs struct_type_ind
+%type <n> struct_type_lst struct_dcltor_lst struct_dcltor
+%type <n> struct_no_tdn_dcltor_lst struct_no_tdn_dcltor enum_spec enumerator_lst
+%type <n> enumerator dcltor no_tdn_dcltor direct_dcltor no_tdn_direct_dcltor
+%type <n> pointer opt_pointer tqual_lst param_type_lst opt_param_type_lst
+%type <n> param_lst param_dcltion ident_lst type_tqual_lst type_name
+%type <n> abstract_dcltor direct_abstract_dcltor initializer initializer_lst
+%type <n> stmt labeled_stmt compound_stmt dcltion_lst opt_dcltion_lst stmt_lst
+%type <n> expr_stmt selection_stmt iteration_stmt jump_stmt parm_dcls_or_ids
+%type <n> func_head opt_stmt_lst local_dcls local_dcl
+%type <n> dest_type i_type_name opt_actions actions action ret_val detail_code
+%type <n> runerr variable checking_conversions label
+%type <n> type_check type_select_lst opt_default type_select selector_lst
+%type <n> c_opt_default c_type_select c_type_select_lst non_lbl_stmt
+%type <n> simple_check_conj simple_check len_select_lst len_select
+%type <n> type_computations side_effect_lst side_effect
+%type <n> type basic_type type_lst
+
+%type <i> opt_plus length
+
+/* Get rid of shift/reduce conflict on Else. Use precedence to force shift of
+   Else rather than reduction of if-cond-expr. This insures that the Else
+   is always paired with innermost If. Note, IfStmt is a dummy token. */
+%nonassoc IfStmt
+%nonassoc Else
+
+%start translation_unit
+%%
+
+primary_expr
+   : identifier   {$$ = sym_node($1);}
+   | StrLit       {$$ = node0(PrimryNd, $1);}
+   | LStrLit      {$$ = node0(PrimryNd, $1);}
+   | FltConst     {$$ = node0(PrimryNd, $1);}
+   | DblConst     {$$ = node0(PrimryNd, $1);}
+   | LDblConst    {$$ = node0(PrimryNd, $1);}
+   | CharConst    {$$ = node0(PrimryNd, $1);}
+   | LCharConst   {$$ = node0(PrimryNd, $1);}
+   | IntConst     {$$ = node0(PrimryNd, $1);}
+   | UIntConst    {$$ = node0(PrimryNd, $1);}
+   | LIntConst    {$$ = node0(PrimryNd, $1);}
+   | ULIntConst   {$$ = node0(PrimryNd, $1);}
+   | '(' expr ')' {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   ;
+
+postfix_expr
+   : primary_expr
+   | postfix_expr '[' expr ']'         {$$ = node2(BinryNd, $2, $1, $3);
+                                        free_t($4);}
+   | postfix_expr '(' ')'              {$$ = node2(BinryNd, $3, $1, NULL);
+                                        free_t($2);}
+   | postfix_expr '(' arg_expr_lst ')' {$$ = node2(BinryNd, $4, $1, $3);
+                                        free_t($2);}
+   | postfix_expr '.' any_ident        {$$ = node2(BinryNd, $2, $1, $3);}
+   | postfix_expr Arrow any_ident      {$$ = node2(BinryNd, $2, $1, $3);}
+   | postfix_expr Incr                 {$$ = node1(PstfxNd, $2, $1);}
+   | postfix_expr Decr                 {$$ = node1(PstfxNd, $2, $1);}
+   | Is  ':' i_type_name '(' assign_expr ')'
+      {$$ = node2(BinryNd, $1, $3, $5); free_t($2); free_t($4); free_t($6);}
+   | Cnv ':' dest_type   '(' assign_expr ',' assign_expr ')'
+      {$$ = node3(TrnryNd, $1, $3, $5, $7), free_t($2); free_t($4); free_t($6);
+       free_t($8);}
+   | Def ':' dest_type   '(' assign_expr ',' assign_expr ',' assign_expr ')'
+      {$$ = node4(QuadNd, $1, $3, $5, $7, $9), free_t($2); free_t($4);
+       free_t($6); free_t($8); free_t($10);}
+   ;
+
+arg_expr_lst
+   : assign_expr
+   | arg_expr_lst ',' assign_expr {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+unary_expr
+   : postfix_expr
+   | Incr unary_expr          {$$ = node1(PrefxNd, $1, $2);}
+   | Decr unary_expr          {$$ = node1(PrefxNd, $1, $2);}
+   | unary_op cast_expr       {$$ = node1(PrefxNd, $1, $2);}
+   | Sizeof unary_expr        {$$ = node1(PrefxNd, $1, $2);}
+   | Sizeof '(' type_name ')' {$$ = node1(PrefxNd, $1, $3);
+                               free_t($2); free_t($4);}
+   ;
+
+unary_op
+   : '&'
+   | '*'
+   | '+'
+   | '-'
+   | '~'
+   | '!'
+   ;
+
+cast_expr
+   : unary_expr
+   | '(' type_name ')' cast_expr {$$ = node2(BinryNd, $1, $2, $4); free_t($3);}
+   ;
+
+multiplicative_expr
+   : cast_expr
+   | multiplicative_expr '*' cast_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | multiplicative_expr '/' cast_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | multiplicative_expr '%' cast_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+additive_expr
+   : multiplicative_expr
+   | additive_expr '+' multiplicative_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | additive_expr '-' multiplicative_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+shift_expr
+   : additive_expr
+   | shift_expr LShft additive_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | shift_expr RShft additive_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+relational_expr
+   : shift_expr
+   | relational_expr '<' shift_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | relational_expr '>' shift_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | relational_expr Leq shift_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | relational_expr Geq shift_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+equality_expr
+   : relational_expr
+   | equality_expr Equal relational_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   | equality_expr Neq   relational_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+and_expr
+   : equality_expr
+   | and_expr '&' equality_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+exclusive_or_expr
+   : and_expr
+   | exclusive_or_expr '^' and_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+inclusive_or_expr
+   : exclusive_or_expr
+   | inclusive_or_expr '|' exclusive_or_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+logical_and_expr
+   : inclusive_or_expr
+   | logical_and_expr And inclusive_or_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+logical_or_expr
+   : logical_and_expr
+   | logical_or_expr Or logical_and_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+conditional_expr
+   : logical_or_expr
+   | logical_or_expr '?' expr ':' conditional_expr
+                                         {$$ = node3(TrnryNd, $2, $1, $3, $5);
+                                          free_t($4);}
+   ;
+
+assign_expr
+   : conditional_expr
+   | unary_expr assign_op assign_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+assign_op
+   : '='
+   | MultAsgn
+   | DivAsgn
+   | ModAsgn
+   | PlusAsgn
+   | MinusAsgn
+   | LShftAsgn
+   | RShftAsgn
+   | AndAsgn
+   | XorAsgn
+   | OrAsgn
+   ;
+
+expr
+   : assign_expr
+   | expr ',' assign_expr {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+opt_expr
+   : {$$ = NULL;}
+   | expr
+   ;
+
+constant_expr
+   : conditional_expr
+   ;
+
+opt_constant_expr
+   : {$$ = NULL;}
+   | constant_expr
+   ;
+
+dcltion
+   :  typ_dcltion_specs ';'                 {$$ = node2(BinryNd, $2, $1, NULL);
+                                             dcl_stk->kind_dcl = OtherDcl;}
+   |  typ_dcltion_specs init_dcltor_lst ';' {$$ = node2(BinryNd, $3, $1, $2);
+                                             dcl_stk->kind_dcl = OtherDcl;}
+   |  storcl_tqual_lst no_tdn_init_dcltor_lst ';'
+                                            {$$ = node2(BinryNd, $3, $1, $2);
+                                             dcl_stk->kind_dcl = OtherDcl;}
+   ;
+
+typ_dcltion_specs
+   :                  type_ind
+   | storcl_tqual_lst type_ind {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+dcltion_specs
+   : typ_dcltion_specs
+   | storcl_tqual_lst
+   ;
+
+type_ind
+   : typedefname             {$$ = node0(PrimryNd, $1);}
+   | typedefname storcl_tqual_lst
+                             {$$ = node2(LstNd, NULL, node0(PrimryNd, $1), $2);}
+   | type_storcl_tqual_lst
+   ;
+
+type_storcl_tqual_lst
+   : stnd_type
+   | type_storcl_tqual_lst stnd_type          {$$ = node2(LstNd, NULL, $1, $2);}
+   | type_storcl_tqual_lst storage_class_spec {$$ = node2(LstNd, NULL, $1, $2);}
+   | type_storcl_tqual_lst type_qual          {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+storcl_tqual_lst
+   : storage_class_spec
+   | type_qual
+   | storcl_tqual_lst storage_class_spec {$$ = node2(LstNd, NULL, $1, $2);}
+   | storcl_tqual_lst type_qual          {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+init_dcltor_lst
+   : init_dcltor
+   | init_dcltor_lst ',' init_dcltor {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+no_tdn_init_dcltor_lst
+   : no_tdn_init_dcltor
+   | no_tdn_init_dcltor_lst ',' no_tdn_init_dcltor
+                                              {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+init_dcltor
+   : dcltor                 {$$ = $1; id_def($1, NULL);}
+   | dcltor '=' initializer {$$ = node2(BinryNd, $2, $1, $3); id_def($1, $3);}
+   ;
+
+no_tdn_init_dcltor
+   : no_tdn_dcltor            {$$ = $1; id_def($1, NULL);}
+   | no_tdn_dcltor '=' initializer
+                              {$$ = node2(BinryNd, $2, $1, $3); id_def($1, $3);}
+   ;
+
+storage_class_spec
+   : Typedef  {$$ = node0(PrimryNd, $1); dcl_stk->kind_dcl = IsTypedef;}
+   | Extern   {$$ = node0(PrimryNd, $1);}
+   | Static   {$$ = node0(PrimryNd, $1);}
+   | Auto     {$$ = node0(PrimryNd, $1);}
+   | Register {$$ = node0(PrimryNd, $1);}
+   ;
+
+type_spec
+   : stnd_type
+   | typedefname {$$ = node0(PrimryNd, $1);}
+   ;
+
+stnd_type
+   : Void                {$$ = node0(PrimryNd, $1);}
+   | Char                {$$ = node0(PrimryNd, $1);}
+   | Short               {$$ = node0(PrimryNd, $1);}
+   | Int                 {$$ = node0(PrimryNd, $1);}
+   | Long                {$$ = node0(PrimryNd, $1);}
+   | Float               {$$ = node0(PrimryNd, $1);}
+   | Doubl               {$$ = node0(PrimryNd, $1);}
+   | Signed              {$$ = node0(PrimryNd, $1);}
+   | Unsigned            {$$ = node0(PrimryNd, $1);}
+   | struct_or_union_spec
+   | enum_spec
+   ;
+
+struct_or_union_spec
+   : struct_or_union any_ident '{' struct_dcltion_lst '}'
+                                            {$$ = node2(BinryNd, $1, $2, $4);
+                                             free_t($3); free_t($5);}
+   | struct_or_union '{' struct_dcltion_lst '}'
+                                            {$$ = node2(BinryNd, $1, NULL, $3);
+                                             free_t($2); free_t($4);}
+   | struct_or_union any_ident              {$$ = node2(BinryNd, $1, $2, NULL);}
+   ;
+
+struct_or_union
+   : Struct
+   | Union
+   ;
+
+struct_dcltion_lst
+   : struct_dcltion
+   | struct_dcltion_lst struct_dcltion {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+struct_dcltion
+   : struct_dcltion_specs struct_dcltor_lst ';'
+                                              {$$ = node2(BinryNd, $3, $1, $2);}
+   | tqual_lst struct_no_tdn_dcltor_lst ';'   {$$ = node2(BinryNd, $3, $1, $2);}
+   ;
+
+struct_dcltion_specs
+   :           struct_type_ind
+   | tqual_lst struct_type_ind  {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+struct_type_ind
+   : typedefname            {$$ = node0(PrimryNd, $1);}
+   | typedefname tqual_lst  {$$ = node2(LstNd, NULL, node0(PrimryNd, $1), $2);}
+   | struct_type_lst
+   ;
+
+struct_type_lst
+   : stnd_type
+   | struct_type_lst stnd_type {$$ = node2(LstNd, NULL, $1, $2);}
+   | struct_type_lst type_qual {$$ = node2(LstNd, NULL, $1, $2);} ;
+
+struct_dcltor_lst
+   : struct_dcltor
+   | struct_dcltor_lst ',' struct_dcltor {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+struct_dcltor
+   : dcltor                   {$$ = node2(StrDclNd, NULL, $1, NULL);
+                               if (dcl_stk->parms_done) pop_cntxt();}
+   |        ':' constant_expr {$$ = node2(StrDclNd, $1, NULL, $2);}
+   | dcltor ':' {if (dcl_stk->parms_done) pop_cntxt();} constant_expr
+                              {$$ = node2(StrDclNd, $2, $1, $4);}
+   ;
+
+struct_no_tdn_dcltor_lst
+   : struct_no_tdn_dcltor
+   | struct_no_tdn_dcltor_lst ',' struct_no_tdn_dcltor
+                                              {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+struct_no_tdn_dcltor
+   : no_tdn_dcltor                   {$$ = node2(StrDclNd, NULL, $1, NULL);
+                                      if (dcl_stk->parms_done) pop_cntxt();}
+   |               ':' constant_expr {$$ = node2(StrDclNd, $1, NULL, $2);}
+   | no_tdn_dcltor ':' {if (dcl_stk->parms_done) pop_cntxt();} constant_expr
+                                     {$$ = node2(StrDclNd, $2, $1, $4);}
+   ;
+
+enum_spec
+   : Enum {push_cntxt(0);} '{' enumerator_lst '}'
+       {$$ = node2(BinryNd, $1, NULL, $4); pop_cntxt(); free_t($3); free_t($5);}
+   | Enum any_ident {push_cntxt(0);} '{' enumerator_lst '}'
+       {$$ = node2(BinryNd, $1, $2,  $5); pop_cntxt(); free_t($4); free_t($6);}
+   | Enum any_ident {$$ = node2(BinryNd, $1, $2,  NULL);}
+   ;
+
+enumerator_lst
+   : enumerator
+   | enumerator_lst ',' enumerator {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+enumerator
+   : any_ident                {$$ = $1; id_def($1, NULL);}
+   | any_ident '=' constant_expr
+                              {$$ = node2(BinryNd, $2, $1, $3); id_def($1, $3);}
+   ;
+
+type_qual
+   : Const    {$$ = node0(PrimryNd, $1);}
+   | Volatile {$$ = node0(PrimryNd, $1);}
+   ;
+
+
+dcltor
+   : opt_pointer direct_dcltor  {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+no_tdn_dcltor
+   : opt_pointer no_tdn_direct_dcltor {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+direct_dcltor
+   : any_ident
+   | '(' dcltor ')'                           {$$ = node1(PrefxNd, $1, $2);
+                                               free_t($3);}
+   | direct_dcltor '[' opt_constant_expr  ']' {$$ = node2(BinryNd, $2, $1, $3);
+                                               free_t($4);}
+   | direct_dcltor '(' {push_cntxt(1);} parm_dcls_or_ids ')'
+                                              {$$ = node2(BinryNd, $5, $1, $4);
+                                               if (dcl_stk->nest_lvl == 2)
+                                                  dcl_stk->parms_done = 1;
+                                                else
+                                                  pop_cntxt();
+                                               free_t($2);}
+   ;
+
+no_tdn_direct_dcltor
+   : identifier                               {$$ = node0(PrimryNd, $1);}
+   | '(' no_tdn_dcltor ')'                    {$$ = node1(PrefxNd, $1, $2);
+                                               free_t($3);}
+   | no_tdn_direct_dcltor '[' opt_constant_expr  ']'
+                                              {$$ = node2(BinryNd, $2, $1, $3);
+                                               free_t($4);}
+   | no_tdn_direct_dcltor '(' {push_cntxt(1);} parm_dcls_or_ids ')'
+                                              {$$ = node2(BinryNd, $5, $1, $4);
+                                               if (dcl_stk->nest_lvl == 2)
+                                                  dcl_stk->parms_done = 1;
+                                                else
+                                                  pop_cntxt();
+                                               free_t($2);}
+   ;
+
+parm_dcls_or_ids
+   : opt_param_type_lst
+   | ident_lst
+   ;
+
+pointer
+   : '*'                   {$$ = node0(PrimryNd, $1);}
+   | '*' tqual_lst         {$$ = node1(PreSpcNd, $1, $2);}
+   | '*' pointer           {$$ = node1(PrefxNd, $1, $2);}
+   | '*' tqual_lst pointer {$$ = node1(PrefxNd, $1, node2(LstNd, NULL, $2,$3));}
+   ;
+
+opt_pointer
+   : {$$ = NULL;}
+   | pointer
+   ;
+
+tqual_lst
+   : type_qual
+   | tqual_lst type_qual {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+param_type_lst
+   : param_lst
+   | param_lst ',' Ellipsis {$$ = node2(CommaNd, $2, $1, node0(PrimryNd, $3));}
+   ;
+
+opt_param_type_lst
+   : {$$ = NULL;}
+   | param_type_lst
+   ;
+
+param_lst
+   : param_dcltion
+   | param_lst ',' param_dcltion {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+param_dcltion
+   : dcltion_specs no_tdn_dcltor   {$$ = node2(LstNd, NULL, $1, $2);
+                                    id_def($2, NULL);}
+   | dcltion_specs
+   | dcltion_specs abstract_dcltor {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+ident_lst
+   : identifier               {$$ = node0(PrimryNd, $1);}
+   | ident_lst ',' identifier {$$ = node2(CommaNd, $2, $1, node0(PrimryNd,$3));}
+   ;
+
+type_tqual_lst
+   : type_spec
+   | type_qual
+   | type_spec type_tqual_lst {$$ = node2(LstNd, NULL, $1, $2);}
+   | type_qual type_tqual_lst {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+type_name
+   : type_tqual_lst
+   | type_tqual_lst abstract_dcltor {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+abstract_dcltor
+   : pointer
+   | opt_pointer direct_abstract_dcltor {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+direct_abstract_dcltor
+   : '(' abstract_dcltor ')'                {$$ = node1(PrefxNd, $1, $2);
+                                             free_t($3);}
+   |                        '[' opt_constant_expr  ']'
+                                            {$$ = node2(BinryNd, $1, NULL, $2);
+                                             free_t($3);}
+   | direct_abstract_dcltor '[' opt_constant_expr  ']'
+                                            {$$ = node2(BinryNd, $2, $1, $3);
+                                             free_t($4);}
+   |                        '(' {push_cntxt(1);} opt_param_type_lst ')'
+                                            {$$ = node2(BinryNd, $4, NULL, $3);
+                                             pop_cntxt();
+                                             free_t($1);}
+   | direct_abstract_dcltor '(' {push_cntxt(1);} opt_param_type_lst ')'
+                                            {$$ = node2(BinryNd, $5, $1, $4);
+                                             pop_cntxt();
+                                             free_t($2);}
+   ;
+
+initializer
+   : assign_expr
+   | '{' initializer_lst '}'
+                        {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   | '{' initializer_lst ',' '}'
+                        {$$ = node1(PrefxNd, $1, node2(CommaNd, $3, $2, NULL));
+                          free_t($4);}
+   ;
+
+initializer_lst
+   : initializer
+   | initializer_lst ',' initializer {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+stmt
+   : labeled_stmt
+   | non_lbl_stmt
+   ;
+
+non_lbl_stmt
+   : {push_cntxt(1);} compound_stmt {$$ = $2; pop_cntxt();}
+   | expr_stmt
+   | selection_stmt
+   | iteration_stmt
+   | jump_stmt
+   | Runerr '(' assign_expr ')' ';'
+      {$$ = node2(BinryNd, $1, $3, NULL); free_t($2); free_t($4);}
+   | Runerr '(' assign_expr ',' assign_expr ')' ';'
+      {$$ = node2(BinryNd, $1, $3, $5); free_t($2); free_t($4); free_t($6);}
+   ;
+
+labeled_stmt
+   : label ':' stmt              {$$ = node2(BinryNd, $2, $1, $3);}
+   | Case constant_expr ':' stmt {$$ = node2(BinryNd, $1, $2, $4); free_t($3);}
+   | Default ':' stmt            {$$ = node1(PrefxNd, $1, $3); free_t($2);}
+   ;
+
+compound_stmt
+   : '{'            opt_stmt_lst '}' {$$ = comp_nd($1, NULL, $2); free_t($3);}
+   | '{' local_dcls opt_stmt_lst '}' {$$ = comp_nd($1, $2,   $3); free_t($4);}
+   ;
+
+dcltion_lst
+   : dcltion
+   | dcltion_lst dcltion {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+opt_dcltion_lst
+   : {$$ = NULL;}
+   | dcltion_lst
+   ;
+
+local_dcls
+   : local_dcl
+   | local_dcls local_dcl {$$ = ($2 == NULL ? $1 : node2(LstNd, NULL, $1, $2));}
+   ;
+
+local_dcl
+   : dcltion
+   | Tended tended_type init_dcltor_lst ';'
+             {$$ = NULL; free_t($1); free_t($4); dcl_stk->kind_dcl = OtherDcl;}
+   ;
+
+tended_type
+   : Char		{tnd_char(); free_t($1);}
+   | Struct identifier  {tnd_strct($2); free_t($1);}
+   | Struct TypeDefName {tnd_strct($2); free_t($1);}
+   | Union  identifier  {tnd_union($2); free_t($1);}
+   ;
+
+stmt_lst
+   : stmt
+   | stmt_lst stmt {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+opt_stmt_lst
+   : {$$ = NULL;}
+   | stmt_lst
+   ;
+expr_stmt
+   : opt_expr ';' {$$ = node1(PstfxNd, $2, $1);}
+   ;
+
+selection_stmt
+   : If '(' expr ')' stmt   %prec IfStmt {$$ = node3(TrnryNd, $1, $3, $5,NULL);
+                                          free_t($2); free_t($4);}
+   | If '(' expr ')' stmt Else stmt      {$$ = node3(TrnryNd, $1, $3, $5, $7);
+                                          free_t($2); free_t($4); free_t($6);}
+   | Switch '(' expr ')' stmt            {$$ = node2(BinryNd, $1, $3, $5);
+                                          free_t($2); free_t($4);}
+   | Type_case expr Of '{' c_type_select_lst c_opt_default '}'
+      {$$ = node3(TrnryNd, $1, $2, $5, $6); free_t($3); free_t($4); free_t($7);}
+   ;
+
+c_type_select_lst
+   :                   c_type_select {$$ = node2(ConCatNd, NULL, NULL, $1);}
+   | c_type_select_lst c_type_select {$$ = node2(ConCatNd, NULL,   $1, $2);}
+   ;
+
+c_type_select
+   : selector_lst non_lbl_stmt {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+c_opt_default
+   : {$$ = NULL;}
+   | Default ':' non_lbl_stmt {$$ = $3; free_t($1); free_t($2);}
+   ;
+
+iteration_stmt
+   : While '(' expr ')' stmt           {$$ = node2(BinryNd, $1, $3, $5);
+                                        free_t($2); free_t($4);}
+   | Do stmt While '(' expr ')' ';'    {$$ = node2(BinryNd, $1, $2, $5);
+                                        free_t($3); free_t($4); free_t($6);
+                                        free_t($7);}
+   | For '(' opt_expr ';' opt_expr ';' opt_expr ')' stmt
+                                       {$$ = node4(QuadNd, $1, $3, $5, $7, $9);
+                                        free_t($2); free_t($4); free_t($6);
+                                        free_t($8);}
+   ;
+
+jump_stmt
+   : Goto label';'       {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   | Continue ';'        {$$ = node0(PrimryNd, $1); free_t($2);}
+   | Break ';'           {$$ = node0(PrimryNd, $1); free_t($2);}
+   | Return ret_val ';'  {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   | Suspend ret_val ';' {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   | Fail ';'            {$$ = node0(PrimryNd, $1); free_t($2);}
+   | Errorfail ';'       {$$ = node0(PrimryNd, $1); free_t($2);}
+   ;
+
+translation_unit
+   :
+   | extrn_decltn_lst
+   ;
+
+extrn_decltn_lst
+   : external_dcltion
+   | extrn_decltn_lst external_dcltion
+   ;
+
+external_dcltion
+   : function_definition
+   | dcltion                {dclout($1);}
+   | definition
+   ;
+
+function_definition
+   : func_head {func_def($1);} opt_dcltion_lst compound_stmt
+                                                          {fncout($1, $3, $4);}
+   ;
+
+func_head
+   :                   no_tdn_dcltor {$$ = node2(LstNd, NULL, NULL, $1);}
+   | storcl_tqual_lst  no_tdn_dcltor {$$ = node2(LstNd, NULL, $1, $2);}
+   | typ_dcltion_specs dcltor        {$$ = node2(LstNd, NULL, $1, $2);}
+   ;
+
+any_ident
+   : identifier  {$$ = node0(PrimryNd, $1);}
+   | typedefname {$$ = node0(PrimryNd, $1);}
+   ;
+
+label
+   : identifier  {$$ = lbl($1);}
+   | typedefname {$$ = lbl($1);}
+   ;
+
+typedefname
+   : TypeDefName
+   | C_Integer /* hack to allow C_integer to be defined with typedef */
+   | C_Double  /* for consistency with C_integer */
+   | C_String  /* for consistency with C_integer */
+   ;
+
+/*
+ * The rest of the grammar implements the interface portion of the language.
+ */
+
+definition
+   : {strt_def();} description operation
+   ;
+
+operation
+   : fnc_oper op_declare actions End {defout($3); free_t($4);}
+   | keyword             actions End {defout($2); free_t($3);}
+   | keyword Constant key_const  End {keyconst($3); free_t($2); free_t($4);}
+   ;
+
+description
+   :         {comment = NULL;}
+   | StrLit  {comment = $1;}
+   ;
+
+fnc_oper
+   : Function '{' result_seq '}' op_name '(' opt_s_parm_lst ')'
+      {impl_fnc($5); free_t($1); free_t($2); free_t($4); free_t($6);
+       free_t($8);}
+   | Operator '{' result_seq {lex_state = OpHead;} '}' OpSym
+      {lex_state = DfltLex;} op_name '(' opt_s_parm_lst ')'
+      {impl_op($6, $8); free_t($1); free_t($2); free_t($5); free_t($9);
+       free_t($11);}
+
+keyword
+   : Keyword  '{' result_seq '}' op_name
+       {impl_key($5); free_t($1); free_t($2); free_t($4);}
+   ;
+
+key_const
+   : StrLit
+   | CharConst
+   | DblConst
+   | IntConst
+   ;
+
+/*
+ * Allow as many special names to be identifiers as possible
+ */
+identifier
+   : Abstract
+   | All_fields
+   | Any_value
+   | Body
+   | Component
+   | Declare
+   | Empty_type
+   | End
+   | Exact
+   | IconType
+   | Identifier
+   | Inline
+   | Named_var
+   | New
+   | Of
+   | Store
+   | Struct_var
+   | Then
+   | Tmp_cset
+   | Tmp_string
+   | Type
+   | Underef
+   | Variable
+   ;
+
+/*
+ * an operation may be given any name.
+ */
+op_name
+   : identifier
+   | typedefname
+   | Auto
+   | Break
+   | Case
+   | Char
+   | Cnv
+   | Const
+   | Continue
+   | Def
+   | Default
+   | Do
+   | Doubl
+   | Else
+   | Enum
+   | Errorfail
+   | Extern
+   | Fail
+   | Float
+   | For
+   | Function
+   | Goto
+   | If
+   | Int
+   | Is
+   | Keyword
+   | Long
+   | Operator
+   | Register
+   | Return
+   | Runerr
+   | Short
+   | Signed
+   | Sizeof
+   | Static
+   | Struct
+   | Suspend
+   | Switch
+   | Tended
+   | Typedef
+   | Union
+   | Unsigned
+   | Void
+   | Volatile
+   | While
+   ;
+
+result_seq
+   :                            {set_r_seq(NoRsltSeq, NoRsltSeq, 0);}
+   | length            opt_plus {set_r_seq($1, $1, (int)$2);}
+   | length ',' length opt_plus {set_r_seq($1, $3, (int)$4); free_t($2);}
+   ;
+
+length
+   : IntConst {$$ = ttol($1); free_t($1);}
+   | '*'      {$$ = UnbndSeq; free_t($1);}
+   ;
+
+opt_plus
+   :     {$$ = 0;}
+   | '+' {$$ = 1; free_t($1);}
+   ;
+
+opt_s_parm_lst
+   :
+   | s_parm_lst
+   | s_parm_lst '[' identifier ']' {var_args($3); free_t($2); free_t($4);}
+   ;
+
+s_parm_lst
+   : s_parm
+   | s_parm_lst ',' s_parm {free_t($2);}
+   ;
+
+s_parm
+   :                          identifier {s_prm_def(NULL, $1);}
+   | Underef identifier                  {s_prm_def($2, NULL); free_t($1);}
+   | Underef identifier Arrow identifier {s_prm_def($2, $4);   free_t($1);
+                                          free_t($3);}
+   ;
+
+op_declare
+   : {}
+   | Declare '{' local_dcls '}' {d_lst_typ($3); free_t($1); free_t($2);
+                                 free_t($4);}
+   ;
+
+opt_actions
+   : {$$ = NULL;}
+   | actions
+   ;
+
+actions
+   : action
+   | actions action {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+action
+   : checking_conversions
+   | detail_code
+   | runerr
+   | '{' opt_actions '}' {$$ = node1(PrefxNd, $1, $2); free_t($3);}
+   | Abstract {lex_state = TypeComp;} '{' type_computations
+         {lex_state = DfltLex;} '}'
+         {$$ = $4; free_t($1); free_t($3); free_t($6);}
+   ;
+
+checking_conversions
+   : If type_check Then action %prec IfStmt
+      {$$ = node3(TrnryNd, $1, $2, $4, NULL); free_t($3);}
+   | If type_check Then action Else action
+      {$$ = node3(TrnryNd, $1, $2, $4, $6); free_t($3); free_t($5);}
+   | Type_case variable Of '{' type_select_lst opt_default '}'
+      {$$ = node3(TrnryNd, $1, $2, $5, $6); free_t($3); free_t($4); free_t($7);}
+   | Len_case identifier Of '{' len_select_lst Default ':' action '}'
+      {$$ = node3(TrnryNd, $1, sym_node($2), $5, $8); free_t($3), free_t($4);
+       free_t($6); free_t($7); free_t($9);}
+   | Arith_case '(' variable ',' variable ')' Of '{'
+      dest_type ':' action dest_type ':' action dest_type ':' action '}'
+      {$$ = arith_nd($1, $3, $5, $9, $11, $12, $14, $15, $17); free_t($2);
+       free_t($4), free_t($6); free_t($7); free_t($8); free_t($10);
+       free_t($13); free_t($16); free_t($18);}
+   ;
+
+type_select_lst
+   :                 type_select {$$ = node2(ConCatNd, NULL, NULL, $1);}
+   | type_select_lst type_select {$$ = node2(ConCatNd, NULL,   $1, $2);}
+   ;
+
+type_select
+   : selector_lst action {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+opt_default
+   : {$$ = NULL;}
+   | Default ':' action {$$ = $3; free_t($1); free_t($2);}
+   ;
+
+selector_lst
+   :              i_type_name ':' {$$ = node2(ConCatNd, NULL, NULL, $1);
+                                   free_t($2);}
+   | selector_lst i_type_name ':' {$$ = node2(ConCatNd, NULL,   $1, $2);
+                                   free_t($3);}
+   ;
+
+len_select_lst
+   : len_select
+   | len_select_lst len_select {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+len_select
+   : IntConst ':' action {$$ = node1(PrefxNd, $1, $3); free_t($2);}
+   ;
+
+type_check
+   : simple_check_conj
+   | '!' simple_check  {$$ = node1(PrefxNd, $1, $2);}
+   ;
+
+simple_check_conj
+   : simple_check
+   | simple_check_conj And simple_check {$$ = node2(BinryNd, $2, $1, $3);}
+   ;
+
+simple_check
+   : Is ':' i_type_name '(' variable ')'
+      {$$ = node2(BinryNd, $1, $3, $5); free_t($2); free_t($4); free_t($6);}
+   | Cnv ':' dest_type '(' variable ')'
+      {$$ = node3(TrnryNd, $1, $3, $5, NULL), dst_alloc($3, $5); free_t($2);
+       free_t($4); free_t($6);}
+   | Cnv ':' dest_type '(' variable  ',' assign_expr ')'
+      {$$ = node3(TrnryNd, $1, $3, $5, $7), free_t($2); free_t($4); free_t($6);
+       free_t($8);}
+   | Def ':' dest_type '(' variable  ',' assign_expr ')'
+      {$$ = node4(QuadNd, $1, $3, $5, $7, NULL), dst_alloc($3, $5); free_t($2);
+       free_t($4); free_t($6); free_t($8);}
+   | Def ':' dest_type '(' variable  ',' assign_expr ',' assign_expr ')'
+      {$$ = node4(QuadNd, $1, $3, $5, $7, $9), free_t($2); free_t($4);
+       free_t($6); free_t($8); free_t($10);}
+   ;
+
+detail_code
+   : Body   {push_cntxt(1);} compound_stmt
+                        {$$ = node1(PrefxNd, $1, $3); pop_cntxt();}
+   | Inline {push_cntxt(1);} compound_stmt
+                        {$$ = node1(PrefxNd, $1, $3); pop_cntxt();}
+   ;
+
+runerr
+   : Runerr '(' IntConst ')' opt_semi
+                    {$$ = node2(BinryNd, $1, node0(PrimryNd, $3), NULL);
+                     free_t($2); free_t($4);}
+   | Runerr '(' IntConst ',' variable ')' opt_semi
+                    {$$ = node2(BinryNd, $1, node0(PrimryNd, $3), $5);
+                     free_t($2); free_t($4); free_t($6);}
+   ;
+
+opt_semi
+   :
+   | ';' {free_t($1);}
+   ;
+
+variable
+   : identifier                  {$$ = sym_node($1);}
+   | identifier '[' IntConst ']' {$$ = node2(BinryNd, $2, sym_node($1),
+                                    node0(PrimryNd, $3));
+                                  free_t($4);}
+
+dest_type
+   : IconType                {$$ = dest_node($1);}
+   | C_Integer               {$$ = node0(PrimryNd, $1);}
+   | C_Double                {$$ = node0(PrimryNd, $1);}
+   | C_String                {$$ = node0(PrimryNd, $1);}
+   | Tmp_string              {$$ = node0(PrimryNd, $1); ++n_tmp_str;}
+   | Tmp_cset                {$$ = node0(PrimryNd, $1); ++n_tmp_cset;}
+   | '(' Exact ')' IconType  {$$ = node0(ExactCnv, chk_exct($4)); free_t($1);
+                              free_t($2); free_t($3);}
+   | '(' Exact ')' C_Integer {$$ = node0(ExactCnv, $4); free_t($1); free_t($2);
+                              free_t($3);}
+   ;
+
+i_type_name
+   : Any_value  {$$ = node0(PrimryNd, $1);}
+   | Empty_type {$$ = node0(PrimryNd, $1);}
+   | IconType   {$$ = sym_node($1);}
+   | Variable   {$$ = node0(PrimryNd, $1);}
+   ;
+
+ret_val
+   : opt_expr
+   | C_Integer assign_expr             {$$ = node1(PrefxNd, $1, $2);}
+   | C_Double assign_expr              {$$ = node1(PrefxNd, $1, $2);}
+   | C_String assign_expr              {$$ = node1(PrefxNd, $1, $2);}
+   ;
+
+type_computations
+   : side_effect_lst Return type opt_semi {$$ = node2(AbstrNd, $2,   $1,   $3);}
+   |                 Return type opt_semi {$$ = node2(AbstrNd, $1,   NULL, $2);}
+   | side_effect_lst                      {$$ = node2(AbstrNd, NULL, $1, NULL);}
+   ;
+
+side_effect_lst
+   : side_effect
+   | side_effect_lst side_effect {$$ = node2(ConCatNd, NULL, $1, $2);}
+   ;
+
+side_effect
+   : Store '[' type ']' '=' type opt_semi {$$ = node2(BinryNd, $5, $3, $6);
+                                           free_t($1); free_t($2); free_t($4);}
+   ;
+
+type
+   : basic_type
+   | type union basic_type     {$$ = node2(BinryNd, $2, $1, $3);}
+   | type Intersect basic_type {$$ = node2(BinryNd, $2, $1, $3);}
+
+basic_type
+   : i_type_name                        {$$ = node1(IcnTypNd,
+                                         copy_t($1->tok), $1);}
+   | Type '(' variable ')'              {$$ = node1(PrefxNd, $1, $3);
+                                         free_t($2); free_t($4);}
+   | New i_type_name '(' type_lst ')'   {$$ = node2(BinryNd, $1, $2, $4);
+                                         free_t($3); free_t($5);}
+   | Store '[' type ']'                 {$$ = node1(PrefxNd, $1, $3);
+                                         free_t($2); free_t($4);}
+   | basic_type '.' attrb_name          {$$ = node1(PstfxNd, $3, $1);
+                                         free_t($2);}
+   | '(' type ')'                       {$$ = $2; free_t($1); free_t($3);}
+   ;
+
+union
+   : Incr
+   ;
+
+type_lst
+   : type
+   | type_lst ',' type {$$ = node2(CommaNd, $2, $1, $3);}
+   ;
+
+attrb_name
+   : Component
+   | All_fields
+   ;
+
+%%
+
+/*
+ * 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)
diff --git a/src/rtt/rttilc.c b/src/rtt/rttilc.c
new file mode 100644
index 0000000..70839ef
--- /dev/null
+++ b/src/rtt/rttilc.c
@@ -0,0 +1,1402 @@
+/*
+ * rttilc.c - routines to construct pieces of C code to put in the data base
+ *  as in-line code.
+ *
+ * In-line C code is represented internally as a linked list of structures.
+ * The information contained in each structure depends on the type of code
+ * being represented. Some structures contain other fragments of C code.
+ * Code that does not require special processing is stored as strings. These
+ * strings are accumulated in a buffer until it is full or code that cannot
+ * be represented as a string must be produced. At that point, the string
+ * in placed in a structure and put on the list.
+ */
+#include "rtt.h"
+
+#ifndef Rttx
+
+/*
+ * prototypes for static functions.
+ */
+static void add_ptr   (struct node *dcltor);
+static void alloc_ilc (int il_c_type);
+static void flush_str (void);
+static void ilc_chnl  (struct token *t);
+static void ilc_cnv   (struct node *cnv_typ, struct node *src,
+                           struct node *dflt, struct node *dest);
+static void ilc_cgoto (int neg, struct node *cond, word lbl);
+static void ilc_goto  (word lbl);
+static void ilc_lbl   (word lbl);
+static void ilc_ret   (struct token *t, int ilc_typ, struct node *n);
+static void ilc_str   (char *s);
+static void ilc_tok   (struct token *t);
+static void ilc_var   (struct sym_entry *sym, int just_desc, int may_mod);
+static void ilc_walk  (struct node *n, int may_mod, int const_cast);
+static void init_ilc  (void);
+static void insrt_str (void);
+static void new_ilc   (int il_c_type);
+static	struct	il_c	*sep_ilc	(char *s1,struct node *n,char *s2);
+
+#define SBufSz 256
+
+static char sbuf[SBufSz];      /* buffer for constructing fragments of code */
+static int nxt_char;           /* next position in sbuf */
+static struct token *line_ref; /* "recent" token for comparing line number */
+static struct il_c ilc_base;   /* base for list of in-line C code */
+static struct il_c *ilc_cur;   /* current end of list of in-line C code */
+static int insert_nl;          /* flag: new-line should be inserted in code */
+static word cont_lbl = 0;      /* destination label for C continue statement */
+static word brk_lbl = 0;       /* destination label for C break statement */
+
+/*
+ * inlin_c - Create a self-contained piece of in-line C code from a syntax
+ *   sub-tree.
+ */
+struct il_c *inlin_c(n, may_mod)
+struct node *n;
+int may_mod;
+   {
+   init_ilc();              /* initialize code list and string buffer */
+   ilc_walk(n, may_mod, 0); /* translate the syntax sub-tree */
+   flush_str();            /* flush string buffer to code list */
+   return ilc_base.next;
+   }
+
+/*
+ * simpl_dcl - produce a simple declaration both in the output file and as
+ *   in-line C code.
+ */
+struct il_c *simpl_dcl(tqual, addr_of, sym)
+char *tqual;
+int addr_of;
+struct sym_entry *sym;
+   {
+   init_ilc();             /* initialize code list and string buffer */
+   prt_str(tqual, 0);
+   ilc_str(tqual);
+   if (addr_of) {
+      prt_str("*", 0);
+      ilc_str("*");
+      }
+   prt_str(sym->image, 0);
+   ilc_str(sym->image);
+   prt_str(";", 0);
+   ForceNl();
+   flush_str();            /* flush string buffer to code list */
+   return ilc_base.next;
+   }
+
+/*
+ * parm_dcl - produce the declaration for a parameter to a body function.
+ *   Print it in the output file and proceduce in-line C code for it.
+ */
+struct il_c *parm_dcl(addr_of, sym)
+int addr_of;
+struct sym_entry *sym;
+   {
+   init_ilc();        /* initialize code list and string buffer */
+
+   /*
+    * Produce type-qualifier list, but without non-type information.
+    */
+   just_type(sym->u.declare_var.tqual, 0, 1);
+   prt_str(" ", 0);
+   ilc_str(" ");
+
+   /*
+    * If the caller requested another level of indirection on the
+    *  declaration add it.
+    */
+   if (addr_of)
+      add_ptr(sym->u.declare_var.dcltor);
+   else {
+      c_walk(sym->u.declare_var.dcltor, 0, 0);
+      ilc_walk(sym->u.declare_var.dcltor, 0, 0);
+      }
+   prt_str(";", 0);
+   ForceNl();
+   flush_str();       /* flush string buffer to code list */
+   return ilc_base.next;
+   }
+
+/*
+ * add_ptr - add another level of indirection to a declarator. Print it in
+ *   the output file and proceduce in-line C code.
+ */
+static void add_ptr(dcltor)
+struct node *dcltor;
+   {
+   while (dcltor->nd_id == ConCatNd) {
+      c_walk(dcltor->u[0].child, IndentInc, 0);
+      ilc_walk(dcltor->u[0].child, 0, 0);
+      dcltor = dcltor->u[1].child;
+      }
+   switch (dcltor->nd_id) {
+      case PrimryNd:
+         /*
+          * We have reached the name, add a level of indirection.
+          */
+         prt_str("(*", IndentInc);
+         ilc_str("(*");
+         prt_str(dcltor->tok->image, IndentInc);
+         ilc_str(dcltor->tok->image);
+         prt_str(")", IndentInc);
+         ilc_str(")");
+         break;
+      case PrefxNd:
+         /*
+          * (...)
+          */
+         prt_str("(", IndentInc);
+         ilc_str("(");
+         add_ptr(dcltor->u[0].child);
+         prt_str(")", IndentInc);
+         ilc_str(")");
+         break;
+      case BinryNd:
+         if (dcltor->tok->tok_id == ')') {
+            /*
+             * Function declaration.
+             */
+            add_ptr(dcltor->u[0].child);
+            prt_str("(", IndentInc);
+            ilc_str("(");
+            c_walk(dcltor->u[1].child, IndentInc, 0);
+            ilc_walk(dcltor->u[1].child, 0, 0);
+            prt_str(")", IndentInc);
+            ilc_str(")");
+            }
+         else {
+            /*
+             * Array.
+             */
+            add_ptr(dcltor->u[0].child);
+            prt_str("[", IndentInc);
+            ilc_str("[");
+            c_walk(dcltor->u[1].child, IndentInc, 0);
+            ilc_walk(dcltor->u[1].child, 0, 0);
+            prt_str("]", IndentInc);
+            ilc_str("]");
+            }
+      }
+   }
+
+/*
+ * bdy_prm - produce the code that must be be supplied as the argument
+ *  to the call of a body function.
+ */
+struct il_c *bdy_prm(addr_of, just_desc, sym, may_mod)
+int addr_of;
+int just_desc;
+struct sym_entry *sym;
+int may_mod;
+   {
+   init_ilc();              /* initialize code list and string buffer */
+   if (addr_of)
+      ilc_str("&(");                  /* call-by-reference parameter */
+   ilc_var(sym, just_desc, may_mod);  /* variable to pass as argument */
+   if (addr_of)
+      ilc_str(")");
+   flush_str();             /* flush string buffer to code list */
+   return ilc_base.next;
+   }
+
+/*
+ * ilc_dcl - produce in-line code for a C declaration.
+ */
+struct il_c *ilc_dcl(tqual, dcltor, init)
+struct node *tqual;
+struct node *dcltor;
+struct node *init;
+   {
+   init_ilc();              /* initialize code list and string buffer */
+   ilc_walk(tqual, 0, 0);
+   ilc_str(" ");
+   ilc_walk(dcltor, 0, 0);
+   if (init != NULL) {
+      ilc_str(" = ");
+      ilc_walk(init, 0, 0);
+      }
+   ilc_str(";");
+   flush_str();             /* flush string buffer to code list */
+   return ilc_base.next;
+   }
+
+
+/*
+ *  init_ilc - initialize the code list by pointing to ilc_base. Initialize
+ *   the string buffer.
+ */
+static void init_ilc()
+   {
+   nxt_char = 0;
+   line_ref = NULL;
+   insert_nl = 0;
+   ilc_base.il_c_type = 0;
+   ilc_base.next = NULL;
+   ilc_cur = &ilc_base;
+   }
+
+
+/*
+ * - ilc_chnl - check for new-line.
+ */
+static void ilc_chnl(t)
+struct token *t;
+   {
+   /*
+    * See if this is a reasonable place to put a newline.
+    */
+   if (t->flag & LineChk) {
+      if (line_ref != NULL &&
+         (t->fname != line_ref->fname || t->line != line_ref->line))
+            insert_nl = 1;
+      line_ref = t;
+      }
+   }
+
+/*
+ * ilc_tok - convert a token to its string representation, quoting it
+ *  if it is a string or character literal.
+ */
+static void ilc_tok(t)
+struct token *t;
+   {
+   char *s;
+
+   ilc_chnl(t);
+   s = t->image;
+   switch (t->tok_id) {
+      case StrLit:
+         ilc_str("\"");
+         ilc_str(s);
+         ilc_str("\"");
+         break;
+      case LStrLit:
+         ilc_str("L\"");
+         ilc_str(s);
+         ilc_str("\"");
+         break;
+      case CharConst:
+         ilc_str("'");
+         ilc_str(s);
+         ilc_str("'");
+         break;
+      case LCharConst:
+         ilc_str("L'");
+         ilc_str(s);
+         ilc_str("'");
+         break;
+      default:
+         ilc_str(s);
+      }
+   }
+
+/*
+ * ilc_str - append a string to the string buffer.
+ */
+static void ilc_str(s)
+char *s;
+   {
+   /*
+    * see if a new-line is needed before the string
+    */
+   if (insert_nl && (nxt_char == 0 || sbuf[nxt_char - 1] != '\n')) {
+      insert_nl = 0;
+      ilc_str("\n");
+      }
+
+   /*
+    * Put the string in the buffer. If the buffer is full, flush it
+    *  to an element in the in-line code list.
+    */
+   while (*s != '\0') {
+      if (nxt_char >= SBufSz - 1)
+         insrt_str();
+      sbuf[nxt_char++] = *s++;
+      }
+   }
+
+/*
+ * insrt_str - insert the string in the buffer into the list of in-line
+ *  code.
+ */
+static void insrt_str()
+   {
+   alloc_ilc(ILC_Str);
+   sbuf[nxt_char] = '\0';
+   ilc_cur->s = salloc(sbuf);
+   nxt_char = 0;
+   }
+
+/*
+ * flush_str - if the string buffer is not empty, flush it to the list
+ *  of in-line code.
+ */
+static void flush_str()
+   {
+   if (insert_nl)
+      ilc_str("");
+   if (nxt_char != 0)
+      insrt_str();
+   }
+
+/*
+ * new_ilc - create a new element for the list of in-line C code. This
+ *   is called for non-string elements. If necessary it flushes the
+ *   string buffer to another element first.
+ */
+static void new_ilc(il_c_type)
+int il_c_type;
+   {
+   flush_str();
+   alloc_ilc(il_c_type);
+   }
+
+/*
+ * alloc_ilc - allocate a new element for the list of in-line C code
+ *   and add it to the list.
+ */
+static void alloc_ilc(il_c_type)
+int il_c_type;
+   {
+   int i;
+   ilc_cur->next = NewStruct(il_c);
+   ilc_cur = ilc_cur->next;
+   ilc_cur->next = NULL;
+   ilc_cur->il_c_type = il_c_type;
+   for (i = 0; i < 3; ++i)
+      ilc_cur->code[i] = NULL;
+   ilc_cur->n = 0;
+   ilc_cur->s = NULL;
+   }
+
+/*
+ * sep_ilc - translate the syntax tree, n, (possibly surrounding it by
+ *  strings) into a sub-list of in-line C code, remove the sub-list from
+ *  the main list, and return it.
+ */
+static struct il_c *sep_ilc(s1, n, s2)
+char *s1;
+struct node *n;
+char *s2;
+   {
+   struct il_c *ilc;
+
+   ilc = ilc_cur;     /* remember the starting point in the main list */
+   if (s1 != NULL)
+      ilc_str(s1);
+   ilc_walk(n, 0, 0);
+   if (s2 != NULL)
+      ilc_str(s2);
+   flush_str();
+
+   /*
+    * Reset the main list to its condition upon entry, and return the sublist
+    *   created from s1, n, and s2.
+    */
+   ilc_cur = ilc;
+   ilc = ilc_cur->next;
+   ilc_cur->next = NULL;
+   return ilc;
+   }
+
+/*
+ * ilc_var - create in-line C code for a variable in the symbol table.
+ */
+static void ilc_var(sym, just_desc, may_mod)
+struct sym_entry *sym;
+int just_desc;
+int may_mod;
+   {
+   if (sym->il_indx >= 0) {
+      /*
+       * This symbol will be in symbol table iconc builds from the
+       *   data base entry. iconc needs to know if this is a modifying
+       *   reference so it can perform optimizations. This is indicated by
+       *   may_mod. Some variables are implemented as the vword of a
+       *   descriptor. Sometime the entire descriptor must be accessed.
+       *   This is indicated by just_desc.
+       */
+      if (may_mod) {
+         new_ilc(ILC_Mod);
+         if (sym->id_type & DrfPrm)
+            sym->u.param_info.parm_mod |= 1;
+         }
+      else
+         new_ilc(ILC_Ref);
+      ilc_cur->n = sym->il_indx;
+      if (just_desc)
+         ilc_cur->s = "d";
+      }
+   else switch (sym->id_type) {
+      case TndDesc:
+         /*
+          * variable declared: tended struct descrip ...
+          */
+         new_ilc(ILC_Tend);
+         ilc_cur->n = sym->t_indx;   /* index into tended variables */
+         break;
+      case TndStr:
+         /*
+          * variable declared: tended char *...
+          */
+         new_ilc(ILC_Tend);
+         ilc_cur->n = sym->t_indx;   /* index into tended variables */
+         ilc_str(".vword.sptr");     /* get string pointer from vword union */
+         break;
+      case TndBlk:
+         /*
+          * If blk_name field is null, this variable was declared:
+          *    tended union block *...
+          *  otherwise it was declared:
+          *    tended struct <blk_name> *...
+          */
+         if (sym->u.tnd_var.blk_name != NULL) {
+            /*
+             * Cast the "union block *" from the vword to the correct
+             *   struct pointer. This cast can be used as an r-value or
+             *   an l-value.
+             */
+            ilc_str("(*(struct ");
+            ilc_str(sym->u.tnd_var.blk_name);
+            ilc_str("**)&");
+            }
+         new_ilc(ILC_Tend);
+         ilc_cur->n = sym->t_indx;  /* index into tended variables */
+         ilc_str(".vword.bptr");    /* get block pointer from vword union */
+         if (sym->u.tnd_var.blk_name != NULL)
+            ilc_str(")");
+         break;
+      case RsltLoc:
+         /*
+          * This is the special variable for the result of the operation.
+          *  iconc needs to know if this is a modifying reference so it
+          *  can perform optimizations.
+          */
+         if (may_mod)
+            new_ilc(ILC_Mod);
+         else
+            new_ilc(ILC_Ref);
+         ilc_cur->n = RsltIndx;
+         break;
+      default:
+         /*
+          * This is a variable with an ordinary declaration. Access it by
+          *   its identifier.
+          */
+         ilc_str(sym->image);
+      }
+   }
+
+/*
+ * ilc_walk - walk the syntax tree for C code producing a list of "in-line"
+ *   code. This function needs to know if the code is in a modifying context,
+ *   such as the left-hand-side of an assignment.
+ */
+static void ilc_walk(n, may_mod, const_cast)
+struct node *n;
+int may_mod;
+int const_cast;
+   {
+   struct token *t;
+   struct node *n1;
+   struct node *n2;
+   struct sym_entry *sym;
+   word cont_sav;
+   word brk_sav;
+   word l1, l2;
+   int typcd;
+
+   if (n == NULL)
+      return;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrimryNd:
+         /*
+          * Primary expressions consisting of a single token.
+          */
+         switch (t->tok_id) {
+            case Fail:
+               /*
+                * fail statement. Note that this operaion can fail, output
+                *   the corresponding "in-line" code, and make sure we have
+                *   seen an abstract clause of some kind.
+                */
+               cur_impl->ret_flag |= DoesFail;
+               insert_nl = 1;
+               new_ilc(ILC_Fail);
+               insert_nl = 1;
+               line_ref = NULL;
+               chkabsret(t, SomeType);
+               break;
+            case Errorfail:
+               /*
+                * errorfail statement. Note that this operaion can do error
+                *   conversion and output the corresponding "in-line" code.
+                */
+               cur_impl->ret_flag |= DoesEFail;
+               insert_nl = 1;
+               new_ilc(ILC_EFail);
+               insert_nl = 1;
+               line_ref = NULL;
+               break;
+            case Break:
+               /*
+                * iconc can only handle gotos for transfer of control in
+                *  in-line code. A break label has been established for
+                *  the current loop; transform the "break" into a goto.
+                */
+               ilc_goto(brk_lbl);
+               break;
+            case Continue:
+               /*
+                * iconc can only handle gotos for transfer of control in
+                *  in-line code. A continue label has been established for
+                *  the current loop; transform the "continue" into a goto.
+                */
+               ilc_goto(cont_lbl);
+               break;
+            default:
+               /*
+                * No special processing is needed for this primary
+                *  expression, just output the image of the token.
+                */
+               ilc_tok(t);
+            }
+         break;
+      case PrefxNd:
+         /*
+          * Expressions with one operand that are introduced by a token.
+          *  Note, "default :" does not appear here because switch
+          *  statements are not allowed in in-line code.
+          */
+         switch (t->tok_id) {
+            case Sizeof:
+               /*
+                * sizeof(...)
+                */
+               ilc_tok(t);
+               ilc_str("(");
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str(")");
+               break;
+            case '{':
+               /*
+                * initializer: { ... }
+                */
+               ilc_tok(t);
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str("}");
+               break;
+            case Goto:
+               /*
+                * goto <label>;
+                */
+               ilc_goto(n->u[0].child->u[0].sym->u.lbl_num);
+               break;
+            case Return:
+               /*
+                * return <expression>;
+                *  Indicate that this operation can return, then perform
+                *  processing to categorize the kind of return statement
+                *  and produce appropriate in-line code.
+                */
+               cur_impl->ret_flag |= DoesRet;
+               ilc_ret(t, ILC_Ret, n->u[0].child);
+               break;
+            case Suspend:
+               /*
+                * suspend <expression>;
+                *  Indicate that this operation can suspend, then perform
+                *  processing to categorize the kind of suspend statement
+                *  and produce appropriate in-line code.
+                */
+               cur_impl->ret_flag |= DoesSusp;
+               ilc_ret(t, ILC_Susp, n->u[0].child);
+               break;
+            case '(':
+               /*
+                * ( ... )
+                */
+               ilc_tok(t);
+               ilc_walk(n->u[0].child, may_mod, const_cast);
+               ilc_str(")");
+               break;
+            case Incr:
+            case Decr:
+               /*
+                * The operand might be modified, otherwise nothing special
+                *   is needed.
+                */
+               ilc_tok(t);
+               ilc_walk(n->u[0].child, 1, 0);
+               break;
+            case '&':
+               /*
+                * Unless the address is cast to a const pointer, this
+                *  might be a modifiying reference.
+                */
+               ilc_tok(t);
+               if (const_cast)
+                  ilc_walk(n->u[0].child, 0, 0);
+               else
+                  ilc_walk(n->u[0].child, 1, 0);
+               break;
+            default:
+               /*
+                * Nothing special is needed, just output the image of
+                *   the prefix operation followed by its operand.
+                */
+               ilc_tok(t);
+               ilc_walk(n->u[0].child, 0, 0);
+            }
+         break;
+      case PstfxNd:
+         /*
+          * postfix notation: ';', '++', and '--'. The later two
+          *   modify their operands.
+          */
+         if (t->tok_id == ';')
+            ilc_walk(n->u[0].child, 0, 0);
+         else
+            ilc_walk(n->u[0].child, 1, 0);
+         ilc_tok(t);
+         break;
+      case PreSpcNd:
+         /*
+          * Prefix notation that needs a space after the expression;
+          *   used for pointer/type qualifier lists.
+          */
+         ilc_tok(t);
+         ilc_walk(n->u[0].child, 0, 0);
+         ilc_str(" ");
+         break;
+      case SymNd:
+         /*
+          * Identifier in symbol table. See if it start a new line. Note
+          *   that we need to know whether this is a modifying reference.
+          */
+         ilc_chnl(n->tok);
+         ilc_var(n->u[0].sym, 0, may_mod);
+         break;
+      case BinryNd:
+         switch (t->tok_id) {
+            case '[':
+               /*
+                * Expression or declaration:
+                *   <expr1> [ <expr2> ]
+                */
+               ilc_walk(n->u[0].child, may_mod, 0);
+               ilc_str("[");
+               ilc_walk(n->u[1].child, 0, 0);
+               ilc_str("]");
+               break;
+            case '(':
+               /*
+                * ( <type> ) expr
+                */
+               ilc_tok(t);
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str(")");
+               /*
+                * See if the is a const cast.
+                */
+               for (n1 = n->u[0].child; n1->nd_id == LstNd; n1 = n1->u[0].child)
+                  ;
+               if (n1->nd_id == PrimryNd && n1->tok->tok_id == Const)
+                  ilc_walk(n->u[1].child, 0, 1);
+               else
+                  ilc_walk(n->u[1].child, 0, 0);
+               break;
+            case ')':
+               /*
+                * Expression or declaration:
+                *   <expr> ( <arg-list> )
+                */
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str("(");
+               ilc_walk(n->u[1].child, 0, 0);
+               ilc_tok(t);
+               break;
+            case Struct:
+            case Union:
+            case TokEnum:
+               /*
+                * <struct-union-enum> <identifier>
+                * <struct-union-enum> { <component-list> }
+                * <struct-union-enum> <identifier> { <component-list> }
+                */
+               ilc_tok(t);
+               ilc_str(" ");
+               ilc_walk(n->u[0].child, 0, 0);
+               if (n->u[1].child != NULL) {
+                  ilc_str(" {");
+                  ilc_walk(n->u[1].child, 0, 0);
+                  ilc_str("}");
+                  }
+               break;
+            case ';':
+               /*
+                * <type specifiers> <declarator> ;
+                */
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str(" ");
+               ilc_walk(n->u[1].child, 0, 0);
+               ilc_tok(t);
+               break;
+            case ':':
+               /*
+                * <label> : <statement>
+                */
+               ilc_lbl(n->u[0].child->u[0].sym->u.lbl_num);
+               ilc_walk(n->u[1].child, 0, 0);
+               break;
+            case Switch:
+               errt1(t, "switch statement not supported in in-line code");
+               break;
+            case While:
+               /*
+                * Convert "while (c) s" into [conditional] gotos and labels.
+                *   Establish labels for break and continue statements
+                *   within s.
+                */
+               brk_sav = brk_lbl;
+               cont_sav = cont_lbl;
+               cont_lbl = lbl_num++;
+               brk_lbl = lbl_num++;
+               ilc_lbl(cont_lbl);                      /* L1: */
+               ilc_cgoto(1, n->u[0].child, brk_lbl);   /* if (!(c)) goto L2; */
+               ilc_walk(n->u[1].child, 0, 0);          /* s */
+               ilc_goto(cont_lbl);                     /* goto L1; */
+               ilc_lbl(brk_lbl);                       /* L2: */
+               brk_lbl = brk_sav;
+               cont_lbl = cont_sav;
+               break;
+            case Do:
+               /*
+                * Convert "do s while (c);" loop into a conditional goto and
+                *  label. Establish labels for break and continue statements
+                *  within s.
+                */
+               brk_sav = brk_lbl;
+               cont_sav = cont_lbl;
+               cont_lbl = lbl_num++;
+               brk_lbl = lbl_num++;
+               ilc_lbl(cont_lbl);                        /* L1: */
+               ilc_walk(n->u[0].child, 0, 0);            /* s */
+               ilc_cgoto(0, n->u[1].child, cont_lbl);    /* if (c) goto L1 */
+               ilc_lbl(brk_lbl);
+               brk_lbl = brk_sav;
+               cont_lbl = cont_sav;
+               break;
+            case '.':
+               /*
+                * <expr1> . <expr2>
+                */
+               ilc_walk(n->u[0].child, may_mod, 0);
+               ilc_tok(t);
+               ilc_walk(n->u[1].child, 0, 0);
+               break;
+            case Arrow:
+               /*
+                * <expr1> -> <expr2>
+                */
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_tok(t);
+               ilc_walk(n->u[1].child, 0, 0);
+               break;
+            case Runerr:
+               /*
+                * runerr ( <expr> ) ;
+                * runerr ( <expr> , <expr> ) ;
+                */
+               ilc_str("err_msg(");
+               ilc_walk(n->u[0].child, 0, 0);
+               if (n->u[1].child == NULL)
+                  ilc_str(", NULL);");
+               else {
+                  ilc_str(", &(");
+                  ilc_walk(n->u[1].child, 0, 0);
+                  ilc_str("));");
+                  }
+               /*
+                * Handle error conversion.
+                */
+               cur_impl->ret_flag |= DoesEFail;
+               insert_nl = 1;
+               new_ilc(ILC_EFail);
+               insert_nl = 1;
+               break;
+            case Is:
+               /*
+                * is : <type-name> ( <expr> )
+                */
+               typcd = icn_typ(n->u[0].child);
+               n1 =  n->u[1].child;
+               if (typcd == str_typ) {
+                  ilc_str("(!((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword & F_Nqual))");
+                  }
+               else if (typcd == Variable) {
+                  ilc_str("(((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword & D_Var) == D_Var)");
+                  }
+              else if (typcd == int_typ) {
+                  ForceNl();
+                  prt_str("#ifdef LargeInts", 0);
+                  ForceNl();
+
+                  ilc_str("(((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword == D_Integer) || ((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword == D_Lrgint))");
+
+                  ForceNl();
+                  prt_str("#else /* LargeInts */", 0);
+                  ForceNl();
+
+                  ilc_str("((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword == D_Integer)");
+
+                  ForceNl();
+                  prt_str("#endif /* LargeInts */", 0);
+                  ForceNl();
+                  }
+              else {
+                  ilc_str("((");
+                  ilc_walk(n1, 0, 0);
+                  ilc_str(").dword == D_");
+                  ilc_str(typ_name(typcd, n->u[0].child->tok));
+                  ilc_str(")");
+                  }
+               break;
+            case '=':
+            case MultAsgn:
+            case DivAsgn:
+            case ModAsgn:
+            case PlusAsgn:
+            case MinusAsgn:
+            case LShftAsgn:
+            case RShftAsgn:
+            case AndAsgn:
+            case XorAsgn:
+            case OrAsgn:
+               /*
+                * Assignment operation (or initialization or specification
+                *   of enumeration value). Left-hand-side may be modified.
+                */
+               ilc_walk(n->u[0].child, 1, 0);
+               ilc_str(" ");
+               ilc_tok(t);
+               ilc_str(" ");
+               ilc_walk(n->u[1].child, 0, 0);
+               break;
+            default:
+               /*
+                * Simple binary operator. Nothing special is needed,
+                *   just put space around the operator.
+                */
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str(" ");
+               ilc_tok(t);
+               ilc_str(" ");
+               ilc_walk(n->u[1].child, 0, 0);
+               break;
+            }
+         break;
+      case LstNd:
+         /*
+          * Consecutive expressions that need a space between them.
+          */
+         ilc_walk(n->u[0].child, 0, 0);
+         ilc_str(" ");
+         ilc_walk(n->u[1].child, 0, 0);
+         break;
+      case ConCatNd:
+         /*
+          * Consecutive expressions that don't need space between them.
+          */
+         ilc_walk(n->u[0].child, 0, 0);
+         ilc_walk(n->u[1].child, 0, 0);
+         break;
+      case CommaNd:
+         ilc_walk(n->u[0].child, 0, 0);
+         ilc_tok(t);
+         ilc_str(" ");
+         ilc_walk(n->u[1].child, 0, 0);
+         break;
+      case StrDclNd:
+         /*
+          * struct field declarator. May be a bit field.
+          */
+         ilc_walk(n->u[0].child, 0, 0);
+         if (n->u[1].child != NULL) {
+            ilc_str(": ");
+            ilc_walk(n->u[1].child, 0, 0);
+            }
+         break;
+      case CompNd: {
+         /*
+          * Compound statement. May have declarations including tended
+          *   declarations that are separated out.
+          */
+         struct node *dcls;
+
+         /*
+          * If the in-line code has declarations, the block must
+          *   be surrounded by braces. Braces are special constructs
+          *   because iconc must not delete one without the other
+          *   during code optimization.
+          */
+         dcls = n->u[0].child;
+         if (dcls != NULL) {
+            insert_nl = 1;
+            new_ilc(ILC_LBrc);
+            insert_nl = 1;
+            line_ref = NULL;
+            ilc_walk(dcls, 0, 0);
+            }
+         /*
+          * we are in an inner block. tended locations may need to
+          *  be set to values from declaration initializations.
+          */
+         for (sym = n->u[1].sym; sym!= NULL; sym = sym->u.tnd_var.next) {
+            if (sym->u.tnd_var.init != NULL) {
+               new_ilc(ILC_Tend);
+               ilc_cur->n = sym->t_indx;
+
+               /*
+                * See if the variable is just the vword of the descriptor.
+                */
+               switch (sym->id_type) {
+                  case TndDesc:
+                     ilc_str(" = ");
+                     break;
+                  case TndStr:
+                     ilc_str(".vword.sptr = ");
+                     break;
+                  case TndBlk:
+                     ilc_str(".vword.bptr = (union block *)");
+                     break;
+                  }
+               ilc_walk(sym->u.tnd_var.init, 0, 0);  /* initial value */
+               ilc_str(";");
+               }
+            }
+
+         ilc_walk(n->u[2].child, 0, 0); /* body of compound statement */
+
+         if (dcls != NULL) {
+            insert_nl = 1;
+            new_ilc(ILC_RBrc);  /* closing brace */
+            insert_nl = 1;
+            line_ref = NULL;
+            }
+         }
+         break;
+      case TrnryNd:
+         switch (t->tok_id) {
+            case '?':
+               /*
+                * <expr> ? <expr> : <expr>
+                */
+               ilc_walk(n->u[0].child, 0, 0);
+               ilc_str(" ");
+               ilc_tok(t);
+               ilc_str(" ");
+               ilc_walk(n->u[1].child, 0, 0);
+               ilc_str(" : ");
+               ilc_walk(n->u[2].child, 0, 0);
+               break;
+            case If:
+               /*
+                * Convert if statement into [conditional] gotos and labels.
+                */
+               n1 = n->u[1].child;
+               n2 = n->u[2].child;
+               l1 = lbl_num++;
+               if (n2 == NULL) {    /* if (c) then s */
+                  ilc_cgoto(1, n->u[0].child, l1);      /* if (!(c)) goto L1; */
+                  ilc_walk(n1, 0, 0);                   /* s */
+                  ilc_lbl(l1);                          /* L1: */
+                  }
+               else {               /* if (c) then s1 else s2 */
+                  ilc_cgoto(0, n->u[0].child, l1);      /* if (c) goto L1; */
+                  ilc_walk(n2, 0, 0);                   /* s2 */
+                  l2 = lbl_num++;
+                  ilc_goto(l2);                         /* goto L2; */
+                  ilc_lbl(l1);                          /* L1: */
+                  ilc_walk(n1, 0, 0);                   /* s1 */
+                  ilc_lbl(l2);                          /* L2: */
+                  }
+               break;
+            case Type_case:
+               errt1(t, "type case statement not supported in in-line code");
+               break;
+            case Cnv:
+               /*
+                * cnv : <type> ( <expr> , <expr> )
+                */
+               ilc_cnv(n->u[0].child, n->u[1].child, NULL, n->u[2].child);
+               break;
+            }
+         break;
+      case QuadNd:
+         switch (t->tok_id) {
+            case For:
+               /*
+                * convert "for (e1; e2; e3) s" into [conditional] gotos and
+                *  labels.
+                */
+               brk_sav = brk_lbl;
+               cont_sav = cont_lbl;
+               l1 = lbl_num++;
+               cont_lbl = lbl_num++;
+               brk_lbl = lbl_num++;
+               ilc_walk(n->u[0].child, 0, 0);     /* e1; */
+               ilc_str(";");
+               ilc_lbl(l1);                       /* L1: */
+               n2 = n->u[1].child;
+               if (n2 != NULL)
+                  ilc_cgoto(1, n2, brk_lbl);      /* if (!(e2)) goto L2; */
+               ilc_walk(n->u[3].child, 0, 0);     /* s */
+               ilc_lbl(cont_lbl);
+               ilc_walk(n->u[2].child, 0, 0);     /* e3; */
+               ilc_str(";");
+               ilc_goto(l1);                      /* goto L1 */
+               ilc_lbl(brk_lbl);                  /* L2: */
+               brk_lbl = brk_sav;
+               cont_lbl = cont_sav;
+               break;
+            case Def:
+               ilc_cnv(n->u[0].child, n->u[1].child, n->u[2].child,
+                  n->u[3].child);
+               break;
+            }
+         break;
+      }
+   }
+
+/*
+ * ilc_cnv - produce code for a cnv: or def: statement.
+ */
+static void ilc_cnv(cnv_typ, src, dflt, dest)
+struct node *cnv_typ;
+struct node *src;
+struct node *dflt;
+struct node *dest;
+   {
+   int dflt_to_ptr;
+   int typcd;
+
+   /*
+    * Get the name of the conversion routine for the given type
+    *  and determine whether the conversion routine needs a
+    *  pointer to the default value (if there is one) rather
+    *  the the value itself.
+    */
+   typcd = icn_typ(cnv_typ);
+   ilc_str(cnv_name(typcd, dflt, &dflt_to_ptr));
+   ilc_str("(");
+
+   /*
+    * If this is a conversion to a temporary string or cset, the
+    *  conversion routine needs a temporary buffer in which to
+    *  perform the conversion.
+    */
+   switch (typcd) {
+      case TypTStr:
+         new_ilc(ILC_SBuf);
+         ilc_str(", ");
+         break;
+      case TypTCset:
+         new_ilc(ILC_CBuf);
+         ilc_str(", ");
+         break;
+      }
+
+   /*
+    * Produce code for the source expression.
+    */
+   ilc_str("&(");
+   ilc_walk(src, 0, 0);
+   ilc_str("), ");
+
+   /*
+    * Produce code for the default expression, if there is one.
+    */
+   if (dflt != NULL) {
+      if (dflt_to_ptr)
+         ilc_str("&(");
+      ilc_walk(dflt, 0, 0);
+      if (dflt_to_ptr)
+         ilc_str("), ");
+      else
+         ilc_str(", ");
+      }
+
+   /*
+    * Produce code for the destination expression.
+    */
+   ilc_str("&(");
+   ilc_walk(dest, 1, 0);
+   ilc_str("))");
+   }
+
+/*
+ * ilc_ret - produce in-line code for suspend/return statement.
+ */
+static void ilc_ret(t, ilc_typ, n)
+struct token *t;
+int ilc_typ;
+struct node *n;
+   {
+   struct node *caller;
+   struct node *args;
+   int typcd;
+
+   insert_nl = 1;
+   line_ref = NULL;
+   new_ilc(ilc_typ);
+
+   if (n->nd_id == SymNd && n->u[0].sym->id_type == RsltLoc) {
+      /*
+       * return/suspend result;
+       */
+      ilc_cur->n = RetNone;
+      return;
+      }
+
+   if (n->nd_id == PrefxNd && n->tok != NULL) {
+      switch (n->tok->tok_id) {
+         case C_Integer:
+            /*
+             * return/suspend C_integer <expr>;
+             */
+            ilc_cur->n = TypCInt;
+            ilc_cur->code[0] = sep_ilc(NULL, n->u[0].child, NULL);
+            chkabsret(t, int_typ);
+            return;
+         case C_Double:
+            /*
+             * return/suspend C_double <expr>;
+             */
+            ilc_cur->n = TypCDbl;
+            ilc_cur->code[0] = sep_ilc(NULL, n->u[0].child, NULL);
+            chkabsret(t, real_typ);
+            return;
+         case C_String:
+            /*
+             * return/suspend C_string <expr>;
+             */
+            ilc_cur->n = TypCStr;
+            ilc_cur->code[0] = sep_ilc(NULL, n->u[0].child, NULL);
+            chkabsret(t, str_typ);
+            return;
+         }
+      }
+   else if (n->nd_id == BinryNd && n->tok->tok_id == ')') {
+      /*
+       * Return value is in form of function call, see if it is really
+       *  a descriptor constructor.
+       */
+      caller = n->u[0].child;
+      args = n->u[1].child;
+      if (caller->nd_id == SymNd) {
+         switch (caller->tok->tok_id) {
+            case IconType:
+               typcd = caller->u[0].sym->u.typ_indx;
+               ilc_cur->n = typcd;
+               switch (icontypes[typcd].rtl_ret) {
+                  case TRetBlkP:
+                  case TRetDescP:
+                  case TRetCharP:
+                  case TRetCInt:
+                     /*
+                      * return/suspend <type>(<value>);
+                      */
+                     ilc_cur->code[0] = sep_ilc(NULL, args, NULL);
+                     break;
+                  case TRetSpcl:
+                     if (typcd == str_typ) {
+                        /*
+                         * return/suspend string(<len>, <char-pntr>);
+                         */
+                        ilc_cur->code[0] = sep_ilc(NULL, args->u[0].child,NULL);
+                        ilc_cur->code[1] = sep_ilc(NULL, args->u[1].child,NULL);
+                        }
+                     else if (typcd == stv_typ) {
+                        /*
+                         * return/suspend tvsubs(<desc-pntr>, <start>, <len>);
+                         */
+                        ilc_cur->n = stv_typ;
+                        ilc_cur->code[0] = sep_ilc(NULL,
+                            args->u[0].child->u[0].child, NULL);
+                        ilc_cur->code[1] = sep_ilc(NULL,
+                            args->u[0].child->u[1].child, NULL);
+                        ilc_cur->code[2] = sep_ilc(NULL, args->u[1].child,
+                            NULL);
+                        chkabsret(t, stv_typ);
+                                 }
+                     break;
+                  }
+               chkabsret(t, typcd);
+               return;
+            case Named_var:
+               /*
+                * return/suspend named_var(<desc-pntr>);
+                */
+               ilc_cur->n = RetNVar;
+               ilc_cur->code[0] = sep_ilc(NULL, args, NULL);
+               chkabsret(t, TypVar);
+               return;
+            case Struct_var:
+               /*
+                * return/suspend struct_var(<desc-pntr>, <block_pntr>);
+                */
+               ilc_cur->n = RetSVar;
+               ilc_cur->code[0] = sep_ilc(NULL, args->u[0].child, NULL);
+               ilc_cur->code[1] = sep_ilc(NULL, args->u[1].child, NULL);
+               chkabsret(t, TypVar);
+               return;
+            }
+         }
+      }
+
+   /*
+    * If it is not one of the special returns, it is just a return of
+    *  a descriptor.
+    */
+   ilc_cur->n = RetDesc;
+   ilc_cur->code[0] = sep_ilc(NULL, n, NULL);
+   chkabsret(t, SomeType);
+   }
+
+/*
+ * ilc_goto - produce in-line C code for a goto to a numbered label.
+ */
+static void ilc_goto(lbl)
+word lbl;
+   {
+   insert_nl = 1;
+   new_ilc(ILC_Goto);
+   ilc_cur->n = lbl;
+   insert_nl = 1;
+   line_ref = NULL;
+   }
+
+/*
+ * ilc_cgoto - produce in-line C code for a conditional goto to a numbered
+ *  label. The condition may be negated.
+ */
+static void ilc_cgoto(neg, cond, lbl)
+int neg;
+struct node *cond;
+word lbl;
+   {
+   insert_nl = 1;
+   line_ref = NULL;
+   new_ilc(ILC_CGto);
+   if (neg)
+      ilc_cur->code[0] = sep_ilc("!(", cond, ")");
+   else
+      ilc_cur->code[0] = sep_ilc(NULL, cond, NULL);
+   ilc_cur->n = lbl;
+   insert_nl = 1;
+   line_ref = NULL;
+   }
+
+/*
+ * ilc_lbl - produce in-line C code for a numbered label.
+ */
+static void ilc_lbl(lbl)
+word lbl;
+   {
+   insert_nl = 1;
+   new_ilc(ILC_Lbl);
+   ilc_cur->n = lbl;
+   insert_nl = 1;
+   line_ref = NULL;
+   }
+#endif					/* Rttx */
+
+/*
+ * chkabsret - make sure a previous abstract return statement
+ *  was encountered and that it is consistent with this return,
+ *  suspend, or fail.
+ */
+void chkabsret(tok, ret_typ)
+struct token *tok;
+int ret_typ;
+   {
+   if (abs_ret == NoAbstr)
+      errt2(tok, tok->image, " with no preceding abstract return");
+
+   /*
+    * We only check for type consistency when it is easy, otherwise
+    *   we don't bother.
+    */
+   if (abs_ret == SomeType || ret_typ == SomeType || abs_ret == TypAny)
+      return;
+
+   /*
+    * Some return types match the generic "variable" type.
+    */
+   if (abs_ret == TypVar && ret_typ >= 0 && icontypes[ret_typ].deref != DrfNone)
+      return;
+
+   /*
+    * Otherwise the abstract return must match the real one.
+    */
+   if (abs_ret != ret_typ)
+      errt2(tok, tok->image,  " is inconsistent with abstract return");
+   }
+
+/*
+ * just_type - strip non-type information from a type-qualifier list. Print
+ *   it in the output file and if ilc is set, produce in-line C code.
+ */
+void just_type(typ, indent, ilc)
+struct node *typ;
+int indent;
+int ilc;
+   {
+   if (typ->nd_id == LstNd) {
+      /*
+       * Simple list of type-qualifier elements - concatenate them.
+       */
+      just_type(typ->u[0].child, indent, ilc);
+      just_type(typ->u[1].child, indent, ilc);
+      }
+   else if (typ->nd_id == PrimryNd) {
+      switch (typ->tok->tok_id) {
+         case Typedef:
+         case Extern:
+         case Static:
+         case Auto:
+         case TokRegister:
+         case Const:
+         case Volatile:
+            return;         /* Don't output these declaration elements */
+         default:
+            c_walk(typ, indent, 0);
+            #ifndef Rttx
+               if (ilc)
+                  ilc_walk(typ, 0, 0);
+            #endif			/* Rttx */
+         }
+      }
+   else {
+      c_walk(typ, indent, 0);
+      #ifndef Rttx
+         if (ilc)
+            ilc_walk(typ, 0, 0);
+      #endif				/* Rttx */
+      }
+   }
diff --git a/src/rtt/rttinlin.c b/src/rtt/rttinlin.c
new file mode 100644
index 0000000..660c604
--- /dev/null
+++ b/src/rtt/rttinlin.c
@@ -0,0 +1,1950 @@
+/*
+ * rttinlin.c contains routines which produce the in-line version of an
+ *  operation and put it in the data base.
+ */
+#include "rtt.h"
+
+/*
+ * prototypes for static functions.
+ */
+static struct il_code *abstrcomp (struct node *n, int indx_stor,
+                                    int chng_stor, int escapes);
+static void         abstrsnty (struct token *t, int typcd,
+                                   int indx_stor, int chng_stor);
+static int             body_anlz (struct node *n, int *does_break,
+                                   int may_mod, int const_cast, int all);
+static struct il_code *body_fnc  (struct node *n);
+static void         chkrettyp (struct node *n);
+static void         chng_ploc (int typcd, struct node *src);
+static void         cnt_bufs  (struct node *cnv_typ);
+static struct il_code *il_walk   (struct node *n);
+static struct il_code *il_var    (struct node *n);
+static int             is_addr   (struct node *dcltor, int modifier);
+static void         lcl_tend  (struct node *n);
+static int             mrg_abstr (int sum, int typ);
+static int             strct_typ (struct node *typ, int *is_reg);
+
+static int body_ret; /* RetInt, RetDbl, and/or RetOther for current body */
+static int ret_flag; /* DoesFail, DoesRet, and/or DoesSusp for current body */
+int fnc_ret;         /* RetInt, RetDbl, RetNoVal, or RetSig for current func */
+
+#ifndef Rttx
+
+/*
+ * body_prms is a list of symbol table entries for identifiers that must
+ *  be passed as parameters to the function implementing the current
+ *  body statement. The id_type of an identifier may be changed in the
+ *  symbol table while the body function is being produced; for example,
+ *  a tended descriptor is accessed through a parameter that is a pointer
+ *  to a descriptor, rather than being accessed as an element of a descriptor
+ *  array in a struct.
+ */
+struct var_lst {
+   struct sym_entry *sym;
+   int id_type;            /* saved value of id_type from sym */
+   struct var_lst *next;
+   };
+struct var_lst *body_prms;
+int n_bdy_prms;		/* number of entries in body_prms list */
+int rslt_loc;		/* flag: function passed addr of result descriptor */
+
+char prfx3;		/* 3rd prefix char; used for unique body func names */
+
+/*
+ * in_line - place in the data base in-line code for an operation and
+ *   produce C functions for body statements.
+ */
+void in_line(n)
+struct node *n;
+   {
+   struct sym_entry *sym;
+   int i;
+   int nvars;
+   int ntend;
+
+   prfx3 = ' '; /* reset 3rd prefix char for body functions */
+
+   /*
+    * Set up the local symbol table in the data base for the in-line code.
+    *  This symbol table has an array of entries for the tended variables
+    *  in the declare statement, if there is one. Determine how large the
+    *  array must be and create it.
+    */
+   ntend = 0;
+   for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next)
+      ++ntend;
+   if (ntend == 0)
+      cur_impl->tnds = NULL;
+   else
+      cur_impl->tnds = alloc(ntend * sizeof(struct tend_var));
+   cur_impl->ntnds = ntend;
+   i = 0;
+
+   /*
+    * Go back through the declarations and fill in the array for the
+    *  tended part of the data base symbol table. Array entries contain
+    *  an indication of the type of tended declaration, the C code to
+    *  initialize the variable if there is any, and, for block pointer
+    *  declarations, the type of block. rtt's symbol table is updated to
+    *  contain the variable's offset into the data base's symbol table.
+    *  Note that parameters are considered part of the data base's symbol
+    *  table when computing the offset and il_indx initially contains
+    *  their number.
+    */
+   for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next) {
+      cur_impl->tnds[i].var_type = sym->id_type;
+      cur_impl->tnds[i].init = inlin_c(sym->u.tnd_var.init, 0);
+      cur_impl->tnds[i].blk_name = sym->u.tnd_var.blk_name;
+      sym->il_indx = il_indx++;
+      ++i;
+      }
+
+   /*
+    * The data base's symbol table also has entries for non-tended
+    *  variables from the declare statement. Each entry has the
+    *  identifier for the variable and the declaration (redundantly
+    *  including the identifier). Once again the offset for the data
+    *  base symbol table is stored in rtt's symbol table.
+    */
+   nvars = -il_indx;  /* pre-subtract preceding number of entries */
+   for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next)
+      sym->il_indx = il_indx++;
+   nvars += il_indx;  /* compute number of entries in this part of table */
+   cur_impl->nvars = nvars;
+   if (nvars > 0) {
+      cur_impl->vars = alloc(nvars * sizeof(struct ord_var));
+      i = 0;
+      for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
+         cur_impl->vars[i].name = sym->image;
+         cur_impl->vars[i].dcl = ilc_dcl(sym->u.declare_var.tqual,
+            sym->u.declare_var.dcltor, sym->u.declare_var.init);
+         ++i;
+         }
+      }
+
+   abs_ret = NoAbstr;		   /* abstract clause not encountered yet */
+   cur_impl->in_line = il_walk(n); /* produce in-line code for operation */
+   }
+
+/*
+ * il_walk - walk the syntax tree producing in-line code.
+ */
+static struct il_code *il_walk(n)
+struct node *n;
+   {
+   struct token *t;
+   struct node *n1;
+   struct node *n2;
+   struct il_code *il;
+   struct il_code *il1;
+   struct sym_entry *sym;
+   struct init_tend *tnd;
+   int dummy_int;
+   int ntend;
+   int typcd;
+
+   if (n == NULL)
+      return NULL;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrefxNd:
+         switch (t->tok_id) {
+            case '{':
+               /*
+                * RTL code: { <actions> }
+                */
+               il = il_walk(n->u[0].child);
+               break;
+            case '!':
+               /*
+                * RTL type-checking and conversions: ! <simple-type-check>
+                */
+               il = new_il(IL_Bang, 1);
+               il->u[0].fld = il_walk(n->u[0].child);
+               break;
+            case Body:
+               /*
+                * RTL code: body { <c-code> }
+                */
+               il = body_fnc(n);
+               break;
+            case Inline:
+               /*
+                * RTL code: inline { <c-code> }
+                *
+                *  An in-line code "block" in the data base starts off
+                *  with an indication of whether execution falls through
+                *  the code and a list of tended descriptors needed by the
+                *  in-line C code. The list indicates the kind of tended
+                *  descriptor. The list is determined by walking to the
+                *  syntax tree for the C code; tend_lst points to its
+                *  beginning. The last item in the block is the C code itself.
+                */
+               free_tend();
+               lcl_tend(n);
+               if (tend_lst == NULL)
+                  ntend = 0;
+               else
+                  ntend = tend_lst->t_indx + 1;
+               il = new_il(IL_Block, 3 + ntend);
+               /*
+                * Only need "fall through" info from body_anlz().
+                */
+               il->u[0].n = body_anlz(n->u[0].child, &dummy_int, 0, 0, 0);
+               il->u[1].n = ntend;
+               for (tnd = tend_lst; tnd != NULL; tnd = tnd->next)
+                  il->u[2 + tnd->t_indx].n = tnd->init_typ;
+               il->u[ntend + 2].c_cd = inlin_c(n->u[0].child, 0);
+               if (!il->u[0].n)
+                  clr_prmloc(); /* execution does not continue */
+               break;
+            }
+         break;
+      case BinryNd:
+         switch (t->tok_id) {
+            case Runerr:
+               /*
+                * RTL code: runerr( <message-number> )
+                *           runerr( <message-number>, <descriptor> )
+                */
+               if (n->u[1].child == NULL)
+                  il = new_il(IL_Err1, 1);
+               else {
+                  il = new_il(IL_Err2, 2);
+                  il->u[1].fld = il_var(n->u[1].child);
+                  }
+               il->u[0].n = atol(n->u[0].child->tok->image);
+               /*
+                * Execution cannot continue on this execution path.
+                */
+               clr_prmloc();
+               break;
+            case And:
+               /*
+                * RTL type-checking and conversions:
+                *   <type-check> && <type_check>
+                */
+               il = new_il(IL_And, 2);
+               il->u[0].fld = il_walk(n->u[0].child);
+               il->u[1].fld = il_walk(n->u[1].child);
+               break;
+            case Is:
+               /*
+                * RTL type-checking and conversions:
+                *   is: <icon-type> ( <variable> )
+                */
+               il = new_il(IL_Is, 2);
+               il->u[0].n = icn_typ(n->u[0].child);
+               il->u[1].fld = il_var(n->u[1].child);
+               break;
+            }
+         break;
+      case ConCatNd:
+         /*
+          * "Glue" for two constructs.
+          */
+         il = new_il(IL_Lst, 2);
+         il->u[0].fld = il_walk(n->u[0].child);
+         il->u[1].fld = il_walk(n->u[1].child);
+         break;
+      case AbstrNd:
+         /*
+          * RTL code: abstract { <type-computations> }
+          *
+          *  Remember the return statement if there is one. It is used for
+          *  type checking when types are easily determined.
+          */
+         il = new_il(IL_Abstr, 2);
+         il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
+         il1 = abstrcomp(n->u[1].child, 0, 0, 1);
+         il->u[1].fld = il1;
+         if (il1 != NULL) {
+            if (abs_ret != NoAbstr)
+               errt1(t,"only one abstract return may be on any execution path");
+            if (il1->il_type == IL_IcnTyp || il1->il_type == IL_New)
+               abs_ret = il1->u[0].n;
+            else
+               abs_ret = SomeType;
+            }
+         break;
+      case TrnryNd:
+         switch (t->tok_id) {
+            case If: {
+               /*
+                * RTL code for "if" statements:
+                *  if <type-check> then <action>
+                *  if <type-check> then <action> else <action>
+                *
+                *  <type-check> may include parameter conversions that create
+                *  new scoping. It is necessary to keep track of parameter
+                *  types and locations along success and failure paths of
+                *  these conversions. The "then" and "else" actions may
+                *  also establish new scopes (if a parameter is used within
+                *  a overlapping scopes that conflict, it has already been
+                *  detected).
+                *
+                *  The "then" and "else" actions may contain abstract return
+                *  statements. The types of these must be "merged" in case
+                *  type checking must be done on real return or suspend
+                *  statements following the "if".
+                */
+               struct parminfo *then_prms = NULL;
+               struct parminfo *else_prms;
+               struct node *cond;
+               struct node *else_nd;
+               int sav_absret;
+               int new_absret;
+
+               /*
+                * Save the current parameter locations. These are in
+                *  effect on the failure path of any type conversions
+                *  in the condition of the "if". Also remember any
+                *  information from abstract returns.
+                */
+               else_prms = new_prmloc();
+               sv_prmloc(else_prms);
+               sav_absret = new_absret = abs_ret;
+
+               cond = n->u[0].child;
+               else_nd = n->u[2].child;
+
+               if (else_nd == NULL)
+                  il = new_il(IL_If1, 2);
+               else
+                  il = new_il(IL_If2, 3);
+               il->u[0].fld = il_walk(cond);
+               /*
+                * If the condition is negated, the failure path is to the "then"
+                *  and the success path is to the "else".
+                */
+               if (cond->nd_id == PrefxNd && cond->tok->tok_id == '!') {
+                  then_prms = else_prms;
+                  else_prms = new_prmloc();
+                  sv_prmloc(else_prms);
+                  ld_prmloc(then_prms);
+                  }
+               il->u[1].fld = il_walk(n->u[1].child);  /* then ... */
+               if (else_nd == NULL) {
+                  mrg_prmloc(else_prms);
+                  ld_prmloc(else_prms);
+                  }
+               else {
+                  if (then_prms == NULL)
+                     then_prms = new_prmloc();
+                  sv_prmloc(then_prms);
+                  ld_prmloc(else_prms);
+                  new_absret = mrg_abstr(new_absret, abs_ret);
+                  abs_ret = sav_absret;
+                  il->u[2].fld = il_walk(else_nd);
+                  mrg_prmloc(then_prms);
+                  ld_prmloc(then_prms);
+                  }
+               abs_ret = mrg_abstr(new_absret, abs_ret);
+               if (then_prms != NULL)
+                  free((char *)then_prms);
+               if (else_prms != NULL)
+                  free((char *)else_prms);
+               }
+               break;
+            case Len_case: {
+               /*
+                * RTL code:
+                *   len_case <variable> of {
+                *      <integer>: <action>
+                *        ...
+                *      default: <action>
+                *      }
+                */
+               struct parminfo *strt_prms;
+               struct parminfo *end_prms;
+               int n_cases;
+               int indx;
+               int sav_absret;
+               int new_absret;
+
+               /*
+                * A case may contain parameter conversions that create new
+                *  scopes. Remember the parameter locations at the start
+                *  of the len_case statement. Also remember information
+                *  about abstract type returns.
+                */
+               strt_prms = new_prmloc();
+               sv_prmloc(strt_prms);
+               end_prms = new_prmloc();
+               sav_absret = new_absret = abs_ret;
+
+               /*
+                * Count the number of cases; there is at least one.
+                */
+               n_cases = 1;
+               for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
+                   n1 = n1->u[0].child)
+                      ++n_cases;
+
+               /*
+                * The data base entry has one slot for the number of cases,
+                *  one for the default clause, and two for each case. A
+                *  case includes a selection integer and an action.
+                */
+               il = new_il(IL_Lcase, 2 + 2 * n_cases);
+               il->u[0].n = n_cases;
+
+               /*
+                * Go through the cases, adding them to the data base entry.
+                *  Merge resulting parameter locations and information
+                *  about abstract type returns, then restore the starting
+                *  information for the next case.
+                */
+               indx = 2 * n_cases;
+               for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
+                    n1 = n1->u[0].child) {
+                  il->u[indx--].fld = il_walk(n1->u[1].child->u[0].child);
+                  il->u[indx--].n = atol(n1->u[1].child->tok->image);
+                  mrg_prmloc(end_prms);
+                  ld_prmloc(strt_prms);
+                  new_absret = mrg_abstr(new_absret, abs_ret);
+                  abs_ret = sav_absret;
+                  }
+               /*
+                * Last case.
+                */
+               il->u[indx--].fld = il_walk(n1->u[0].child);
+               il->u[indx].n = atol(n1->tok->image);
+               mrg_prmloc(end_prms);
+               ld_prmloc(strt_prms);
+               new_absret = mrg_abstr(new_absret, abs_ret);
+               abs_ret = sav_absret;
+               /*
+                * Default clause.
+                */
+               il->u[1 + 2 * n_cases].fld = il_walk(n->u[2].child);
+               mrg_prmloc(end_prms);
+               ld_prmloc(end_prms);
+               abs_ret = mrg_abstr(new_absret, abs_ret);
+               if (strt_prms != NULL)
+                  free((char *)strt_prms);
+               if (end_prms != NULL)
+                  free((char *)end_prms);
+               }
+               break;
+            case Type_case: {
+               /*
+                * RTL code:
+                *   type_case <variable> of {
+                *       <icon_type> : ... <icon_type> : <action>
+                *          ...
+                *       }
+                *
+                *   last clause may be: default: <action>
+                */
+               struct node *sel;
+               struct parminfo *strt_prms;
+               struct parminfo *end_prms;
+               int *typ_vect;
+               int n_case;
+               int n_typ;
+               int n_fld;
+               int sav_absret;
+               int new_absret;
+
+               /*
+                * A case may contain parameter conversions that create new
+                *  scopes. Remember the parameter locations at the start
+                *  of the type_case statement. Also remember information
+                *  about abstract type returns.
+                */
+               strt_prms = new_prmloc();
+               sv_prmloc(strt_prms);
+               end_prms = new_prmloc();
+               sav_absret = new_absret = abs_ret;
+
+               /*
+                * Count the number of cases.
+                */
+               n_case = 0;
+               for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child)
+                  ++n_case;
+
+               /*
+                * The data base entry has one slot for the variable whose
+                *  type is being tested, one for the number cases, three
+                *  for each case, and, if there is default clause, one
+                *  for it. Each case includes the number of types selected
+                *  by the case, a vectors of those types, and the action
+                *  for the case.
+                */
+               if (n->u[2].child == NULL) {
+                  il = new_il(IL_Tcase1, 3 * n_case + 2);
+                  il->u[0].fld = il_var(n->u[0].child);
+                  }
+               else {
+                  /*
+                   * There is a default clause.
+                   */
+                  il = new_il(IL_Tcase2, 3 * n_case + 3);
+                  il->u[0].fld = il_var(n->u[0].child);
+                  il->u[3 * n_case + 2].fld = il_walk(n->u[2].child);
+                  mrg_prmloc(end_prms);
+                  ld_prmloc(strt_prms);
+                  }
+               il->u[1].n = n_case;
+
+               /*
+                * Go through the cases, adding them to the data base entry.
+                *  Merge resulting parameter locations and information
+                *  about abstract type returns, then restore the starting
+                *  information for the next case.
+                */
+               n_fld = 2;
+               for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
+                  /*
+                   * Determine the number types selected by the case and
+                   *  put the types in a vector.
+                   */
+                  sel = n1->u[1].child;
+                  n_typ = 0;
+                  for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
+                     n_typ++;
+                  il->u[n_fld++].n = n_typ;
+                  typ_vect = alloc(n_typ * sizeof(int));
+                  il->u[n_fld++].vect = typ_vect;
+                  n_typ = 0;
+                  for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
+                     typ_vect[n_typ++] = icn_typ(n2->u[1].child);
+                  /*
+                   * Add code for the case to the data  base entry.
+                   */
+                  new_absret = mrg_abstr(new_absret, abs_ret);
+                  abs_ret = sav_absret;
+                  il->u[n_fld++].fld = il_walk(sel->u[1].child);
+                  mrg_prmloc(end_prms);
+                  ld_prmloc(strt_prms);
+                  }
+               ld_prmloc(end_prms);
+               abs_ret = mrg_abstr(new_absret, abs_ret);
+               if (strt_prms != NULL)
+                  free((char *)strt_prms);
+               if (end_prms != NULL)
+                  free((char *)end_prms);
+               }
+               break;
+            case Cnv: {
+               /*
+                * RTL code: cnv: <type> ( <source> )
+                *           cnv: <type> ( <source> , <destination> )
+                */
+               struct node *typ;
+               struct node *src;
+               struct node *dst;
+
+               typ = n->u[0].child;
+               src = n->u[1].child;
+               dst = n->u[2].child;
+               typcd = icn_typ(typ);
+               if (src->nd_id == SymNd)
+                  sym = src->u[0].sym;
+               else if (src->nd_id == BinryNd)
+                  sym = src->u[0].child->u[0].sym; /* subscripted variable */
+               else
+                  errt2(src->tok, "undeclared identifier: ", src->tok->image);
+               if (sym->u.param_info.parm_mod) {
+                  fprintf(stderr, "%s: file %s, line %d, warning: ",
+                     progname, src->tok->fname, src->tok->line);
+                  fprintf(stderr, "%s may be modified\n", sym->image);
+                  fprintf(stderr,
+                  "\ticonc does not handle conversion of modified parameter\n");
+                  }
+
+
+               if (dst == NULL) {
+                  il = new_il(IL_Cnv1, 2);
+                  il->u[0].n = typcd;
+                  il->u[1].fld = il_var(src);
+                  /*
+                   * This "in-place" conversion may create a new scope for the
+                   *  source parameter.
+                   */
+                  chng_ploc(typcd, src);
+                  sym->u.param_info.parm_mod |= 1;
+                  }
+               else {
+                  il = new_il(IL_Cnv2, 3);
+                  il->u[0].n = typcd;
+                  il->u[1].fld = il_var(src);
+                  il->u[2].c_cd = inlin_c(dst, 1);
+                  }
+               }
+               break;
+            case Arith_case: {
+               /*
+                * arith_case (<variable>, <variable>) of {
+                *   C_integer: <statement>
+                *   integer: <statement>
+                *   C_double: <statement>
+                *   }
+                *
+                * This construct does type conversions and provides
+                *  alternate execution paths. It is necessary to keep
+                *  track of parameter locations.
+                */
+               struct node *var1;
+               struct node *var2;
+               struct parminfo *strt_prms;
+               struct parminfo *end_prms;
+               int sav_absret;
+               int new_absret;
+
+               strt_prms = new_prmloc();
+               sv_prmloc(strt_prms);
+               end_prms = new_prmloc();
+               sav_absret = new_absret = abs_ret;
+
+               var1 = n->u[0].child;
+               var2 = n->u[1].child;
+               n1 = n->u[2].child;   /* contains actions for the 3 cases */
+
+               /*
+                * The data base entry has a slot for each of the two variables
+                *  and one for each of the three cases.
+                */
+               il = new_il(IL_Acase, 5);
+               il->u[0].fld = il_var(var1);
+               il->u[1].fld = il_var(var2);
+
+               /*
+                * The "in-place" conversions to C_integer creates new scopes.
+                */
+               chng_ploc(TypECInt, var1);
+               chng_ploc(TypECInt, var2);
+               il->u[2].fld = il_walk(n1->u[0].child);
+               mrg_prmloc(end_prms);
+               new_absret = mrg_abstr(new_absret, abs_ret);
+
+
+               /*
+                * Conversion to integer (applicable to large integers only).
+                */
+               ld_prmloc(strt_prms);
+               abs_ret = sav_absret;
+               il->u[3].fld  = il_walk(n1->u[1].child);
+               mrg_prmloc(end_prms);
+               new_absret = mrg_abstr(new_absret, abs_ret);
+
+               /*
+                * The "in-place" conversions to C_double creates new scopes.
+                */
+               ld_prmloc(strt_prms);
+               abs_ret = sav_absret;
+               chng_ploc(TypCDbl, var1);
+               chng_ploc(TypCDbl, var2);
+               il->u[4].fld  = il_walk(n1->u[2].child);
+               mrg_prmloc(end_prms);
+
+               ld_prmloc(end_prms);
+               abs_ret = mrg_abstr(new_absret, abs_ret);
+               free((char *)strt_prms);
+               free((char *)end_prms);
+               }
+               break;
+            }
+         break;
+      case QuadNd: {
+         /*
+          * RTL code: def: <type> ( <source> , <default>)
+          *           def: <type> ( <source> , <default> , <destination> )
+          */
+         struct node *typ;
+         struct node *src;
+         struct node *dflt;
+         struct node *dst;
+
+         typ = n->u[0].child;
+         src = n->u[1].child;
+         dflt = n->u[2].child;
+         dst = n->u[3].child;
+         typcd = icn_typ(typ);
+         if (dst == NULL) {
+            il = new_il(IL_Def1, 3);
+            il->u[0].n = typcd;
+            il->u[1].fld = il_var(src);
+            il->u[2].c_cd = inlin_c(dflt, 0);
+            /*
+             * This "in-place" conversion may create a new scope for the
+             *  source parameter.
+             */
+            chng_ploc(typcd, src);
+            }
+         else {
+            il = new_il(IL_Def2, 4);
+            il->u[0].n = typcd;
+            il->u[1].fld = il_var(src);
+            il->u[2].c_cd = inlin_c(dflt, 0);
+            il->u[3].c_cd = inlin_c(dst, 1);
+            }
+         }
+         break;
+      }
+   return il;
+   }
+
+/*
+ * il_var - produce in-line code in the data base for varibel references.
+ *   These include both simple identifiers and subscripted identifiers.
+ */
+static struct il_code *il_var(n)
+struct node *n;
+   {
+   struct il_code *il;
+
+   if (n->nd_id == SymNd) {
+      il = new_il(IL_Var, 1);
+      il->u[0].n = n->u[0].sym->il_indx; /* offset into data base sym. tab. */
+      }
+   else if (n->nd_id == BinryNd) {
+      /*
+       * A subscripted variable.
+       */
+      il = new_il(IL_Subscr, 2);
+      il->u[0].n = n->u[0].child->u[0].sym->il_indx; /* sym. tab. offset */
+      il->u[1].n = atol(n->u[1].child->tok->image);  /* subscript */
+      }
+   else
+      errt2(n->tok, "undeclared identifier: ", n->tok->image);
+   return il;
+   }
+
+/*
+ * abstrcomp - produce data base code for RTL abstract type computations.
+ *  In the process, do a few sanity checks where they are easy to do.
+ */
+static struct il_code *abstrcomp(n, indx_stor, chng_stor, escapes)
+struct node *n;
+int indx_stor;
+int chng_stor;
+int escapes;
+   {
+   struct token *t;
+   struct il_code *il;
+   int typcd;
+   int cmpntcd;
+
+   if (n == NULL)
+      return NULL;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrefxNd:
+         switch (t->tok_id) {
+            case TokType:
+               /*
+                * type( <variable> )
+                */
+               il = new_il(IL_VarTyp, 1);
+               il->u[0].fld = il_var(n->u[0].child);
+               break;
+            case Store:
+               /*
+                * store[ <type> ]
+                */
+               il = new_il(IL_Store, 1);
+               il->u[0].fld = abstrcomp(n->u[0].child, 1, 0, 0);
+               break;
+            }
+         break;
+      case PstfxNd:
+         /*
+          * <type> . <attrb_name>
+          */
+         il = new_il(IL_Compnt, 2);
+         il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
+         switch (t->tok_id) {
+            case Component:
+               cmpntcd = sym_lkup(t->image)->u.typ_indx;
+               il->u[1].n = cmpntcd;
+               if (escapes && !typecompnt[cmpntcd].var)
+                  errt3(t, typecompnt[cmpntcd].id,
+                    " component is an internal reference type.\n",
+                    "\t\tuse store[<type>.<component>] to \"dereference\" it");
+               break;
+            case All_fields:
+               il->u[1].n = CM_Fields;
+               break;
+            }
+         break;
+      case IcnTypNd:
+         /*
+          * <icon-type>
+          */
+         il = new_il(IL_IcnTyp, 1);
+         typcd = icn_typ(n->u[0].child);
+         abstrsnty(t, typcd, indx_stor, chng_stor);
+         il->u[0].n = typcd;
+         break;
+      case BinryNd:
+         switch (t->tok_id) {
+            case '=':
+               /*
+                * store[ <type> ] = <type>
+                */
+               il = new_il(IL_TpAsgn, 2);
+               il->u[0].fld = abstrcomp(n->u[0].child, 1, 1, 0);
+               il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 1);
+               break;
+            case Incr: /* union */
+               /*
+                * <type> ++ <type>
+                */
+               il = new_il(IL_Union, 2);
+               il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
+                  escapes);
+               il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
+                  escapes);
+               break;
+            case Intersect:
+               /*
+                * <type> ** <type>
+                */
+               il = new_il(IL_Inter, 2);
+               il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
+                  escapes);
+               il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
+                  escapes);
+               break;
+            case New: {
+               /*
+                * new <icon-type> ( <type> ,  ... )
+                */
+               struct node *typ;
+               struct node *args;
+               int nargs;
+
+               typ = n->u[0].child;
+               args = n->u[1].child;
+
+               typcd = icn_typ(typ);
+               abstrsnty(typ->tok, typcd, indx_stor, chng_stor);
+
+               /*
+                * Determine the number of arguments expected for this
+                *  structure type.
+                */
+               if (typcd >= 0)
+                  nargs = icontypes[typcd].num_comps;
+               else
+                  nargs  = 0;
+               if (nargs == 0)
+                  errt2(typ->tok,typ->tok->image," is not an aggregate type.");
+
+               /*
+                * Create the "new" construct for the data base with its type
+                *  code and arguments.
+                */
+               il = new_il(IL_New, 2 + nargs);
+               il->u[0].n = typcd;
+               il->u[1].n = nargs;
+               while (nargs > 1) {
+                  if (args->nd_id == CommaNd)
+                     il->u[1 + nargs].fld = abstrcomp(args->u[1].child, 0,0,1);
+                  else
+                     errt2(typ->tok, "too few arguments for new",
+                        typ->tok->image);
+                  args = args->u[0].child;
+                  --nargs;
+                  }
+               if (args->nd_id == CommaNd)
+                  errt2(typ->tok, "too many arguments for new",typ->tok->image);
+               il->u[2].fld = abstrcomp(args, 0, 0, 1);
+               }
+               break;
+            }
+         break;
+      case ConCatNd:
+         /*
+          * "Glue" for several side effects.
+          */
+         il = new_il(IL_Lst, 2);
+         il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
+         il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 0);
+         break;
+      }
+   return il;
+   }
+
+/*
+ * abstrsnty - do some sanity checks on how this type is being used in
+ *  an abstract type computation.
+ */
+static void abstrsnty(t, typcd, indx_stor, chng_stor)
+struct token *t;
+int typcd;
+int indx_stor;
+int chng_stor;
+   {
+   struct icon_type *itp;
+
+   if ((typcd < 0) || (!indx_stor))
+      return;
+
+   itp = &icontypes[typcd];
+
+   /*
+    * This type is being used to index the store; make sure this it
+    *   is a variable.
+    */
+   if (itp->deref == DrfNone)
+      errt2(t, itp->id, " is not a variable type");
+
+   if (chng_stor && itp->deref == DrfCnst)
+      errt2(t, itp->id, " has an associated type that may not be changed");
+   }
+
+/*
+ * body_anlz - walk the syntax tree for the C code in a body statment,
+ *  analyzing the code to determine the interface needed by the C function
+ *  which will implement it. Also determine how many buffers are needed.
+ *  The value returned indicates whether it is possible for execution
+ *  to fall through the the code.
+ */
+static int body_anlz(n, does_break, may_mod, const_cast, all)
+struct node *n;   /* subtree being analyzed */
+int *does_break;  /* output flag: subtree contains "break;" */
+int may_mod;      /* input flag: this subtree might be assigned to */
+int const_cast;   /* input flag: expression is cast to (const ...) */
+int all;          /* input flag: need all information about operation */
+   {
+   struct token *t;
+   struct node *n1, *n2, *n3;
+   struct sym_entry *sym;
+   struct var_lst *var_ref;
+   int break_chk = 0;
+   int fall_thru;
+   static int may_brnchto;
+
+   if (n == NULL)
+      return 1;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrimryNd:
+         switch (t->tok_id) {
+            case Fail:
+               if (all)
+                  ret_flag |= DoesFail;
+               return 0;
+            case Errorfail:
+               if (all)
+                  ret_flag |= DoesEFail;
+               return 0;
+            case Break:
+               *does_break = 1;
+               return 0;
+            default: /* do nothing special */
+               return 1;
+            }
+      case PrefxNd:
+         switch (t->tok_id) {
+            case Return:
+               if (all) {
+                  ret_flag |= DoesRet;
+                  chkrettyp(n->u[0].child); /* check for returning of C value */
+                  }
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               return 0;
+            case Suspend:
+               if (all) {
+                  ret_flag |= DoesSusp;
+                  chkrettyp(n->u[0].child); /* check for returning of C value */
+                  }
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               return 1;
+            case '(':
+               /*
+                * parenthesized expression: pass along may_mod and const_cast.
+                */
+               return body_anlz(n->u[0].child, does_break, may_mod, const_cast,
+                  all);
+            case Incr: /* ++ */
+            case Decr: /* -- */
+               /*
+                * Operand may be modified.
+                */
+               body_anlz(n->u[0].child, does_break, 1, 0, all);
+               return 1;
+            case '&':
+               /*
+                * Unless the address is cast to a const pointer, this
+                *  might be a modifiying reference.
+                */
+               if (const_cast)
+                  body_anlz(n->u[0].child, does_break, 0, 0, all);
+               else
+                  body_anlz(n->u[0].child, does_break, 1, 0, all);
+               return 1;
+            case Default:
+               fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
+               may_brnchto = 1;
+               return fall_thru;
+            case Goto:
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               return 0;
+            default: /* unary operations the need nothing special */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               return 1;
+            }
+      case PstfxNd:
+         if (t->tok_id == ';')
+            return body_anlz(n->u[0].child, does_break, 0, 0, all);
+         else {
+            /*
+             * C expressions: <expr> ++
+             *                <expr> --
+             *
+             * modify operand
+             */
+            return body_anlz(n->u[0].child, does_break, 1, 0, all);
+            }
+      case PreSpcNd:
+         body_anlz(n->u[0].child, does_break, 0, 0, all);
+         return 1;
+      case SymNd:
+         /*
+          * This is an identifier.
+          */
+         if (!all)
+             return 1;
+         sym = n->u[0].sym;
+         if (sym->id_type == RsltLoc) {
+            /*
+             * Note that this body code explicitly references the result
+             *  location of the operation.
+             */
+            rslt_loc = 1;
+            }
+         else if (sym->nest_lvl == 2) {
+            /*
+             * This variable is local to the operation, but declared outside
+             *  the body. It must passed as a parameter to the function.
+             *  See if it is in the parameter list yet.
+             */
+            if (!(sym->id_type & PrmMark)) {
+               sym->id_type |= PrmMark;
+               var_ref = NewStruct(var_lst);
+               var_ref->sym = sym;
+               var_ref->next = body_prms;
+               body_prms = var_ref;
+               ++n_bdy_prms;
+               }
+
+            /*
+             *  Note if the variable might be assigned to.
+             */
+            sym->may_mod |= may_mod;
+            }
+         return 1;
+      case BinryNd:
+         switch (t->tok_id) {
+            case '[': /* subscripting */
+            case '.':
+               /*
+                * Assignments will modify left operand.
+                */
+               body_anlz(n->u[0].child, does_break, may_mod, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return 1;
+            case '(':
+               /*
+                * ( <type> ) expr
+                */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               /*
+                * See if the is a const cast.
+                */
+               for (n1 = n->u[0].child; n1->nd_id == LstNd; n1 = n1->u[0].child)
+                  ;
+               if (n1->nd_id == PrimryNd && n1->tok->tok_id == Const)
+                  body_anlz(n->u[1].child, does_break, 0, 1, all);
+               else
+                  body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return 1;
+            case ')':
+               /*
+                * function call or declaration: <expr> ( <expr-list> )
+                */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return call_ret(n->u[0].child);
+            case ':':
+            case Case:
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
+               may_brnchto = 1;
+               return fall_thru;
+            case Switch:
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               fall_thru = body_anlz(n->u[1].child, &break_chk, 0, 0, all);
+               return fall_thru | break_chk;
+            case While: {
+	       struct node *n0 = n->u[0].child;
+               body_anlz(n0, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, &break_chk, 0, 0, all);
+	       /*
+		* check for an infinite loop, while (1) ... :
+                *  a condition consisting of an IntConst with image=="1"
+                *  and no breaks in the body.
+		*/
+	       if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
+		   !strcmp(n0->tok->image,"1") && !break_chk)
+		  return 0;
+               return 1;
+	       }
+            case Do:
+               /*
+                * Any "break;" statements in the body do not effect
+                *  outer loops so pass along a new flag for does_break.
+                */
+               body_anlz(n->u[0].child, &break_chk, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return 1;
+            case Runerr:
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               if (all)
+                  ret_flag |= DoesEFail;  /* possibler error failure */
+               return 0;
+            case '=':
+            case MultAsgn:  /*  *=  */
+            case DivAsgn:   /*  /=  */
+            case ModAsgn:   /*  %=  */
+            case PlusAsgn:  /*  +=  */
+            case MinusAsgn: /*  -=  */
+            case LShftAsgn: /* <<=  */
+            case RShftAsgn: /* >>=  */
+            case AndAsgn:   /*  &=  */
+            case XorAsgn:   /*  ^=  */
+            case OrAsgn:    /*  |=  */
+               /*
+                * Left operand is modified.
+                */
+               body_anlz(n->u[0].child, does_break, 1, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return 1;
+            default: /* binary operations that need nothing special */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               return 1;
+            }
+      case LstNd:
+      case StrDclNd:
+         /*
+          * Some declaration code.
+          */
+         body_anlz(n->u[0].child, does_break, 0, 0, all);
+         body_anlz(n->u[1].child, does_break, 0, 0, all);
+         return 1;
+      case ConCatNd:
+        /*
+         * <some-code> <some-code>
+         */
+         if (body_anlz(n->u[0].child, does_break, 0, 0, all))
+            return body_anlz(n->u[1].child, does_break, 0, 0, all);
+         else {
+            /*
+             * Cannot directly reach the second piece of code, see if
+             *  it is possible to branch into it.
+             */
+            may_brnchto = 0;
+            fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
+            return may_brnchto & fall_thru;
+            }
+      case CommaNd:
+         /*
+          * <expr> , <expr>
+          */
+         fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
+         return fall_thru & body_anlz(n->u[1].child, does_break, 0, 0, all);
+      case CompNd:
+         /*
+          * Compound statement, look only at executable code.
+          *
+          *  First traverse declaration list looking for initializers.
+          */
+         n1 = n->u[0].child;
+         while (n1 != NULL) {
+            if (n1->nd_id == LstNd) {
+               n2 = n1->u[1].child;
+               n1 = n1->u[0].child;
+               }
+            else {
+               n2 = n1;
+               n1 = NULL;
+               }
+
+            /*
+             * Get declarator list from declaration and traverse it.
+             */
+            n2 = n2->u[1].child;
+            while (n2 != NULL) {
+               if (n2->nd_id == CommaNd) {
+                  n3 = n2->u[1].child;
+                  n2 = n2->u[0].child;
+                  }
+               else {
+                  n3 = n2;
+                  n2 = NULL;
+                  }
+               if (n3->nd_id == BinryNd && n3->tok->tok_id == '=')
+                   body_anlz(n3->u[1].child, does_break, 0, 0, all);
+               }
+            }
+
+         /*
+          * Check initializers on tended declarations.
+          */
+         for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next)
+            body_anlz(sym->u.tnd_var.init, does_break, 0, 0, all);
+
+         /*
+          * Do the statement list.
+          */
+         return body_anlz(n->u[2].child, does_break, 0, 0, all);
+      case TrnryNd:
+         switch (t->tok_id) {
+            case Cnv:
+               /*
+                * extended C code: cnv: <type> ( <source> )
+                *                  cnv: <type> ( <source> , <destination> )
+                *
+                *  For some conversions, buffers may have to be allocated.
+                *  An explicit destination must be marked as modified.
+                */
+               if (all)
+                  cnt_bufs(n->u[0].child);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               body_anlz(n->u[2].child, does_break, 1, 0, all);
+               return 1;
+            case If:
+               /*
+                * Execution falls through an if statement if it falls
+                *  through either branch. A null "else" branch always
+                *  falls through.
+                */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               return body_anlz(n->u[1].child, does_break, 0, 0, all) |
+                  body_anlz(n->u[2].child, does_break, 0, 0, all);
+            case Type_case:
+               /*
+                * type_case <expr> of { <section-list> }
+                * type_case <expr> of { <section-list> <default-clause> }
+                */
+
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               /*
+                * Loop through the case clauses.
+                */
+               fall_thru = 0;
+               for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
+                  n2 = n1->u[1].child->u[1].child;
+                  fall_thru |= body_anlz(n2, does_break, 0, 0, all);
+                  }
+               return fall_thru | body_anlz(n->u[2].child, does_break, 0, 0,
+                  all);
+            default: /* nothing special is needed for these ternary nodes */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               body_anlz(n->u[2].child, does_break, 0, 0, all);
+               return 1;
+               }
+      case QuadNd:
+         if (t->tok_id == Def) {
+               /*
+                * extended C code:
+                *   def: <type> ( <source> , <default> )
+                *   def: <type> ( <source> , <default> , <destination> )
+                *
+                *  For some conversions, buffers may have to be allocated.
+                *  An explicit destination must be marked as modified.
+                */
+               if (all)
+                  cnt_bufs(n->u[0].child);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               body_anlz(n->u[2].child, does_break, 0, 0, all);
+               body_anlz(n->u[3].child, does_break, 1, 0, all);
+               return 1;
+               }
+          else {  /* for */
+               /*
+                * Check for an infinite loop:  for (<expr>; ; <expr> ) ...
+                *
+                *  No ending condition and no breaks in the body.
+                */
+               body_anlz(n->u[0].child, does_break, 0, 0, all);
+               body_anlz(n->u[1].child, does_break, 0, 0, all);
+               body_anlz(n->u[2].child, does_break, 0, 0, all);
+               body_anlz(n->u[3].child, &break_chk, 0, 0, all);
+               if (n->u[1].child == NULL && !break_chk)
+                  return 0;
+               else
+                  return 1;
+               }
+      }
+   err1("rtt internal error detected in function body_anlz()");
+   /* NOTREACHED */
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ *  lcl_tend  - allocate any tended variables needed in this body or inline
+ *   statement.
+ */
+static void lcl_tend(n)
+struct node *n;
+   {
+   struct sym_entry *sym;
+
+   if (n == NULL)
+      return;
+
+   /*
+    * Walk the syntax tree until a block with declarations is found.
+    */
+   switch (n->nd_id) {
+      case PrefxNd:
+      case PstfxNd:
+      case PreSpcNd:
+        lcl_tend(n->u[0].child);
+        break;
+      case BinryNd:
+      case LstNd:
+      case ConCatNd:
+      case CommaNd:
+      case StrDclNd:
+        lcl_tend(n->u[0].child);
+        lcl_tend(n->u[1].child);
+        break;
+      case CompNd:
+         /*
+          * Allocate the tended variables in this block, noting that the
+          *  level of nesting in this C function is one less than in the
+          *  operation as a whole. Then mark the tended slots as free for
+          *  use in the next block.
+          */
+         for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next) {
+            sym->t_indx = alloc_tnd(sym->id_type, sym->u.tnd_var.init,
+               sym->nest_lvl - 1);
+            }
+         lcl_tend(n->u[2].child);
+         sym = n->u[1].sym;
+         if (sym != NULL)
+            unuse(tend_lst, sym->nest_lvl - 1);
+         break;
+      case TrnryNd:
+         lcl_tend(n->u[0].child);
+         lcl_tend(n->u[1].child);
+         lcl_tend(n->u[2].child);
+         break;
+      case QuadNd:
+         lcl_tend(n->u[0].child);
+         lcl_tend(n->u[1].child);
+         lcl_tend(n->u[2].child);
+         lcl_tend(n->u[3].child);
+         break;
+      }
+   }
+
+/*
+ * chkrettyp - check type of return to see if it is a C integer or a
+ *  C double and make note of what is found.
+ */
+static void chkrettyp(n)
+struct node *n;
+   {
+   if (n->nd_id == PrefxNd && n->tok != NULL) {
+      switch (n->tok->tok_id) {
+         case C_Integer:
+            body_ret |= RetInt;
+            return;
+         case C_Double:
+            body_ret |= RetDbl;
+            return;
+         }
+      }
+   body_ret |= RetOther;
+   }
+
+/*
+ * body_fnc - produce the function which implements a body statement.
+ */
+static struct il_code *body_fnc(n)
+struct node *n;
+   {
+   struct node *compound;
+   struct node *dcls;
+   struct node *stmts;
+   struct var_lst *var_ref;
+   struct sym_entry *sym;
+   struct il_code *il;
+   int fall_thru;          /* flag: control can fall through end of body */
+   int num_sigs;           /* number of different signals function may return */
+   int bprm_indx;
+   int first;
+   int is_reg;
+   int strct;
+   int addr;
+   int by_ref;
+   int just_desc;
+   int dummy_int;
+   char buf1[6];
+
+   char *cname;
+   char buf[MaxPath];
+
+   /*
+    * Figure out the next character to use as the 3rd prefix for the
+    *  name of this body function.
+    */
+   if (prfx3 == ' ')
+      prfx3 = '0';
+   else if (prfx3 == '9')
+      prfx3 = 'a';
+   else if (prfx3 == 'z')
+      errt2(n->tok, "more than 26 body statements in", cur_impl->name);
+   else
+      ++prfx3;
+
+   /*
+    * Free any old body parameters and tended locations.
+    */
+   while (body_prms != NULL) {
+      var_ref = body_prms;
+      body_prms = body_prms->next;
+      free((char *)var_ref);
+      }
+   free_tend();
+
+   /*
+    * Locate the outer declarations and statements from the body clause.
+    */
+   compound = n->u[0].child;
+   dcls = compound->u[0].child;
+   stmts = compound->u[2].child;
+
+   /*
+    * Analyze the body code to determine what the function's interface
+    *  needs. body_anlz() does the work after the counters and flags
+    *  are initialized.
+    */
+   n_tmp_str = 0;  /* number of temporary string buffers neeeded */
+   n_tmp_cset = 0; /* number of temporary cset buffers needed */
+   nxt_sbuf = 0;   /* next string buffer index; used in code generation */
+   nxt_cbuf = 0;   /* next cset buffer index; used in code generation */
+   n_bdy_prms = 0; /* number of variables needed as body function parameters */
+   body_ret = 0;   /* flag: C values and/or non-C values returned */
+   ret_flag = 0;   /* flag: return, suspend, fail, error fail */
+   rslt_loc = 0;   /* flag: body code needs operations result location */
+   fall_thru = body_anlz(compound, &dummy_int, 0, 0, 1);
+   lcl_tend(n);    /* allocate tended descriptors needed */
+
+
+   /*
+    * Use the letter indicating operation type along with body function
+    *  prefixes to construct the name of the file to hold the C code.
+    */
+   sprintf(buf1, "%c_%c%c%c", lc_letter, prfx1, prfx2, prfx3);
+   cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
+   if ((out_file = fopen(cname, "w")) == NULL)
+      err2("cannot open output file ", cname);
+   else
+      addrmlst(cname, out_file);
+
+   prologue(); /* output standard comments and preprocessor directives */
+
+   /*
+    * If the function produces a unique signal, the function need not actually
+    *  return it, and we may be able to use the return value for something
+    *  else. See if this is true.
+    */
+   num_sigs = 0;
+   if (ret_flag & DoesRet)
+      ++num_sigs;
+   if (ret_flag & (DoesFail  | DoesEFail))
+      ++num_sigs;
+   if (ret_flag & DoesSusp)
+      num_sigs += 2;    /* something > 1 (success cont. may return anything) */
+   if (fall_thru) {
+      ret_flag |= DoesFThru;
+      ++num_sigs;
+      }
+
+   if (num_sigs > 1)
+      fnc_ret = RetSig;  /* Function must return a signal */
+   else {
+      /*
+       * If the body returns a C_integer or a C_double, we can make the
+       *  function directly return the C value and the compiler can decide
+       *  whether to construct a descriptor.
+       */
+      if (body_ret == RetInt || body_ret == RetDbl)
+         fnc_ret = body_ret;
+      else
+         fnc_ret = RetNoVal; /* Function returns nothing directly */
+      }
+
+   /*
+    * Decide whether the function needs to to be passed an explicit result
+    *  location (the case where "result" is explicitly referenced is handled
+    *  while analyzing the body). suspend always uses the result location.
+    *  return uses the result location unless the function directly
+    *  returns a C value.
+    */
+   if (ret_flag & DoesSusp)
+      rslt_loc = 1;
+   else if ((ret_flag & DoesRet) && (fnc_ret != RetInt && fnc_ret != RetDbl))
+      rslt_loc = 1;
+
+   /*
+    * The data base entry for the call to the body function has 8 slots
+    *  for standard interface information and 2 slots for each parameter.
+    */
+   il = new_il(IL_Call, 8 + 2 * n_bdy_prms);
+   il->u[0].n = 0;         /* reserved for internal use by compiler */
+   il->u[1].n = prfx3;
+   il->u[2].n = fnc_ret;
+   il->u[3].n = ret_flag;
+   il->u[4].n = rslt_loc;
+   il->u[5].n = 0;       /* number of string buffers to pass in: set below */
+   il->u[6].n = 0;       /* number of cset buffers to pass in: set below */
+   il->u[7].n = n_bdy_prms;
+   bprm_indx = 8;
+
+   /*
+    * Write the C function header for the body function.
+    */
+   switch (fnc_ret) {
+      case RetSig:
+         fprintf(out_file, "int ");
+         break;
+      case RetInt:
+         fprintf(out_file, "C_integer ");
+         break;
+      case RetDbl:
+         fprintf(out_file, "double ");
+         break;
+      case RetNoVal:
+         fprintf(out_file, "void ");
+         break;
+      }
+   fprintf(out_file, " %c%c%c%c_%s(", uc_letter, prfx1, prfx2, prfx3,
+        cur_impl->name);
+   fname = cname;
+   line = 7;
+
+   /*
+    * Write parameter list, first the parenthesized list of names. Start
+    *  with names of RLT variables that must be passed in.
+    */
+   first = 1;
+   for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
+      sym = var_ref->sym;
+      sym->id_type &= ~PrmMark;             /* unmark entry */
+      if (first)
+         first = 0;
+      else
+         prt_str(", ", IndentInc);
+      prt_str(sym->image, IndentInc);
+      }
+
+   if (fall_thru) {
+      /*
+       * We cannot allocate string and cset buffers locally, so any
+       *   that are needed must be parameters.
+       */
+      if (n_tmp_str > 0) {
+         if (first)
+            first = 0;
+         else
+            prt_str(", ", IndentInc);
+         prt_str("r_sbuf", IndentInc);
+         }
+      if (n_tmp_cset > 0) {
+         if (first)
+            first = 0;
+         else
+            prt_str(", ", IndentInc);
+         prt_str("r_cbuf", IndentInc);
+         }
+      }
+
+   /*
+    * If the result location is needed it is passed as the next parameter.
+    */
+   if (rslt_loc) {
+      if (first)
+         first = 0;
+      else
+         prt_str(", ", IndentInc);
+      prt_str("r_rslt", IndentInc);
+      }
+
+   /*
+    * If a success continuation is needed, it goes last.
+    */
+   if (ret_flag & DoesSusp) {
+      if (!first)
+         prt_str(", ", IndentInc);
+      prt_str("r_s_cont", IndentInc);
+      }
+   prt_str(")", IndentInc);
+   ForceNl();
+
+   /*
+    * Go through the parameters to this function writing out declarations
+    *  and filling in rest of data base entry. Start with RLT variables.
+    */
+   for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
+      /*
+       * Each parameters has two slots in the data base entry. One
+       *  is the declaration for use by iconc in producing function
+       *  prototypes. The other is the argument that must be passed as
+       *  part of the call generated by iconc.
+       *
+       * Determine whether the parameter is passed by reference or by
+       *  value (flag by_ref). Tended variables that refer to just the
+       *  vword of a descriptor require special handling. They must
+       *  be passed to the body function as a pointer to the entire
+       *  descriptor and not just the vword. Within the function the
+       *  parameter is then accessed as x->vword... This is indicated
+       *  by the parameter flag just_desc.
+       */
+      sym = var_ref->sym;
+      var_ref->id_type = sym->id_type;      /* save old id_type */
+      by_ref = 0;
+      just_desc = 0;
+      switch (sym->id_type) {
+         case TndDesc:  /* tended struct descrip x */
+            by_ref = 1;
+            il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
+            break;
+         case TndStr:   /* tended char *x */
+         case TndBlk:   /* tended struct b_??? *x or tended union block *x */
+            by_ref = 1;
+            just_desc = 1;
+            il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
+            break;
+         case RtParm: /* undereferenced RTL parameter */
+         case DrfPrm: /* dereferenced RTL parameter */
+            switch (sym->u.param_info.cur_loc) {
+               case PrmTend: /* plain parameter: descriptor */
+                  by_ref = 1;
+                  il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
+                  break;
+               case PrmCStr: /* parameter converted to a tended C string */
+                  by_ref = 1;
+                  just_desc = 1;
+                  il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
+                  break;
+               case PrmInt:  /* parameter converted to a C integer */
+                  sym->id_type = OtherDcl;
+                  if (var_ref->sym->may_mod && fall_thru)
+                     by_ref = 1;
+                  il->u[bprm_indx++].c_cd = simpl_dcl("C_integer ", by_ref,
+                     sym);
+                  break;
+               case PrmDbl: /* parameter converted to a C double */
+                  sym->id_type = OtherDcl;
+                  if (var_ref->sym->may_mod && fall_thru)
+                     by_ref =  1;
+                  il->u[bprm_indx++].c_cd = simpl_dcl("double ", by_ref, sym);
+                  break;
+               }
+            break;
+         case RtParm | VarPrm:
+         case DrfPrm | VarPrm:
+            /*
+             * Variable part of RTL parameter list: already descriptor pointer.
+             */
+            sym->id_type = OtherDcl;
+            il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
+            break;
+         case VArgLen:
+            /*
+             * Number of elements in variable part of RTL parameter list:
+             *  integer but not a true variable.
+             */
+            sym->id_type = OtherDcl;
+            il->u[bprm_indx++].c_cd = simpl_dcl("int ", 0, sym);
+            break;
+         case OtherDcl:
+            is_reg = 0;
+            /*
+             * Pass by reference if it is a structure or union type (but
+             *  not if it is a pointer to one) or if the variable is
+             *  modified and it is possible to execute more code after the
+             *  body. WARNING: crude assumptions are made for typedef
+             *  types.
+             */
+            strct = strct_typ(sym->u.declare_var.tqual, &is_reg);
+            addr = is_addr(sym->u.declare_var.dcltor, '\0');
+            if ((strct && !addr) || (var_ref->sym->may_mod && fall_thru))
+                  by_ref = 1;
+            if (is_reg && by_ref)
+              errt2(sym->u.declare_var.dcltor->u[1].child->tok, sym->image,
+                 " may not be declared 'register'");
+
+            il->u[bprm_indx++].c_cd = parm_dcl(by_ref, sym);
+            break;
+         }
+
+      /*
+       * Determine what the iconc generated argument in a function
+       *  call should look like.
+       */
+      il->u[bprm_indx++].c_cd = bdy_prm(by_ref, just_desc, sym,
+         var_ref->sym->may_mod);
+
+      /*
+       * If it a call-by-reference parameter, indicate that the level
+       *  of indirection must be taken into account within the function
+       *  body.
+       */
+      if (by_ref)
+         sym->id_type |= ByRef;
+      }
+
+   if (fall_thru) {
+      /*
+       * Write declarations for any needed buffer parameters.
+       */
+      if (n_tmp_str > 0) {
+         prt_str("char (*r_sbuf)[MaxCvtLen];", 0);
+         ForceNl();
+         }
+      if (n_tmp_cset > 0) {
+         prt_str("struct b_cset *r_cbuf;", 0);
+         ForceNl();
+         }
+      /*
+       * Indicate that buffers must be allocated by compiler and not
+       *  within the function.
+       */
+      il->u[5].n = n_tmp_str;
+      il->u[6].n = n_tmp_cset;
+      n_tmp_str = 0;
+      n_tmp_cset = 0;
+      }
+
+   /*
+    * Write declarations for result location and success continuation
+    *  parameters if they are needed.
+    */
+   if (rslt_loc) {
+      prt_str("dptr r_rslt;", 0);
+      ForceNl();
+      }
+   if (ret_flag & DoesSusp) {
+      prt_str("continuation r_s_cont;", 0);
+      ForceNl();
+      }
+
+   /*
+    * Output the code for the function including ordinary declaration,
+    *  special declarations, and executable code.
+    */
+   prt_str("{", IndentInc);
+   ForceNl();
+   c_walk(dcls, IndentInc, 0);
+   spcl_dcls(NULL);
+   c_walk(stmts, IndentInc, 0);
+   ForceNl();
+   /*
+    * If it is possible for excution to fall through to the end of
+    *  the body function, and it does so, return an A_FallThru signal.
+    */
+   if (fall_thru) {
+      if (tend_lst != NULL) {
+	 prt_str("tend = tend->previous;", IndentInc);
+	 ForceNl();
+         }
+      if (fnc_ret == RetSig) {
+         prt_str("return A_FallThru;", IndentInc);
+         ForceNl();
+         }
+      }
+   prt_str("}\n", IndentInc);
+   if (fclose(out_file) != 0)
+      err2("cannot close ", cname);
+   put_c_fl(cname, 1);
+
+   /*
+    * Restore the symbol table to its previous state. Note any parameters
+    *  that were modified by the body code.
+    */
+   for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
+      sym = var_ref->sym;
+      sym->id_type = var_ref->id_type;
+      if (sym->id_type & DrfPrm)
+         sym->u.param_info.parm_mod |= sym->may_mod;
+      sym->may_mod = 0;
+      }
+
+   if (!fall_thru)
+       clr_prmloc();
+   return il;
+   }
+
+/*
+ * strct_typ - determine if the declaration may be for a structured type
+ *   and look for register declarations.
+ */
+static int strct_typ(typ, is_reg)
+struct node *typ;
+int *is_reg;
+   {
+   if (typ->nd_id == LstNd) {
+      return strct_typ(typ->u[0].child, is_reg) |
+         strct_typ(typ->u[1].child, is_reg);
+      }
+   else if (typ->nd_id == PrimryNd) {
+      switch (typ->tok->tok_id) {
+         case Typedef:
+         case Extern:
+            errt2(typ->tok, "declare {...} should not contain ",
+               typ->tok->image);
+         case TokRegister:
+            *is_reg = 1;
+            return 0;
+         case TypeDefName:
+            if (strcmp(typ->tok->image, "word")  == 0 ||
+                strcmp(typ->tok->image, "uword") == 0 ||
+                strcmp(typ->tok->image, "dptr")  == 0)
+               return 0;   /* assume non-structure type */
+            else
+               return 1;   /* might be a structure (is not C_integer) */
+         default:
+            return 0;
+         }
+      }
+   else {
+      /*
+       * struct, union, or enum.
+       */
+      return 1;
+      }
+   }
+
+/*
+ * determine if the variable being declared evaluates to an address.
+ */
+static int is_addr(dcltor, modifier)
+struct node *dcltor;
+int modifier;
+   {
+   switch (dcltor->nd_id) {
+      case ConCatNd:
+         /*
+          * pointer?
+          */
+         if (dcltor->u[0].child != NULL)
+            modifier = '*';
+         return is_addr(dcltor->u[1].child, modifier);
+      case PrimryNd:
+         /*
+          * We have reached the name.
+          */
+         switch (modifier) {
+            case '\0':
+               return 0;
+            case '*':
+            case '[':
+               return 1;
+            case ')':
+               errt1(dcltor->tok,
+                  "declare {...} should not contain a prototype");
+            }
+      case PrefxNd:
+         /*
+          * (...)
+          */
+         return is_addr(dcltor->u[0].child, modifier);
+      case BinryNd:
+         /*
+          * function or array.
+          */
+         return is_addr(dcltor->u[0].child, dcltor->tok->tok_id);
+      }
+   err1("rtt internal error detected in function is_addr()");
+   /* NOTREACHED */
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ * chgn_ploc - if this is an "in-place" conversion to a C value, change
+ *  the "location" of the parameter being converted.
+ */
+static void chng_ploc(typcd, src)
+int typcd;
+struct node *src;
+   {
+   int loc;
+
+   /*
+    * Note, we know this is a valid conversion, because it got through
+    *  pass 1.
+    */
+   loc = PrmTend;
+   switch (typcd) {
+      case TypCInt:
+      case TypECInt:
+         loc = PrmInt;
+         break;
+      case TypCDbl:
+         loc = PrmDbl;
+         break;
+      case TypCStr:
+         loc = PrmCStr;
+         break;
+      }
+   if (loc != PrmTend)
+      src->u[0].sym->u.param_info.cur_loc = loc;
+   }
+
+/*
+ * cnt_bufs - See if we need to allocate a string or cset buffer for
+ *  this conversion.
+ */
+static void cnt_bufs(cnv_typ)
+struct node *cnv_typ;
+   {
+   if (cnv_typ->nd_id == PrimryNd)
+      switch (cnv_typ->tok->tok_id) {
+         case Tmp_string:
+            ++n_tmp_str;
+            break;
+         case Tmp_cset:
+            ++n_tmp_cset;
+            break;
+         }
+   }
+
+/*
+ * mrg_abstr - merge (join) types of abstract returns on two execution paths.
+ *   The type lattice has three levels: NoAbstr is bottom, SomeType is top,
+ *   and individual types form the middle level.
+ */
+static int mrg_abstr(sum, typ)
+int sum;
+int typ;
+   {
+   if (sum == NoAbstr)
+      return typ;
+   else if (typ == NoAbstr)
+      return sum;
+   else if (sum == typ)
+      return sum;
+   else
+      return SomeType;
+   }
+#endif					/* Rttx */
diff --git a/src/rtt/rttlex.c b/src/rtt/rttlex.c
new file mode 100644
index 0000000..3e100bc
--- /dev/null
+++ b/src/rtt/rttlex.c
@@ -0,0 +1,356 @@
+/*
+ * This lexical analyzer uses the preprocessor to convert text into tokens.
+ *  The lexical anayser discards white space, checks to see if identifiers
+ *  are reserved words or typedef names, makes sure single characters
+ *  are valid tokens, and converts preprocessor constants into the
+ *  various C constants.
+ */
+#include "rtt.h"
+
+/*
+ * Prototype for static function.
+ */
+static int int_suffix (char *s);
+
+int lex_state = DfltLex;
+
+char *ident = "ident";
+
+/*
+ * Characters are used as token id's for single character tokens. The
+ *  following table indicates which ones can be valid for RTL.
+ */
+
+#define GoodChar(c) ((c) < 127 && good_char[c])
+static int good_char[128] = {
+   0  /* \000 */,   0  /* \001 */,   0  /* \002 */,   0  /* \003 */,
+   0  /* \004 */,   0  /* \005 */,   0  /* \006 */,   0  /* \007 */,
+   0  /*  \b  */,   0  /*  \t  */,   0  /*  \n  */,   0  /*  \v  */,
+   0  /*  \f  */,   0  /*  \r  */,   0  /* \016 */,   0  /* \017 */,
+   0  /* \020 */,   0  /* \021 */,   0  /* \022 */,   0  /* \023 */,
+   0  /* \024 */,   0  /* \025 */,   0  /* \026 */,   0  /* \027 */,
+   0  /* \030 */,   0  /* \031 */,   0  /* \032 */,   0  /*  \e  */,
+   0  /* \034 */,   0  /* \035 */,   0  /* \036 */,   0  /* \037 */,
+   0  /*      */,   1  /*  !   */,   0  /*  \   */,   0  /*  #   */,
+   0  /*  $   */,   1  /*  %   */,   1  /*  &   */,   0  /*  '   */,
+   1  /*  (   */,   1  /*  )   */,   1  /*  *   */,   1  /*  +   */,
+   1  /*  ,   */,   1  /*  -   */,   1  /*  .   */,   1  /*  /   */,
+   0  /*  0   */,   0  /*  1   */,   0  /*  2   */,   0  /*  3   */,
+   0  /*  4   */,   0  /*  5   */,   0  /*  6   */,   0  /*  7   */,
+   0  /*  8   */,   0  /*  9   */,   1  /*  :   */,   1  /*  ;   */,
+   1  /*  <   */,   1  /*  =   */,   1  /*  >   */,   1  /*  ?   */,
+   0  /*  @   */,   0  /*  A   */,   0  /*  B   */,   0  /*  C   */,
+   0  /*  D   */,   0  /*  E   */,   0  /*  F   */,   0  /*  G   */,
+   0  /*  H   */,   0  /*  I   */,   0  /*  J   */,   0  /*  K   */,
+   0  /*  L   */,   0  /*  M   */,   0  /*  N   */,   0  /*  O   */,
+   0  /*  P   */,   0  /*  Q   */,   0  /*  R   */,   0  /*  S   */,
+   0  /*  T   */,   0  /*  U   */,   0  /*  V   */,   0  /*  W   */,
+   0  /*  X   */,   0  /*  Y   */,   0  /*  Z   */,   1  /*  [   */,
+   1  /*  \\  */,   1  /*  ]   */,   1  /*  ^   */,   0  /*  _   */,
+   0  /*  `   */,   0  /*  a   */,   0  /*  b   */,   0  /*  c   */,
+   0  /*  d   */,   0  /*  e   */,   0  /*  f   */,   0  /*  g   */,
+   0  /*  h   */,   0  /*  i   */,   0  /*  j   */,   0  /*  k   */,
+   0  /*  l   */,   0  /*  m   */,   0  /*  n   */,   0  /*  o   */,
+   0  /*  p   */,   0  /*  q   */,   0  /*  r   */,   0  /*  s   */,
+   0  /*  t   */,   0  /*  u   */,   0  /*  v   */,   0  /*  w   */,
+   0  /*  x   */,   0  /*  y   */,   0  /*  z   */,   1  /*  {   */,
+   1  /*  |   */,   1  /*  }   */,   1  /*  ~   */,   0  /*  \d  */
+   };
+
+/*
+ * init_lex - initialize lexical analyzer.
+ */
+void init_lex()
+   {
+   struct sym_entry *sym;
+   int i;
+   static int first_time = 1;
+
+   if (first_time) {
+      first_time = 0;
+      ident = spec_str(ident);  /* install ident in string table */
+      /*
+       * install C keywords into the symbol table
+       */
+      sym_add(Auto,          spec_str("auto"),          OtherDcl, 0);
+      sym_add(Break,         spec_str("break"),         OtherDcl, 0);
+      sym_add(Case,          spec_str("case"),          OtherDcl, 0);
+      sym_add(TokChar,       spec_str("char"),          OtherDcl, 0);
+      sym_add(Const,         spec_str("const"),         OtherDcl, 0);
+      sym_add(Continue,      spec_str("continue"),      OtherDcl, 0);
+      sym_add(Default,       spec_str("default"),       OtherDcl, 0);
+      sym_add(Do,            spec_str("do"),            OtherDcl, 0);
+      sym_add(Doubl,         spec_str("double"),        OtherDcl, 0);
+      sym_add(Else,          spec_str("else"),          OtherDcl, 0);
+      sym_add(TokEnum,       spec_str("enum"),          OtherDcl, 0);
+      sym_add(Extern,        spec_str("extern"),        OtherDcl, 0);
+      sym_add(Float,         spec_str("float"),         OtherDcl, 0);
+      sym_add(For,           spec_str("for"),           OtherDcl, 0);
+      sym_add(Goto,          spec_str("goto"),          OtherDcl, 0);
+      sym_add(If,            spec_str("if"),            OtherDcl, 0);
+      sym_add(Int,           spec_str("int"),           OtherDcl, 0);
+      sym_add(TokLong,       spec_str("long"),          OtherDcl, 0);
+      sym_add(TokRegister,   spec_str("register"),      OtherDcl, 0);
+      sym_add(Return,        spec_str("return"),        OtherDcl, 0);
+      sym_add(TokShort,      spec_str("short"),         OtherDcl, 0);
+      sym_add(Signed,        spec_str("signed"),        OtherDcl, 0);
+      sym_add(Sizeof,        spec_str("sizeof"),        OtherDcl, 0);
+      sym_add(Static,        spec_str("static"),        OtherDcl, 0);
+      sym_add(Struct,        spec_str("struct"),        OtherDcl, 0);
+      sym_add(Switch,        spec_str("switch"),        OtherDcl, 0);
+      sym_add(Typedef,       spec_str("typedef"),       OtherDcl, 0);
+      sym_add(Union,         spec_str("union"),         OtherDcl, 0);
+      sym_add(Unsigned,      spec_str("unsigned"),      OtherDcl, 0);
+      sym_add(Void,          spec_str("void"),          OtherDcl, 0);
+      sym_add(Volatile,      spec_str("volatile"),      OtherDcl, 0);
+      sym_add(While,         spec_str("while"),         OtherDcl, 0);
+
+      /*
+       * Install keywords from run-time interface language.
+       */
+      sym_add(Abstract,      spec_str("abstract"),      OtherDcl, 0);
+      sym_add(All_fields,    spec_str("all_fields"),    OtherDcl, 0);
+      sym_add(Any_value,     spec_str("any_value"),     OtherDcl, 0);
+      sym_add(Arith_case,    spec_str("arith_case"),    OtherDcl, 0);
+      sym_add(Body,          spec_str("body"),          OtherDcl, 0);
+      sym_add(C_Double,      spec_str("C_double"),      OtherDcl, 0);
+      sym_add(C_Integer,     spec_str("C_integer"),     OtherDcl, 0);
+      sym_add(C_String,      spec_str("C_string"),      OtherDcl, 0);
+      sym_add(Cnv,           spec_str("cnv"),           OtherDcl, 0);
+      sym_add(Constant,      spec_str("constant"),      OtherDcl, 0);
+      sym_add(Declare,       spec_str("declare"),       OtherDcl, 0);
+      sym_add(Def,           spec_str("def"),           OtherDcl, 0);
+      sym_add(Empty_type,    spec_str("empty_type"),    OtherDcl, 0);
+      sym_add(End,           spec_str("end"),           OtherDcl, 0);
+      sym_add(Errorfail,     spec_str("errorfail"),     OtherDcl, 0);
+      sym_add(Exact,         spec_str("exact"),         OtherDcl, 0);
+      sym_add(Fail,          spec_str("fail"),          OtherDcl, 0);
+      sym_add(TokFunction,   spec_str("function"),      OtherDcl, 0);
+      sym_add(Inline,        spec_str("inline"),        OtherDcl, 0);
+      sym_add(Is,            spec_str("is"),            OtherDcl, 0);
+      sym_add(Keyword,       spec_str("keyword"),       OtherDcl, 0);
+      sym_add(Len_case,      spec_str("len_case"),      OtherDcl, 0);
+      sym_add(Named_var,     spec_str("named_var"),     OtherDcl, 0);
+      sym_add(New,           spec_str("new"),           OtherDcl, 0);
+      sym_add(Of,            spec_str("of"),            OtherDcl, 0);
+      sym_add(Operator,      spec_str("operator"),      OtherDcl, 0);
+      str_rslt = spec_str("result");
+      sym_add(Runerr,        spec_str("runerr"),        OtherDcl, 0);
+      sym_add(Store,         spec_str("store"),         OtherDcl, 0);
+      sym_add(Struct_var,    spec_str("struct_var"),    OtherDcl, 0);
+      sym_add(Suspend,       spec_str("suspend"),       OtherDcl, 0);
+      sym_add(Tended,        spec_str("tended"),        OtherDcl, 0);
+      sym_add(Then,          spec_str("then"),          OtherDcl, 0);
+      sym_add(Tmp_cset,      spec_str("tmp_cset"),      OtherDcl, 0);
+      sym_add(Tmp_string,    spec_str("tmp_string"),    OtherDcl, 0);
+      sym_add(TokType,       spec_str("type"),          OtherDcl, 0);
+      sym_add(Type_case,     spec_str("type_case"),     OtherDcl, 0);
+      sym_add(Underef,       spec_str("underef"),       OtherDcl, 0);
+      sym_add(Variable,      spec_str("variable"),      OtherDcl, 0);
+
+      for (i = 0; i < num_typs; ++i) {
+         icontypes[i].id = spec_str(icontypes[i].id);
+         sym = sym_add(IconType, icontypes[i].id, OtherDcl, 0);
+         sym->u.typ_indx = i;
+         }
+
+      for (i = 0; i < num_cmpnts; ++i) {
+         typecompnt[i].id = spec_str(typecompnt[i].id);
+         sym = sym_add(Component, typecompnt[i].id, OtherDcl, 0);
+         sym->u.typ_indx = i;
+         }
+      }
+   }
+
+/*
+ * int_suffix - we have reached the end of what seems to be an integer
+ *  constant. check for a valid suffix.
+ */
+static int int_suffix(s)
+char *s;
+   {
+   int tok_id;
+
+   if (*s == 'u' || *s == 'U') {
+      ++s;
+      if (*s == 'l' || *s == 'L') {
+         ++s;
+         tok_id = ULIntConst;  /* unsigned long */
+         }
+      else
+         tok_id  = UIntConst;  /* unsigned */
+      }
+   else if (*s == 'l' || *s == 'L') {
+      ++s;
+      if (*s == 'u' || *s == 'U') {
+         ++s;
+         tok_id = ULIntConst;  /* unsigned long */
+         }
+      else
+         tok_id = LIntConst;   /* long */
+      }
+   else
+      tok_id = IntConst;       /* plain int */
+   if (*s != '\0')
+      errt2(yylval.t, "invalid integer constant: ", yylval.t->image);
+   return tok_id;
+   }
+
+/*
+ * yylex - lexical analyzer, called by yacc-generated parser.
+ */
+int yylex()
+   {
+   register char *s;
+   struct sym_entry *sym;
+   struct token *lk_ahead = NULL;
+   int is_float;
+   struct str_buf *sbuf;
+
+   /*
+    * See if the last call to yylex() left a token from looking ahead.
+    */
+   if (lk_ahead == NULL)
+      yylval.t = preproc();
+   else {
+      yylval.t = lk_ahead;
+      lk_ahead = NULL;
+      }
+
+   /*
+    * Skip white space, then check for end-of-input.
+    */
+   while (yylval.t != NULL && yylval.t->tok_id == WhiteSpace) {
+      free_t(yylval.t);
+      yylval.t = preproc();
+      }
+   if (yylval.t == NULL)
+      return 0;
+
+   /*
+    * The rtt recognizes ** as an operator in abstract type computations.
+    *  The parsing context is indicated by lex_state.
+    */
+   if (lex_state == TypeComp && yylval.t->tok_id == '*') {
+      lk_ahead = preproc();
+      if (lk_ahead != NULL && lk_ahead->tok_id == '*') {
+         free_t(lk_ahead);
+         lk_ahead = NULL;
+         yylval.t->tok_id = Intersect;
+         yylval.t->image = spec_str("**");
+         }
+      }
+
+   /*
+    * Some tokens are passed along without change, but some need special
+    *  processing: identifiers, numbers, PpKeep tokens, and single
+    *  character tokens.
+    */
+   if (yylval.t->tok_id == Identifier) {
+      /*
+       * See if this is an identifier, a reserved word, or typedef name.
+       */
+      sym = sym_lkup(yylval.t->image);
+      if (sym != NULL)
+         yylval.t->tok_id = sym->tok_id;
+      }
+   else if (yylval.t->tok_id == PpNumber) {
+      /*
+       * Determine what kind of numeric constant this is.
+       */
+      s = yylval.t->image;
+      if (*s == '0' && (*++s == 'x' || *s == 'X')) {
+         /*
+          * Hex integer constant.
+          */
+         ++s;
+         while (isxdigit(*s))
+            ++s;
+         yylval.t->tok_id = int_suffix(s);
+         }
+      else {
+         is_float = 0;
+         while (isdigit(*s))
+             ++s;
+         if (*s == '.') {
+            is_float = 1;
+            ++s;
+            while (isdigit(*s))
+               ++s;
+            }
+         if (*s == 'e' || *s == 'E') {
+            is_float = 1;
+            ++s;
+            if (*s == '+' || *s == '-')
+               ++s;
+            while (isdigit(*s))
+               ++s;
+            }
+         if (is_float) {
+            switch (*s) {
+               case '\0':
+                  yylval.t->tok_id = DblConst;   /* double */
+                  break;
+               case 'f': case 'F':
+                   yylval.t->tok_id = FltConst;  /* float */
+                   break;
+               case 'l': case 'L':
+                   yylval.t->tok_id = LDblConst; /* long double */
+                   break;
+               default:
+                   errt2(yylval.t, "invalid float constant: ", yylval.t->image);
+               }
+            }
+         else {
+            /*
+             * This appears to be an integer constant. If it starts
+             *  with '0', it should be an octal constant.
+             */
+            if (yylval.t->image[0] == '0') {
+               s = yylval.t->image;
+               while (*s >= '0' && *s <= '7')
+                  ++s;
+               }
+            yylval.t->tok_id = int_suffix(s);
+            }
+         }
+      }
+   else if (yylval.t->tok_id == PpKeep) {
+      /*
+       * This is a non-standard preprocessor directive that must be
+       *  passed on to the output.
+       */
+      keepdir(yylval.t);
+      return yylex();
+      }
+   else if (lex_state == OpHead && yylval.t->tok_id != '}' &&
+     GoodChar((int)yylval.t->image[0])) {
+      /*
+       * This should be the operator symbol in the header of an operation
+       *  declaration. Concatenate all operator symbols into one token
+       *  of type OpSym.
+       */
+      sbuf = get_sbuf();
+      for (s = yylval.t->image; *s != '\0'; ++s)
+         AppChar(*sbuf, *s);
+      lk_ahead = preproc();
+      while (lk_ahead != NULL && GoodChar((int)lk_ahead->image[0])) {
+         for (s = lk_ahead->image; *s != '\0'; ++s)
+            AppChar(*sbuf, *s);
+         free_t(lk_ahead);
+         lk_ahead = preproc();
+         }
+      yylval.t->tok_id = OpSym;
+      yylval.t->image = str_install(sbuf);
+      rel_sbuf(sbuf);
+      }
+   else if (yylval.t->tok_id < 256) {
+      /*
+       * This is a one-character token, make sure it is valid.
+       */
+      if (!GoodChar(yylval.t->tok_id))
+         errt2(yylval.t, "invalid character: ", yylval.t->image);
+      }
+
+   return yylval.t->tok_id;
+   }
diff --git a/src/rtt/rttmain.c b/src/rtt/rttmain.c
new file mode 100644
index 0000000..2099c2f
--- /dev/null
+++ b/src/rtt/rttmain.c
@@ -0,0 +1,402 @@
+#include "rtt.h"
+
+/*
+ * prototypes for static functions.
+ */
+static void add_tdef (char *name);
+
+/*
+ * refpath is used to locate the standard include files for the Icon
+ *  run-time system. If patchpath has been patched in the binary of rtt,
+ *  the string that was patched in is used for refpath.
+ */
+char *refpath;
+char patchpath[MaxPath+18] = "%PatchStringHere->";
+
+static char *ostr = "+ECPD:I:U:d:cir:st:x";
+
+static char *options =
+   "[-E] [-C] [-P] [-Dname[=[text]]] [-Uname] [-Ipath] [-dfile]\n    \
+[-rpath] [-tname] [-x] [files]";
+
+/*
+ * The relative path to grttin.h and rt.h depends on whether they are
+ *  interpreted as relative to where rtt.exe is or where rtt.exe is
+ *  invoked.
+ */
+    char *grttin_path = "../src/h/grttin.h";
+    char *rt_path = "../src/h/rt.h";
+
+/*
+ *  Note: rtt presently does not process system include files. If this
+ *   is needed, it may be necessary to add other options that set
+ *   manifest constants in such include files.  See pmain.c for the
+ *   stand-alone preprocessor for examples of what's needed.
+ */
+
+char *progname = "rtt";
+char *compiler_def;
+FILE *out_file;
+char *inclname;
+int def_fnd;
+char *largeints = NULL;
+
+int iconx_flg = 0;
+int enable_out = 0;
+
+static char *curlst_nm = "rttcur.lst";
+static FILE *curlst;
+static char *cur_src;
+
+extern int line_cntrl;
+
+/*
+ * tdefnm is used to construct a list of identifiers that
+ *  must be treated by rtt as typedef names.
+ */
+struct tdefnm {
+   char *name;
+   struct tdefnm *next;
+   };
+
+static char *dbname = "rt.db";
+static int pp_only = 0;
+static char *opt_lst;
+static char **opt_args;
+static char *in_header;
+static struct tdefnm *tdefnm_lst = NULL;
+
+/*
+ * getopt() variables
+ */
+extern int optind;		/* index into parent argv vector */
+extern int optopt;		/* character checked for validity */
+extern char *optarg;		/* argument associated with option */
+
+int main(argc, argv)
+int argc;
+char **argv;
+   {
+   int c;
+   int nopts;
+   char buf[MaxPath];		/* file name construction buffer */
+   struct fileparts *fp;
+
+   /*
+    * See if the location of include files has been patched into the
+    *  rtt executable.
+    */
+   if ((int)strlen(patchpath) > 18)
+      refpath = patchpath+18;
+   else
+      refpath = relfile(argv[0], "/../");
+
+   /*
+    * Initialize the string table and indicate that File must be treated
+    *  as a typedef name.
+    */
+   init_str();
+   add_tdef("FILE");
+
+   /*
+    * By default, the spelling of white space in unimportant (it can
+    *  only be significant with the -E option) and #line directives
+    *  are required in the output.
+    */
+   whsp_image = NoSpelling;
+   line_cntrl = 1;
+
+   /*
+    * opt_lst and opt_args are the options and corresponding arguments
+    *  that are passed along to the preprocessor initialization routine.
+    *  Their number is at most the number of arguments to rtt.
+    */
+   opt_lst = alloc(argc);
+   opt_args = alloc(argc * sizeof (char *));
+   nopts = 0;
+
+   /*
+    * Process options.
+    */
+   while ((c = getopt(argc, argv, ostr)) != EOF)
+      switch (c) {
+         case 'E': /* run preprocessor only */
+            pp_only = 1;
+            if (whsp_image == NoSpelling)
+               whsp_image = NoComment;
+            break;
+         case 'C':  /* retain spelling of white space, only effective with -E */
+            whsp_image = FullImage;
+            break;
+          case 'P': /* do not produce #line directives in output */
+            line_cntrl = 0;
+            break;
+          case 'd': /* -d name: name of data base */
+            dbname = optarg;
+            break;
+         case 'r':  /* -r path: location of include files */
+            refpath = optarg;
+            break;
+         case 't':  /* -t ident : treat ident as a typedef name */
+            add_tdef(optarg);
+            break;
+         case 'x':  /* produce code for interpreter rather than compiler */
+            iconx_flg = 1;
+            break;
+
+         case 'D':  /* define preprocessor symbol */
+         case 'I':  /* path to search for preprocessor includes */
+         case 'U':  /* undefine preprocessor symbol */
+            /*
+             * Save these options for the preprocessor initialization routine.
+             */
+            opt_lst[nopts] = c;
+            opt_args[nopts] = optarg;
+            ++nopts;
+            break;
+         default:
+            show_usage();
+         }
+
+   #ifdef Rttx
+      if (!iconx_flg) {
+         fprintf(stdout,
+            "rtt was compiled to only support the intepreter, use -x\n");
+         exit(EXIT_FAILURE);
+         }
+   #endif				/* Rttx */
+
+   if (iconx_flg)
+      compiler_def = "#define COMPILER 0\n";
+   else
+      compiler_def = "#define COMPILER 1\n";
+   in_header = alloc(strlen(refpath) + strlen(grttin_path) + 1);
+   strcpy(in_header, refpath);
+   strcat(in_header, grttin_path);
+   inclname = alloc(strlen(refpath) + strlen(rt_path) + 1);
+   strcpy(inclname, refpath);
+   strcat(inclname, rt_path);
+
+   opt_lst[nopts] = '\0';
+
+   /*
+    * At least one file name must be given on the command line.
+    */
+   if (optind == argc)
+     show_usage();
+
+   /*
+    * When creating the compiler run-time system, rtt outputs a list
+    *  of names of C files created, because most of the file names are
+    *  not derived from the names of the input files.
+    */
+   if (!iconx_flg) {
+      curlst = fopen(curlst_nm, "w");
+      if (curlst == NULL)
+         err2("cannot open ", curlst_nm);
+      }
+
+   /*
+    * Unless the input is only being preprocessed, set up the in-memory data
+    *  base (possibly loading it from a file).
+    */
+   if (!pp_only) {
+      fp = fparse(dbname);
+      if (*fp->ext == '\0')
+         dbname = salloc(makename(buf, SourceDir, dbname, DBSuffix));
+      else if (!smatch(fp->ext, DBSuffix))
+         err2("bad data base name:", dbname);
+      loaddb(dbname);
+      }
+
+   /*
+    * Scan file name arguments, and translate the files.
+    */
+   while (optind < argc)  {
+      trans(argv[optind]);
+      optind++;
+      }
+
+   #ifndef Rttx
+      /*
+       * Unless the user just requested the preprocessor be run, we
+       *   have created C files and updated the in-memory data base.
+       *   If this is the compiler's run-time system, we must dump
+       *   to data base to a file and create a list of all output files
+       *   produced in all runs of rtt that created the data base.
+       */
+      if (!(pp_only || iconx_flg)) {
+         if (fclose(curlst) != 0)
+            err2("cannot close ", curlst_nm);
+         dumpdb(dbname);
+         full_lst("rttfull.lst");
+         }
+   #endif				/* Rttx */
+
+   return EXIT_SUCCESS;
+   }
+
+/*
+ * trans - translate a source file.
+ */
+void trans(src_file)
+char *src_file;
+   {
+   char *cname;
+   char buf[MaxPath];		/* file name construction buffer */
+   char *buf_ptr;
+   char *s;
+   struct fileparts *fp;
+   struct tdefnm *td;
+   struct token *t;
+   static char *test_largeints = "#ifdef LargeInts\nyes\n#endif\n";
+   static int first_time = 1;
+
+   cur_src = src_file;
+
+   /*
+    * Read standard header file for preprocessor directives and
+    * typedefs, but don't write anything to output.
+    */
+   enable_out = 0;
+   init_preproc(in_header, opt_lst, opt_args);
+   str_src("<rtt initialization>", compiler_def, (int)strlen(compiler_def));
+   init_sym();
+   for (td = tdefnm_lst; td != NULL; td = td->next)
+      sym_add(TypeDefName, td->name, OtherDcl, 1);
+   init_lex();
+   yyparse();
+   if (first_time) {
+      first_time = 0;
+      /*
+       * Now that the standard include files have been processed, see if
+       *  Largeints is defined and make sure it matches what's in the data base.
+       */
+      s = "NoLargeInts";
+      str_src("<rtt initialization>", test_largeints,
+         (int)strlen(test_largeints));
+      while ((t = preproc()) != NULL)
+          if (strcmp(t->image, "yes"))
+             s = "LargeInts";
+      if (largeints == NULL)
+         largeints = s;
+      else if (strcmp(largeints, s) != 0)
+         err2("header file definition of LargeInts/NoLargeInts does not match ",
+            dbname);
+      }
+   enable_out = 1;
+
+   /*
+    * Make sure we have a .r file or standard input.
+    */
+   if (strcmp(cur_src, "-") == 0) {
+      source("-"); /* tell preprocessor to read standard input */
+      cname = salloc(makename(buf, TargetDir, "stdin", CSuffix));
+      }
+   else {
+      fp = fparse(cur_src);
+      if (*fp->ext == '\0')
+         cur_src = salloc(makename(buf, SourceDir, cur_src, RttSuffix));
+      else if (!smatch(fp->ext, RttSuffix))
+         err2("unknown file suffix ", cur_src);
+      cur_src = spec_str(cur_src);
+
+      /*
+       * For the compiler, remove from the data base the list of
+       *  files produced from this input file.
+       */
+      if (!iconx_flg)
+         clr_dpnd(cur_src);
+      source(cur_src);  /* tell preprocessor to read source file */
+
+      /*
+       * For the interpreter prepend "x" to the file name for the .c file.
+       */
+      buf_ptr = buf;
+      if (iconx_flg)
+         *buf_ptr++ = 'x';
+      makename(buf_ptr, TargetDir, cur_src, CSuffix);
+      cname = salloc(buf);
+      }
+
+   if (pp_only)
+      output(stdout); /* invoke standard preprocessor output routine */
+   else {
+      /*
+       * For the compiler, non-RTL code is put in a file whose name
+       *  is derived from input file name. The flag def_fnd indicates
+       *  if anything interesting is put in the file.
+       */
+      def_fnd = 0;
+      if ((out_file = fopen(cname, "w")) == NULL)
+         err2("cannot open output file ", cname);
+      else
+         addrmlst(cname, out_file);
+      prologue(); /* output standard comments and preprocessor directives */
+      yyparse();  /* translate the input */
+      fprintf(out_file, "\n");
+      if (fclose(out_file) != 0)
+         err2("cannot close ", cname);
+
+      /*
+       * For the Compiler, note the name of the "primary" output file
+       *  in the data base and list of created files.
+       */
+      if (!iconx_flg)
+         put_c_fl(cname, def_fnd);
+      }
+   }
+
+/*
+ * add_tdef - add identifier to list of typedef names.
+ */
+static void add_tdef(name)
+char *name;
+   {
+   struct tdefnm *td;
+
+   td = NewStruct(tdefnm);
+   td->name = spec_str(name);
+   td->next = tdefnm_lst;
+   tdefnm_lst = td;
+   }
+
+/*
+ * Add name of file to the output list, and if it contains "interesting"
+ *  code, add it to the dependency list in the data base.
+ */
+void put_c_fl(fname, keep)
+char *fname;
+int keep;
+   {
+   struct fileparts *fp;
+
+   fp = fparse(fname);
+   fprintf(curlst, "%s\n", fp->name);
+   if (keep)
+      add_dpnd(src_lkup(cur_src), fname);
+   }
+
+/*
+ * Print an error message if called incorrectly.
+ */
+void show_usage()
+   {
+   fprintf(stderr, "usage: %s %s\n", progname, options);
+   exit(EXIT_FAILURE);
+   }
+
+/*
+ * yyerror - error routine called by yacc.
+ */
+void yyerror(s)
+char *s;
+   {
+   struct token *t;
+
+   t = yylval.t;
+   if (t == NULL)
+      err2(s, " at end of file");
+   else
+      errt1(t, s);
+   }
diff --git a/src/rtt/rttmisc.c b/src/rtt/rttmisc.c
new file mode 100644
index 0000000..822970f
--- /dev/null
+++ b/src/rtt/rttmisc.c
@@ -0,0 +1,114 @@
+#include "rtt.h"
+
+int n_tmp_str  = 0;
+int n_tmp_cset = 0;
+struct sym_entry *params = NULL;
+
+/*
+ * clr_def - clear any information related to definitions.
+ */
+void clr_def()
+   {
+   struct sym_entry *sym;
+
+   n_tmp_str = 0;
+   n_tmp_cset = 0;
+   while (params != NULL) {
+      sym = params;
+      params = params->u.param_info.next;
+      free_sym(sym);
+      }
+   free_tend();
+   if (v_len != NULL)
+      free_sym(v_len);
+   v_len = NULL;
+   il_indx = 0;
+   lbl_num = 0;
+   abs_ret = SomeType;
+   }
+
+/*
+ * ttol - convert a token representing an integer constant into a long
+ *  integer value.
+ */
+long ttol(t)
+struct token *t;
+{
+   register long i;
+   register char *s;
+   int base;
+
+   s = t->image;
+   i = 0;
+   base = 10;
+
+   if (*s == '0') {
+      base = 8;
+      ++s;
+      if (*s == 'x') {
+         base = 16;
+         ++s;
+         }
+      }
+   while (*s != '\0') {
+      i *= base;
+      if (*s >= '0' && *s <= '9')
+         i += *s++ - '0';
+      else if (*s >= 'a' && *s <= 'f')
+         i += *s++ - 'a' + 10;
+      else if (*s >= 'A' && *s <= 'F')
+         i += *s++ - 'A' + 10;
+      }
+   return i;
+   }
+
+struct token *chk_exct(tok)
+struct token *tok;
+   {
+   struct sym_entry *sym;
+
+   sym = sym_lkup(tok->image);
+   if (sym->u.typ_indx != int_typ)
+      errt2(tok, "exact conversions do not apply  to ", tok->image);
+   return tok;
+   }
+
+/*
+ * icn_typ - convert a type node into a type code for the internal
+ *   representation of the data base.
+ */
+int icn_typ(typ)
+struct node *typ;
+   {
+   switch (typ->nd_id) {
+      case PrimryNd:
+         switch (typ->tok->tok_id) {
+            case Any_value:
+               return TypAny;
+            case Empty_type:
+               return TypEmpty;
+            case Variable:
+               return TypVar;
+            case C_Integer:
+               return TypCInt;
+            case C_Double:
+               return TypCDbl;
+            case C_String:
+               return TypCStr;
+            case Tmp_string:
+               return TypTStr;
+            case Tmp_cset:
+               return TypTCset;
+            }
+
+      case SymNd:
+         return typ->u[0].sym->u.typ_indx;
+
+      default:  /* must be exact conversion */
+         if (typ->tok->tok_id == C_Integer)
+            return TypECInt;
+         else     /* integer */
+            return TypEInt;
+      }
+   }
+
diff --git a/src/rtt/rttnode.c b/src/rtt/rttnode.c
new file mode 100644
index 0000000..6064b7e
--- /dev/null
+++ b/src/rtt/rttnode.c
@@ -0,0 +1,264 @@
+#include "rtt.h"
+
+/*
+ * node0 - create a syntax tree leaf node.
+ */
+struct node *node0(id, tok)
+int id;
+struct token *tok;
+   {
+   struct node *n;
+
+   n = NewNode(0);
+   n->nd_id = id;
+   n->tok = tok;
+   return n;
+   }
+
+/*
+ * node1 - create a syntax tree node with one child.
+ */
+struct node *node1(id, tok, n1)
+int id;
+struct token *tok;
+struct node *n1;
+   {
+   struct node *n;
+
+   n = NewNode(1);
+   n->nd_id = id;
+   n->tok = tok;
+   n->u[0].child = n1;
+   return n;
+   }
+
+/*
+ * node2 - create a syntax tree node with two children.
+ */
+struct node *node2(id, tok, n1, n2)
+int id;
+struct token *tok;
+struct node *n1;
+struct node *n2;
+   {
+   struct node *n;
+
+   n = NewNode(2);
+   n->nd_id = id;
+   n->tok = tok;
+   n->u[0].child = n1;
+   n->u[1].child = n2;
+   return n;
+   }
+
+/*
+ * node3 - create a syntax tree node with three children.
+ */
+struct node *node3(id, tok, n1, n2, n3)
+int id;
+struct token *tok;
+struct node *n1;
+struct node *n2;
+struct node *n3;
+   {
+   struct node *n;
+
+   n = NewNode(3);
+   n->nd_id = id;
+   n->tok = tok;
+   n->u[0].child = n1;
+   n->u[1].child = n2;
+   n->u[2].child = n3;
+   return n;
+   }
+
+/*
+ * node4 - create a syntax tree node with four children.
+ */
+struct node *node4(id, tok, n1, n2, n3, n4)
+int id;
+struct token *tok;
+struct node *n1;
+struct node *n2;
+struct node *n3;
+struct node *n4;
+   {
+   struct node *n;
+
+   n = NewNode(4);
+   n->nd_id = id;
+   n->tok = tok;
+   n->u[0].child = n1;
+   n->u[1].child = n2;
+   n->u[2].child = n3;
+   n->u[3].child = n4;
+   return n;
+   }
+
+/*
+ * sym_node - create a syntax tree node for a variable. If the identifier
+ *  is in the symbol table, create a node that references the entry,
+ *  otherwise create a simple leaf node.
+ */
+struct node *sym_node(tok)
+struct token *tok;
+   {
+   struct sym_entry *sym;
+   struct node *n;
+
+   sym = sym_lkup(tok->image);
+   if (sym != NULL) {
+      n = NewNode(1);
+      n->nd_id = SymNd;
+      n->tok = tok;
+      n->u[0].sym = sym;
+      ++sym->ref_cnt;
+      /*
+       * If this is the result location of an operation, note that it
+       *  is explicitly referenced.
+       */
+      if (sym->id_type == RsltLoc)
+         sym->u.referenced = 1;
+      return n;
+      }
+   else
+      return node0(PrimryNd, tok);
+   }
+
+/*
+ * comp_nd - create a node for a compound statement.
+ */
+struct node *comp_nd(tok, dcls, stmts)
+struct token *tok;
+struct node *dcls;
+struct node *stmts;
+   {
+   struct node *n;
+
+   n = NewNode(3);
+   n->nd_id = CompNd;
+   n->tok = tok;
+   n->u[0].child = dcls;
+   n->u[1].sym = dcl_stk->tended; /* tended declarations are not in dcls */
+   n->u[2].child = stmts;
+   return n;
+   }
+
+/*
+ * arith_nd - create a node for an arith_case statement.
+ */
+struct node *arith_nd(tok, p1, p2, c_int, ci_act, intgr, i_act, dbl, d_act)
+struct token *tok;
+struct node *p1;
+struct node *p2;
+struct node *c_int;
+struct node *ci_act;
+struct node *intgr;
+struct node *i_act;
+struct node *dbl;
+struct node *d_act;
+   {
+   struct node *n;
+
+   /*
+    * Insure the cases are what we expect.
+    */
+   if (c_int->tok->tok_id != C_Integer)
+      errt3(c_int->tok, "expected \"C_integer\", found \"", c_int->tok->image,
+         "\"");
+   if (intgr->tok->image != icontypes[int_typ].id)
+      errt3(intgr->tok, "expected \"integer\", found \"", intgr->tok->image,
+         "\"");
+   if (dbl->tok->tok_id != C_Double)
+      errt3(dbl->tok, "expected \"C_double\", found \"", dbl->tok->image,
+         "\"");
+
+   /*
+    * Indicate in the symbol table that the arguments are converted to C
+    *  values.
+    */
+   dst_alloc(c_int, p1);
+   dst_alloc(c_int, p2);
+   dst_alloc(dbl, p1);
+   dst_alloc(dbl, p2);
+
+   free_tree(c_int);
+   free_tree(intgr);
+   free_tree(dbl);
+
+   n = node3(TrnryNd, NULL, ci_act, i_act, d_act);
+   return node3(TrnryNd, tok, p1, p2, n);
+   }
+
+struct node *dest_node(tok)
+struct token *tok;
+   {
+   struct node *n;
+   int typcd;
+
+   n = sym_node(tok);
+   typcd = n->u[0].sym->u.typ_indx;
+   if (typcd != int_typ && typcd != str_typ && typcd != cset_typ &&
+      typcd != real_typ)
+      errt2(tok, "cannot convert to ", tok->image);
+   return n;
+   }
+
+
+/*
+ * free_tree - free storage for a syntax tree.
+ */
+void free_tree(n)
+struct node *n;
+   {
+   struct sym_entry *sym, *sym1;
+
+   if (n == NULL)
+      return;
+
+   /*
+    * Free any subtrees and other referenced storage.
+    */
+   switch (n->nd_id) {
+      case SymNd:
+         free_sym(n->u[0].sym); /* Indicate one less reference to symbol */
+         break;
+
+      case CompNd:
+         /*
+          * Compound node. Free ordinary declarations, tended declarations,
+          *  and executable code.
+          */
+         free_tree(n->u[0].child);
+         sym = n->u[1].sym;
+         while (sym != NULL) {
+            sym1 = sym;
+            sym = sym->u.tnd_var.next;
+            free_sym(sym1);
+            }
+         free_tree(n->u[2].child);
+         break;
+
+      case QuadNd:
+         free_tree(n->u[3].child);
+         /* fall thru to next case */
+      case TrnryNd:
+         free_tree(n->u[2].child);
+         /* fall thru to next case */
+      case AbstrNd: case BinryNd: case CommaNd: case ConCatNd: case LstNd:
+      case StrDclNd:
+         free_tree(n->u[1].child);
+         /* fall thru to next case */
+      case IcnTypNd: case PstfxNd: case PreSpcNd: case PrefxNd:
+         free_tree(n->u[0].child);
+         /* fall thru to next case */
+      case ExactCnv: case PrimryNd:
+         break;
+
+      default:
+         fprintf(stdout, "rtt internal error: unknown node type\n");
+         exit(EXIT_FAILURE);
+         }
+   free_t(n->tok);             /* free token */
+   free((char *)n);
+   }
diff --git a/src/rtt/rttout.c b/src/rtt/rttout.c
new file mode 100644
index 0000000..14c71b7
--- /dev/null
+++ b/src/rtt/rttout.c
@@ -0,0 +1,3821 @@
+#include "rtt.h"
+
+#define NotId 0  /* declarator is not simple identifier */
+#define IsId  1  /* declarator is simple identifier */
+
+#define OrdFunc -1   /* indicates ordinary C function - non-token value */
+
+/*
+ * VArgAlwnc - allowance for the variable part of an argument list in the
+ *  most general version of an operation. If it is too small, storage must
+ *  be malloced. 3 was chosen because over 90 percent of all writes have
+ *  3 or fewer arguments. It is possible that 4 would be a better number,
+ *  but 5 is probably overkill.
+ */
+#define VArgAlwnc 3
+
+/*
+ * Prototypes for static functions.
+ */
+static void cnv_fnc       (struct token *t, int typcd,
+                               struct node *src, struct node *dflt,
+                               struct node *dest, int indent);
+static void chk_conj      (struct node *n);
+static void chk_nl        (int indent);
+static void chk_rsltblk   (int indent);
+static void comp_def      (struct node *n);
+static int     does_call     (struct node *expr);
+static void failure       (int indent, int brace);
+static void interp_def    (struct node *n);
+static int     len_sel       (struct node *sel,
+                               struct parminfo *strt_prms,
+                               struct parminfo *end_prms, int indent);
+static void line_dir      (int nxt_line, char *new_fname);
+static int     only_proto    (struct node *n);
+static void parm_locs     (struct sym_entry *op_params);
+static void parm_tnd      (struct sym_entry *sym);
+static void prt_runerr    (struct token *t, struct node *num,
+                               struct node *val, int indent);
+static void prt_tok       (struct token *t, int indent);
+static void prt_var       (struct node *n, int indent);
+static int     real_def      (struct node *n);
+static int     retval_dcltor (struct node *dcltor, int indent);
+static void ret_value     (struct token *t, struct node *n,
+                               int indent);
+static void ret_1_arg     (struct token *t, struct node *args,
+                               int typcd, char *vwrd_asgn, char *arg_rep,
+                               int indent);
+static int     rt_walk       (struct node *n, int indent, int brace);
+static void spcl_start    (struct sym_entry *op_params);
+static int     tdef_or_extr  (struct node *n);
+static void tend_ary      (int n);
+static void tend_init     (void);
+static void tnd_var       (struct sym_entry *sym, char *strct_ptr, char *access, int indent);
+static void tok_line      (struct token *t, int indent);
+static void typ_asrt      (int typcd, struct node *desc,
+                               struct token *tok, int indent);
+static int     typ_case      (struct node *var, struct node *slct_lst,
+                               struct node *dflt,
+                               int (*walk)(struct node *n, int xindent,
+                                 int brace), int maybe_var, int indent);
+static void untend        (int indent);
+
+extern char *progname;
+
+int op_type = OrdFunc;  /* type of operation */
+char lc_letter;         /* f = function, o = operator, k = keyword */
+char uc_letter;         /* F = function, O = operator, K = keyword */
+char prfx1;             /* 1st char of unique prefix for operation */
+char prfx2;             /* 2nd char of unique prefix for operation */
+char *fname = "";       /* current source file name */
+int line = 0;           /* current source line number */
+int nxt_sbuf;           /* next string buffer index */
+int nxt_cbuf;           /* next cset buffer index */
+int abs_ret = SomeType; /* type from abstract return(s) */
+
+int nl = 0;             /* flag indicating the a new-line should be output */
+static int no_nl = 0;   /* flag to suppress line directives */
+
+static int ntend;       /* number of tended descriptor needed */
+static char *tendstrct; /* expression to access struct of tended descriptors */
+static char *rslt_loc;  /* expression to access result location */
+static int varargs = 0; /* flag: operation takes variable number of arguments */
+
+static int no_ret_val;  /* function has return statement with no value */
+static struct node *fnc_head; /* header of function being "copied" to output */
+
+/*
+ * chk_nl - if a new-line is required, output it and indent the next line.
+ */
+static void chk_nl(indent)
+int indent;
+   {
+   int col;
+
+   if (nl)  {
+      /*
+       * new-line required.
+       */
+      putc('\n', out_file);
+      ++line;
+      for (col = 0; col < indent; ++col)
+         putc(' ', out_file);
+      nl = 0;
+      }
+   }
+
+/*
+ * line_dir - Output a line directive.
+ */
+static void line_dir(nxt_line, new_fname)
+int nxt_line;
+char *new_fname;
+   {
+   char *s;
+
+   /*
+    * Make sure line directives are desired in the output. Normally,
+    *  blank lines surround the directive for readability. However,`
+    *  a preceding blank line is suppressed at the beginning of the
+    *  output file. In addition, a blank line is suppressed after
+    *  the directive if it would force the line number on the directive
+    *  to be 0.
+    */
+   if (line_cntrl) {
+      fprintf(out_file, "\n");
+      if (line != 0)
+         fprintf(out_file, "\n");
+      if (nxt_line == 1)
+         fprintf(out_file, "#line %d \"", nxt_line);
+      else
+         fprintf(out_file, "#line %d \"", nxt_line - 1);
+      for (s = new_fname; *s != '\0'; ++s) {
+         if (*s == '"' || *s == '\\')
+            putc('\\', out_file);
+         putc(*s, out_file);
+         }
+      if (nxt_line == 1)
+         fprintf(out_file, "\"");
+      else
+         fprintf(out_file, "\"\n");
+      nl = 1;
+      --nxt_line;
+      }
+    else if ((nxt_line > line || fname != new_fname) && line != 0) {
+      /*
+       * Line directives are disabled, but we are in a situation where
+       *  one or two new-lines are desirable.
+       */
+      if (nxt_line > line + 1 || fname != new_fname)
+         fprintf(out_file, "\n");
+      nl = 1;
+      --nxt_line;
+      }
+   line = nxt_line;
+   fname = new_fname;
+   }
+
+/*
+ * prt_str - print a string to the output file, possibly preceded by
+ *   a new-line and indenting.
+ */
+void prt_str(s, indent)
+char *s;
+int indent;
+   {
+   chk_nl(indent);
+   fprintf(out_file, "%s", s);
+   }
+
+/*
+ * tok_line - determine if a line directive is needed to synchronize the
+ *  output file name and line number with an input token.
+ */
+static void tok_line(t, indent)
+struct token *t;
+int indent;
+   {
+   int nxt_line;
+
+   /*
+    * Line directives may be suppressed at certain points during code
+    *  output. This is done either by rtt itself using the no_nl flag, or
+    *  for macros, by the preprocessor using a flag in the token.
+    */
+   if (no_nl)
+      return;
+   if (t->flag & LineChk) {
+      /*
+       * If blank lines can be used in place of a line directive and no
+       *  more than 3 are needed, use them. If the line number and file
+       *  name are correct, but we need a new-line, we must output a
+       *  line directive so the line number is reset after the "new-line".
+       */
+      nxt_line = t->line;
+      if (fname != t->fname  || line > nxt_line || line + 2 < nxt_line)
+         line_dir(nxt_line, t->fname);
+      else if (nl && line == nxt_line)
+         line_dir(nxt_line, t->fname);
+      else if (line != nxt_line) {
+         nl = 1;
+         --nxt_line;
+         while (line < nxt_line) { /* above condition limits # interactions */
+            putc('\n', out_file);
+            ++line;
+            }
+         }
+      }
+   chk_nl(indent);
+   }
+
+/*
+ * prt_tok - print a token.
+ */
+static void prt_tok(t, indent)
+struct token *t;
+int indent;
+   {
+   char *s;
+
+   tok_line(t, indent); /* synchronize file name and line number */
+
+   /*
+    * Most tokens contain a string of their exact image. However, string
+    *  and character literals lack the surrounding quotes.
+    */
+   s = t->image;
+   switch (t->tok_id) {
+      case StrLit:
+         fprintf(out_file, "\"%s\"", s);
+         break;
+      case LStrLit:
+         fprintf(out_file, "L\"%s\"", s);
+         break;
+      case CharConst:
+         fprintf(out_file, "'%s'", s);
+         break;
+      case LCharConst:
+         fprintf(out_file, "L'%s'", s);
+         break;
+      default:
+         fprintf(out_file, "%s", s);
+      }
+   }
+
+/*
+ * untend - output code to removed the tended descriptors in this
+ *  function from the global tended list.
+ */
+static void untend(indent)
+int indent;
+   {
+   ForceNl();
+   prt_str("tend = ", indent);
+   fprintf(out_file, "%s.previous;", tendstrct);
+   ForceNl();
+   /*
+    * For varargs operations, the tended structure might have been
+    *  malloced. If so, it must be freed.
+    */
+   if (varargs) {
+      prt_str("if (r_tendp != (struct tend_desc *)&r_tend)", indent);
+      ForceNl();
+      prt_str("free((pointer)r_tendp);", 2 * indent);
+      }
+   }
+
+/*
+ * tnd_var - output an expression to accessed a tended variable.
+ */
+static void tnd_var(sym, strct_ptr, access, indent)
+struct sym_entry *sym;
+char *strct_ptr;
+char *access;
+int indent;
+   {
+   /*
+    * A variable that is a specific block pointer type must be cast
+    *  to that pointer type in such a way that it can be used as either
+    *  an lvalue or an rvalue:  *(struct b_??? **)&???.vword.bptr
+    */
+   if (strct_ptr != NULL) {
+      prt_str("(*(struct ", indent);
+      prt_str(strct_ptr, indent);
+      prt_str("**)&", indent);
+      }
+
+   if (sym->id_type & ByRef) {
+      /*
+       * The tended variable is being accessed indirectly through
+       *  a pointer (that is, it is accessed as the argument to a body
+       *  function); dereference its identifier.
+       */
+      prt_str("(*", indent);
+      prt_str(sym->image, indent);
+      prt_str(")", indent);
+      }
+   else {
+      if (sym->t_indx >= 0) {
+         /*
+          * The variable is accessed directly as part of the tended structure.
+          */
+         prt_str(tendstrct, indent);
+         fprintf(out_file, ".d[%d]", sym->t_indx);
+         }
+      else {
+         /*
+          * This is a direct access to an operation parameter.
+          */
+         prt_str("r_args[", indent);
+         fprintf(out_file, "%d]", sym->u.param_info.param_num + 1);
+         }
+      }
+   prt_str(access, indent);  /* access the vword for tended pointers */
+   if (strct_ptr != NULL)
+      prt_str(")", indent);
+   }
+
+/*
+ * prt_var - print a variable.
+ */
+static void prt_var(n, indent)
+struct node *n;
+int indent;
+   {
+   struct token *t;
+   struct sym_entry *sym;
+
+   t = n->tok;
+   tok_line(t, indent); /* synchronize file name and line nuber */
+   sym = n->u[0].sym;
+   switch (sym->id_type & ~ByRef) {
+      case TndDesc:
+         /*
+          * Simple tended descriptor.
+          */
+         tnd_var(sym, NULL, "", indent);
+         break;
+      case TndStr:
+         /*
+          * Tended character pointer.
+          */
+         tnd_var(sym, NULL, ".vword.sptr", indent);
+         break;
+      case TndBlk:
+         /*
+          * Tended block pointer.
+          */
+         tnd_var(sym, sym->u.tnd_var.blk_name, ".vword.bptr",
+            indent);
+         break;
+      case RtParm:
+      case DrfPrm:
+         switch (sym->u.param_info.cur_loc) {
+            case PrmTend:
+               /*
+                * Simple tended parameter.
+                */
+               tnd_var(sym, NULL, "", indent);
+               break;
+            case PrmCStr:
+               /*
+                * Parameter converted to a (tended) string.
+                */
+               tnd_var(sym, NULL, ".vword.sptr", indent);
+               break;
+            case PrmInt:
+               /*
+                * Parameter converted to a C integer.
+                */
+               chk_nl(indent);
+               fprintf(out_file, "r_i%d", sym->u.param_info.param_num);
+               break;
+            case PrmDbl:
+               /*
+                * Parameter converted to a C double.
+                */
+               chk_nl(indent);
+               fprintf(out_file, "r_d%d", sym->u.param_info.param_num);
+               break;
+            default:
+               errt2(t, "Conflicting conversions for: ", t->image);
+            }
+         break;
+      case RtParm | VarPrm:
+      case DrfPrm | VarPrm:
+         /*
+          * Parameter representing variable part of argument list.
+          */
+         prt_str("(&", indent);
+         if (sym->t_indx >= 0)
+            fprintf(out_file, "%s.d[%d])", tendstrct, sym->t_indx);
+         else
+            fprintf(out_file, "r_args[%d])", sym->u.param_info.param_num + 1);
+         break;
+      case VArgLen:
+         /*
+          * Length of variable part of argument list.
+          */
+         prt_str("(r_nargs - ", indent);
+         fprintf(out_file, "%d)", params->u.param_info.param_num);
+         break;
+      case RsltLoc:
+         /*
+          * "result" the result location of the operation.
+          */
+         prt_str(rslt_loc, indent);
+         break;
+      case Label:
+         /*
+          * Statement label.
+          */
+         prt_str(sym->image, indent);
+         break;
+      case OtherDcl:
+         /*
+          * Some other type of variable: accessed by identifier. If this
+          *  is a body function, it may be passed by reference and need
+          *  a level of pointer dereferencing.
+          */
+         if (sym->id_type & ByRef)
+            prt_str("(*",indent);
+         prt_str(sym->image, indent);
+         if (sym->id_type & ByRef)
+            prt_str(")",indent);
+         break;
+      }
+   }
+
+/*
+ * does_call - determine if an expression contains a function call by
+ *  walking its syntax tree.
+ */
+static int does_call(expr)
+struct node *expr;
+   {
+   int n_subs;
+   int i;
+
+   if (expr == NULL)
+      return 0;
+   if (expr->nd_id == BinryNd && expr->tok->tok_id == ')')
+      return 1;      /* found a function call */
+
+   switch (expr->nd_id) {
+      case ExactCnv: case PrimryNd: case SymNd:
+         n_subs = 0;
+         break;
+      case CompNd:
+         /*
+          * Check field 0 below, field 1 is not a subtree, check field 2 here.
+          */
+         n_subs = 1;
+         if (does_call(expr->u[2].child))
+             return 1;
+         break;
+      case IcnTypNd: case PstfxNd: case PreSpcNd: case PrefxNd:
+         n_subs = 1;
+         break;
+      case AbstrNd: case BinryNd: case CommaNd: case ConCatNd: case LstNd:
+      case StrDclNd:
+         n_subs = 2;
+         break;
+      case TrnryNd:
+         n_subs = 3;
+         break;
+      case QuadNd:
+         n_subs = 4;
+         break;
+      default:
+         fprintf(stdout, "rtt internal error: unknown node type\n");
+         exit(EXIT_FAILURE);
+         }
+
+   for (i = 0; i < n_subs; ++i)
+      if (does_call(expr->u[i].child))
+          return 1;
+
+   return 0;
+   }
+
+/*
+ * prt_runerr - print code to implement runerr().
+ */
+static void prt_runerr(t, num, val, indent)
+struct token *t;
+struct node *num;
+struct node *val;
+int indent;
+   {
+   if (op_type == OrdFunc)
+      errt1(t, "'runerr' may not be used in an ordinary C function");
+
+   tok_line(t, indent);  /* synchronize file name and line number */
+   prt_str("{", indent);
+   ForceNl();
+   prt_str("err_msg(", indent);
+   c_walk(num, indent, 0);                /* error number */
+   if (val == NULL)
+      prt_str(", NULL);", indent);        /* no offending value */
+   else {
+      prt_str(", &(", indent);
+      c_walk(val, indent, 0);             /* offending value */
+      prt_str("));", indent);
+      }
+   /*
+    * Handle error conversion. Indicate that operation may fail because
+    *  of error conversion and produce the necessary code.
+    */
+   cur_impl->ret_flag |= DoesEFail;
+   failure(indent, 1);
+   prt_str("}", indent);
+   ForceNl();
+   }
+
+/*
+ * typ_name - convert a type code to a string that can be used to
+ *  output "T_" or "D_" type codes.
+ */
+char *typ_name(typcd, tok)
+int typcd;
+struct token *tok;
+   {
+   if (typcd == Empty_type)
+      errt1(tok, "it is meaningless to assert a type of empty_type");
+   else if (typcd == Any_value)
+      errt1(tok, "it is useless to assert a type of any_value");
+   else if (typcd < 0 || typcd == str_typ)
+      return NULL;
+   else
+      return icontypes[typcd].cap_id;
+   /*NOTREACHED*/
+   return 0;			/* avoid gcc warning */
+   }
+
+/*
+ * Produce a C conditional expression to check a descriptor for a
+ *  particular type.
+ */
+static void typ_asrt(typcd, desc, tok, indent)
+int typcd;
+struct node *desc;
+struct token *tok;
+int indent;
+   {
+   tok_line(tok, indent);
+
+   if (typcd == str_typ) {
+      /*
+       * Check dword for the absense of a "not qualifier" flag.
+       */
+      prt_str("(!((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword & F_Nqual))", indent);
+      }
+   else if (typcd == TypVar) {
+      /*
+       * Check dword for the presense of a "variable" flag.
+       */
+      prt_str("(((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword & D_Var) == D_Var)", indent);
+      }
+   else if (typcd == int_typ) {
+      /*
+       * If large integers are supported, an integer can be either
+       *  an ordinary integer or a large integer.
+       */
+      ForceNl();
+      prt_str("#ifdef LargeInts", 0);
+      ForceNl();
+      prt_str("(((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword == D_Integer) || ((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword == D_Lrgint))", indent);
+      ForceNl();
+      prt_str("#else\t\t\t\t\t/* LargeInts */", 0);
+      ForceNl();
+      prt_str("((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword == D_Integer)", indent);
+      ForceNl();
+      prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
+      ForceNl();
+      }
+   else {
+      /*
+       * Check dword for a specific type code.
+       */
+      prt_str("((", indent);
+      c_walk(desc, indent, 0);
+      prt_str(").dword == D_", indent);
+      prt_str(typ_name(typcd, tok), indent);
+      prt_str(")", indent);
+      }
+   }
+
+/*
+ * retval_dcltor - convert the "declarator" part of function declaration
+ *  into a declarator for the variable "r_retval" of the same type
+ *  as the function result type, outputing the new declarator. This
+ *  variable is a temporary location to store the result of the argument
+ *  to a C return statement.
+ */
+static int retval_dcltor(dcltor, indent)
+struct node *dcltor;
+int indent;
+   {
+   int flag;
+
+   switch (dcltor->nd_id) {
+      case ConCatNd:
+         c_walk(dcltor->u[0].child, indent, 0);
+         retval_dcltor(dcltor->u[1].child, indent);
+         return NotId;
+      case PrimryNd:
+         /*
+          * We have reached the function name. Replace it with "r_retval"
+          *  and tell caller we have found it.
+          */
+         prt_str("r_retval", indent);
+         return IsId;
+      case PrefxNd:
+         /*
+          * (...)
+          */
+         prt_str("(", indent);
+         flag = retval_dcltor(dcltor->u[0].child, indent);
+         prt_str(")", indent);
+         return flag;
+      case BinryNd:
+         if (dcltor->tok->tok_id == ')') {
+            /*
+             * Function declaration. If this is the declarator that actually
+             *  defines the function being processed, discard the paramater
+             *  list including parentheses.
+             */
+            if (retval_dcltor(dcltor->u[0].child, indent) == NotId) {
+               prt_str("(", indent);
+               c_walk(dcltor->u[1].child, indent, 0);
+               prt_str(")", indent);
+               }
+            }
+         else {
+            /*
+             * Array.
+             */
+            retval_dcltor(dcltor->u[0].child, indent);
+            prt_str("[", indent);
+            c_walk(dcltor->u[1].child, indent, 0);
+            prt_str("]", indent);
+            }
+         return NotId;
+      }
+   err1("rtt internal error detected in function retval_dcltor()");
+   /*NOTREACHED*/
+   return 0;			/* avoid gcc warning */
+   }
+
+/*
+ * cnv_fnc - produce code to handle RTT cnv: and def: constructs.
+ */
+static void cnv_fnc(t, typcd, src, dflt, dest, indent)
+struct token *t;
+int typcd;
+struct node *src;
+struct node *dflt;
+struct node *dest;
+int indent;
+   {
+   int dflt_to_ptr;
+   int loc;
+   int is_cstr;
+
+   if (src->nd_id == SymNd && src->u[0].sym->id_type & VarPrm)
+      errt1(t, "converting entire variable part of param list not supported");
+
+   tok_line(t, indent); /* synchronize file name and line number */
+
+   /*
+    * Initial assumptions: result of conversion is a tended location
+    *   and is not tended C string.
+    */
+   loc = PrmTend;
+   is_cstr = 0;
+
+  /*
+   * Print the name of the conversion function. If it is a conversion
+   *  with a default value, determine (through dflt_to_prt) if the
+   *  default value is passed by-reference instead of by-value.
+   */
+   prt_str(cnv_name(typcd, dflt, &dflt_to_ptr), indent);
+   prt_str("(", indent);
+
+   /*
+    * Determine what parameter scope, if any, is established by this
+    *  conversion. If the conversion needs a buffer, allocate it and
+    *  put it in the argument list.
+    */
+   switch (typcd) {
+      case TypCInt:
+      case TypECInt:
+         loc = PrmInt;
+         break;
+      case TypCDbl:
+         loc = PrmDbl;
+         break;
+      case TypCStr:
+         is_cstr = 1;
+         break;
+      case TypTStr:
+         fprintf(out_file, "r_sbuf[%d], ", nxt_sbuf++);
+         break;
+      case TypTCset:
+         fprintf(out_file, "&r_cbuf[%d], ", nxt_cbuf++);
+         break;
+      }
+
+   /*
+    * Output source of conversion.
+    */
+   prt_str("&(", indent);
+   c_walk(src, indent, 0);
+   prt_str("), ", indent);
+
+   /*
+    * If there is a default value, output it, taking its address if necessary.
+    */
+   if (dflt != NULL) {
+      if (dflt_to_ptr)
+         prt_str("&(", indent);
+      c_walk(dflt, indent, 0);
+      if (dflt_to_ptr)
+         prt_str("), ", indent);
+      else
+         prt_str(", ", indent);
+      }
+
+   /*
+    * Output the destination of the conversion. This may or may not be
+    *  the same as the source.
+    */
+   prt_str("&(", indent);
+   if (dest == NULL) {
+      /*
+       * Convert "in place", changing the location of a paramater if needed.
+       */
+      if (src->nd_id == SymNd && src->u[0].sym->id_type & (RtParm | DrfPrm)) {
+         if (src->u[0].sym->id_type & DrfPrm)
+            src->u[0].sym->u.param_info.cur_loc = loc;
+         else
+            errt1(t, "only dereferenced parameter can be converted in-place");
+         }
+      else if ((loc != PrmTend) | is_cstr)
+         errt1(t,
+            "only ordinary parameters can be converted in-place to C values");
+      c_walk(src, indent, 0);
+      if (is_cstr) {
+         /*
+          * The parameter must be accessed as a tended C string, but only
+          *  now, after the "destination" code has been produced as a full
+          *  descriptor.
+          */
+         src->u[0].sym->u.param_info.cur_loc = PrmCStr;
+         }
+      }
+   else {
+      /*
+       * Convert to an explicit destination.
+       */
+      if (is_cstr) {
+         /*
+          * Access the destination as a full descriptor even though it
+          *  must be declared as a tended C string.
+          */
+         if (dest->nd_id != SymNd || (dest->u[0].sym->id_type != TndStr &&
+               dest->u[0].sym->id_type != TndDesc))
+            errt1(t,
+             "dest. of C_string conv. must be tended descriptor or char *");
+         tnd_var(dest->u[0].sym, NULL, "", indent);
+         }
+      else
+         c_walk(dest, indent, 0);
+      }
+   prt_str("))", indent);
+   }
+
+/*
+ * cnv_name - produce name of conversion routine. Warning, name is
+ *   constructed in a static buffer. Also determine if a default
+ *   must be passed "by reference".
+ */
+char *cnv_name(typcd, dflt, dflt_to_ptr)
+int typcd;
+struct node *dflt;
+int *dflt_to_ptr;
+   {
+   static char buf[15];
+   int by_ref;
+
+   /*
+    * The names of simple conversion and defaulting conversions have
+    *  the same suffixes, but different prefixes.
+    */
+   if (dflt == NULL)
+      strcpy(buf , "cnv_");
+   else
+       strcpy(buf, "def_");
+
+   by_ref = 0;
+   switch (typcd) {
+      case TypCInt:
+         strcat(buf, "c_int");
+         break;
+      case TypCDbl:
+         strcat(buf, "c_dbl");
+         break;
+      case TypCStr:
+         strcat(buf, "c_str");
+         break;
+      case TypTStr:
+         strcat(buf, "tstr");
+         by_ref = 1;
+         break;
+      case TypTCset:
+         strcat(buf, "tcset");
+         by_ref = 1;
+         break;
+      case TypEInt:
+         strcat(buf, "eint");
+         break;
+      case TypECInt:
+         strcat(buf, "ec_int");
+         break;
+      default:
+         if (typcd == cset_typ) {
+            strcat(buf, "cset");
+            by_ref = 1;
+            }
+         else if (typcd == int_typ)
+            strcat(buf, "int");
+         else if (typcd == real_typ)
+            strcat(buf, "real");
+         else if (typcd == str_typ) {
+            strcat(buf, "str");
+            by_ref = 1;
+            }
+      }
+   if (dflt_to_ptr != NULL)
+      *dflt_to_ptr = by_ref;
+   return buf;
+   }
+
+/*
+ * ret_value - produce code to set the result location of an operation
+ *  using the expression on a return or suspend.
+ */
+static void ret_value(t, n, indent)
+struct token *t;
+struct node *n;
+int indent;
+   {
+   struct node *caller;
+   struct node *args;
+   int typcd;
+
+   if (n == NULL)
+      errt1(t, "there is no default return value for run-time operations");
+
+   if (n->nd_id == SymNd && n->u[0].sym->id_type == RsltLoc) {
+      /*
+       * return/suspend result;
+       *
+       *   result already where it needs to be.
+       */
+      return;
+      }
+
+   if (n->nd_id == PrefxNd && n->tok != NULL) {
+      switch (n->tok->tok_id) {
+         case C_Integer:
+            /*
+             * return/suspend C_integer <expr>;
+             */
+            prt_str(rslt_loc, indent);
+            prt_str(".vword.integr = ", indent);
+            c_walk(n->u[0].child, indent + IndentInc, 0);
+            prt_str(";", indent);
+            ForceNl();
+            prt_str(rslt_loc, indent);
+            prt_str(".dword = D_Integer;", indent);
+            chkabsret(t, int_typ);  /* compare return with abstract return */
+            return;
+         case C_Double:
+            /*
+             * return/suspend C_double <expr>;
+             */
+            prt_str(rslt_loc, indent);
+            prt_str(".vword.bptr = (union block *)alcreal(", indent);
+            c_walk(n->u[0].child, indent + IndentInc, 0);
+            prt_str(");", indent + IndentInc);
+            ForceNl();
+            prt_str(rslt_loc, indent);
+            prt_str(".dword = D_Real;", indent);
+            /*
+             * The allocation of the real block may fail.
+             */
+            chk_rsltblk(indent);
+            chkabsret(t, real_typ); /* compare return with abstract return */
+            return;
+         case C_String:
+            /*
+             * return/suspend C_string <expr>;
+             */
+            prt_str(rslt_loc, indent);
+            prt_str(".vword.sptr = ", indent);
+            c_walk(n->u[0].child, indent + IndentInc, 0);
+            prt_str(";", indent);
+            ForceNl();
+            prt_str(rslt_loc, indent);
+            prt_str(".dword = strlen(", indent);
+            prt_str(rslt_loc, indent);
+            prt_str(".vword.sptr);", indent);
+            chkabsret(t, str_typ); /* compare return with abstract return */
+            return;
+         }
+      }
+   else if (n->nd_id == BinryNd && n->tok->tok_id == ')') {
+      /*
+       * Return value is in form of function call, see if it is really
+       *  a descriptor constructor.
+       */
+      caller = n->u[0].child;
+      args = n->u[1].child;
+      if (caller->nd_id == SymNd) {
+         switch (caller->tok->tok_id) {
+            case IconType:
+               typcd = caller->u[0].sym->u.typ_indx;
+               switch (icontypes[typcd].rtl_ret) {
+                  case TRetBlkP:
+                     /*
+                      * return/suspend <type>(<block-pntr>);
+                      */
+                     ret_1_arg(t, args, typcd, ".vword.bptr = (union block *)",
+                        "(bp)", indent);
+                     break;
+                  case TRetDescP:
+                     /*
+                      * return/suspend <type>(<desc-pntr>);
+                      */
+                     ret_1_arg(t, args, typcd, ".vword.descptr = (dptr)",
+                        "(dp)", indent);
+                     break;
+                  case TRetCharP:
+                     /*
+                      * return/suspend <type>(<char-pntr>);
+                      */
+                     ret_1_arg(t, args, typcd, ".vword.sptr = (char *)",
+                        "(s)", indent);
+                     break;
+                  case TRetCInt:
+                     /*
+                      * return/suspend <type>(<integer>);
+                      */
+                     ret_1_arg(t, args, typcd, ".vword.integr = (word)",
+                        "(i)", indent);
+                     break;
+                  case TRetSpcl:
+                     if (typcd == str_typ) {
+                        /*
+                         * return/suspend string(<len>, <char-pntr>);
+                         */
+                        if (args == NULL || args->nd_id != CommaNd ||
+                           args->u[0].child->nd_id == CommaNd)
+                           errt1(t, "wrong no. of args for string(n, s)");
+                        prt_str(rslt_loc, indent);
+                        prt_str(".vword.sptr = ", indent);
+                        c_walk(args->u[1].child, indent + IndentInc, 0);
+                        prt_str(";", indent);
+                        ForceNl();
+                        prt_str(rslt_loc, indent);
+                        prt_str(".dword = ", indent);
+                        c_walk(args->u[0].child, indent + IndentInc, 0);
+                        prt_str(";", indent);
+                        }
+                     else if (typcd == stv_typ) {
+                        /*
+                         * return/suspend tvsubs(<desc-pntr>, <start>, <len>);
+                         */
+                        if (args == NULL || args->nd_id != CommaNd ||
+                           args->u[0].child->nd_id != CommaNd ||
+                           args->u[0].child->u[0].child->nd_id == CommaNd)
+                           errt1(t, "wrong no. of args for tvsubs(dp, i, j)");
+                        no_nl = 1;
+                        prt_str("SubStr(&", indent);
+                        prt_str(rslt_loc, indent);
+                        prt_str(", ", indent);
+                        c_walk(args->u[0].child->u[0].child, indent + IndentInc,
+                           0);
+                        prt_str(", ", indent + IndentInc);
+                        c_walk(args->u[1].child, indent + IndentInc, 0);
+                        prt_str(", ", indent + IndentInc);
+                        c_walk(args->u[0].child->u[1].child, indent + IndentInc,
+                          0);
+                        prt_str(");", indent + IndentInc);
+                        no_nl = 0;
+                        /*
+                         * The allocation of the substring trapped variable
+                         *   block may fail.
+                         */
+                        chk_rsltblk(indent);
+                        chkabsret(t, stv_typ); /* compare to abstract return */
+                        }
+                     break;
+                  }
+               chkabsret(t, typcd); /* compare return with abstract return */
+               return;
+            case Named_var:
+               /*
+                * return/suspend named_var(<desc-pntr>);
+                */
+               if (args == NULL || args->nd_id == CommaNd)
+                  errt1(t, "wrong no. of args for named_var(dp)");
+               prt_str(rslt_loc, indent);
+               prt_str(".vword.descptr = ", indent);
+               c_walk(args, indent + IndentInc, 0);
+               prt_str(";", indent);
+               ForceNl();
+               prt_str(rslt_loc, indent);
+               prt_str(".dword = D_Var;", indent);
+               chkabsret(t, TypVar); /* compare return with abstract return */
+               return;
+            case Struct_var:
+               /*
+                * return/suspend struct_var(<desc-pntr>, <block_pntr>);
+                */
+               if (args == NULL || args->nd_id != CommaNd ||
+                  args->u[0].child->nd_id == CommaNd)
+                  errt1(t, "wrong no. of args for struct_var(dp, bp)");
+               prt_str(rslt_loc, indent);
+               prt_str(".vword.descptr = (dptr)", indent);
+               c_walk(args->u[1].child, indent + IndentInc, 0);
+               prt_str(";", indent);
+               ForceNl();
+               prt_str(rslt_loc, indent);
+               prt_str(".dword = D_Var + ((word *)", indent);
+               c_walk(args->u[0].child, indent + IndentInc, 0);
+               prt_str(" - (word *)", indent+IndentInc);
+               prt_str(rslt_loc, indent);
+               prt_str(".vword.descptr);", indent+IndentInc);
+               ForceNl();
+               chkabsret(t, TypVar); /* compare return with abstract return */
+               return;
+            }
+         }
+      }
+
+   /*
+    * If it is not one of the special returns, it is just a return of
+    *  a descriptor.
+    */
+   prt_str(rslt_loc, indent);
+   prt_str(" = ", indent);
+   c_walk(n, indent + IndentInc, 0);
+   prt_str(";", indent);
+   chkabsret(t, SomeType); /* check for preceding abstract return */
+   }
+
+/*
+ * ret_1_arg - produce code for a special return/suspend with one argument.
+ */
+static void ret_1_arg(t, args, typcd, vwrd_asgn, arg_rep, indent)
+struct token *t;
+struct node *args;
+int typcd;
+char *vwrd_asgn;
+char *arg_rep;
+int indent;
+   {
+   if (args == NULL || args->nd_id == CommaNd)
+      errt3(t, "wrong no. of args for", icontypes[typcd].id, arg_rep);
+
+   /*
+    * Assignment to vword of result descriptor.
+    */
+   prt_str(rslt_loc, indent);
+   prt_str(vwrd_asgn, indent);
+   c_walk(args, indent + IndentInc, 0);
+   prt_str(";", indent);
+   ForceNl();
+
+   /*
+    * Assignment to dword of result descriptor.
+    */
+   prt_str(rslt_loc, indent);
+   prt_str(".dword = D_", indent);
+   prt_str(icontypes[typcd].cap_id, indent);
+   prt_str(";", indent);
+   }
+
+/*
+ * chk_rsltblk - the result value contains an allocated block, make sure
+ *    the allocation succeeded.
+ */
+static void chk_rsltblk(indent)
+int indent;
+   {
+   ForceNl();
+   prt_str("if (", indent);
+   prt_str(rslt_loc, indent);
+   prt_str(".vword.bptr == NULL) {", indent);
+   ForceNl();
+   prt_str("err_msg(307, NULL);", indent + IndentInc);
+   ForceNl();
+   /*
+    * Handle error conversion. Indicate that operation may fail because
+    *  of error conversion and produce the necessary code.
+    */
+   cur_impl->ret_flag |= DoesEFail;
+   failure(indent + IndentInc, 1);
+   prt_str("}", indent + IndentInc);
+   ForceNl();
+   }
+
+/*
+ * failure - produce code for fail or efail.
+ */
+static void failure(indent, brace)
+int indent;
+int brace;
+   {
+   /*
+    * If there are tended variables, they must be removed from the tended
+    *  list. The C function may or may not return an explicit signal.
+    */
+   ForceNl();
+   if (ntend != 0) {
+      if (!brace)
+         prt_str("{", indent);
+      untend(indent);
+      ForceNl();
+      if (fnc_ret == RetSig)
+         prt_str("return A_Resume;", indent);
+      else
+         prt_str("return;", indent);
+      if (!brace) {
+         ForceNl();
+         prt_str("}", indent);
+         }
+      }
+   else
+      if (fnc_ret == RetSig)
+         prt_str("return A_Resume;", indent);
+      else
+         prt_str("return;", indent);
+   ForceNl();
+   }
+
+/*
+ * c_walk - walk the syntax tree for extended C code and output the
+ *  corresponding ordinary C. Return and indication of whether execution
+ *  falls through the code.
+ */
+int c_walk(n, indent, brace)
+struct node *n;
+int indent;
+int brace;
+   {
+   struct token *t;
+   struct node *n1;
+   struct sym_entry *sym;
+   int fall_thru;
+   int save_break;
+   static int does_break = 0;
+   static int may_brnchto;  /* may reach end of code by branching into middle */
+
+   if (n == NULL)
+      return 1;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrimryNd:
+         switch (t->tok_id) {
+            case Fail:
+               if (op_type == OrdFunc)
+                  errt1(t, "'fail' may not be used in an ordinary C function");
+               cur_impl->ret_flag |= DoesFail;
+               failure(indent, brace);
+	       chkabsret(t, SomeType);  /* check preceding abstract return */
+	       return 0;
+	    case Errorfail:
+	       if (op_type == OrdFunc)
+		  errt1(t,
+		      "'errorfail' may not be used in an ordinary C function");
+	       cur_impl->ret_flag |= DoesEFail;
+	       failure(indent, brace);
+	       return 0;
+            case Break:
+	       prt_tok(t, indent);
+	       prt_str(";", indent);
+               does_break = 1;
+               return 0;
+	    default:
+               /*
+                * Other "primary" expressions are just their token image,
+                *  possibly followed by a semicolon.
+                */
+	       prt_tok(t, indent);
+	       if (t->tok_id == Continue)
+		  prt_str(";", indent);
+               return 1;
+	    }
+      case PrefxNd:
+	 switch (t->tok_id) {
+	    case Sizeof:
+	       prt_tok(t, indent);                /* sizeof */
+	       prt_str("(", indent);
+	       c_walk(n->u[0].child, indent, 0);
+	       prt_str(")", indent);
+	       return 1;
+	    case '{':
+               /*
+                * Initializer list.
+                */
+	       prt_tok(t, indent + IndentInc);     /* { */
+	       c_walk(n->u[0].child, indent + IndentInc, 0);
+	       prt_str("}", indent + IndentInc);
+	       return 1;
+	    case Default:
+	       prt_tok(t, indent - IndentInc);     /* default (un-indented) */
+	       prt_str(": ", indent - IndentInc);
+	       fall_thru = c_walk(n->u[0].child, indent, 0);
+               may_brnchto = 1;
+               return fall_thru;
+	    case Goto:
+	       prt_tok(t, indent);                 /* goto */
+	       prt_str(" ", indent);
+	       c_walk(n->u[0].child, indent, 0);
+	       prt_str(";", indent);
+	       return 0;
+	    case Return:
+	       if (n->u[0].child != NULL)
+		  no_ret_val = 0;  /* note that return statement has no value */
+
+	       if (op_type == OrdFunc || fnc_ret == RetInt ||
+		  fnc_ret == RetDbl) {
+		  /*
+		   * ordinary C return: ignore C_integer, C_double, and
+		   *  C_string qualifiers on return expression (the first
+		   *  two may legally occur when fnc_ret is RetInt or RetDbl).
+		   */
+		  n1 = n->u[0].child;
+		  if (n1 != NULL && n1->nd_id == PrefxNd && n1->tok != NULL) {
+		     switch (n1->tok->tok_id) {
+			case C_Integer:
+			case C_Double:
+			case C_String:
+			   n1 = n1->u[0].child;
+			}
+		     }
+		  if (ntend != 0) {
+                     /*
+                      * There are tended variables that must be removed from
+                      *  the tended list.
+                      */
+		     if (!brace)
+			prt_str("{", indent);
+		     if (does_call(n1)) {
+			/*
+			 * The return expression contains a function call;
+                         *  the variables must remain tended while it is
+                         *  computed, so compute it into a temporary variable
+                         *  named r_retval.Output a declaration for r_retval;
+                         *  its type must match the return type of the C
+                         *  function.
+                         */
+			ForceNl();
+			prt_str("register ", indent);
+			if (op_type == OrdFunc) {
+			   no_nl = 1;
+			   just_type(fnc_head->u[0].child, indent, 0);
+			   prt_str(" ", indent);
+			   retval_dcltor(fnc_head->u[1].child, indent);
+			   prt_str(";", indent);
+			   no_nl = 0;
+			   }
+			else if (fnc_ret == RetInt)
+			   prt_str("C_integer r_retval;", indent);
+			else    /* fnc_ret == RetDbl */
+			   prt_str("double r_retval;", indent);
+			ForceNl();
+
+                        /*
+                         * Output code to compute the return value, untend
+                         *  the variable, then return the value.
+                         */
+			prt_str("r_retval = ", indent);
+			c_walk(n1, indent + IndentInc, 0);
+			prt_str(";", indent);
+			untend(indent);
+			ForceNl();
+			prt_str("return r_retval;", indent);
+			}
+		     else {
+                        /*
+                         * It is safe to untend the variables and return
+                         *  the result value directly with a return
+                         *  statement.
+                         */
+			untend(indent);
+			ForceNl();
+			prt_tok(t, indent);    /* return */
+			prt_str(" ", indent);
+			c_walk(n1, indent, 0);
+			prt_str(";", indent);
+			}
+		     if (!brace) {
+			ForceNl();
+			prt_str("}", indent);
+			}
+		     ForceNl();
+		     }
+		  else {
+                     /*
+                      * There are no tended variable, just output the
+                      *  return expression.
+                      */
+		     prt_tok(t, indent);     /* return */
+		     prt_str(" ", indent);
+		     c_walk(n1, indent, 0);
+		     prt_str(";", indent);
+		     }
+
+                  /*
+                   * If this is a body function, check the return against
+                   *  preceding abstract returns.
+                   */
+		  if (fnc_ret == RetInt)
+		     chkabsret(n->tok, int_typ);
+                  else if (fnc_ret == RetDbl)
+                     chkabsret(n->tok, real_typ);
+                  }
+               else {
+                  /*
+                   * Return from Icon operation. Indicate that the operation
+                   *  returns, compute the value into the result location,
+                   *  untend variables if necessary, and return a signal
+                   *  if the function requires one.
+                   */
+                  cur_impl->ret_flag |= DoesRet;
+                  ForceNl();
+                  if (!brace) {
+                     prt_str("{", indent);
+                     ForceNl();
+                     }
+                  ret_value(t, n->u[0].child, indent);
+                  if (ntend != 0)
+                     untend(indent);
+                  ForceNl();
+                  if (fnc_ret == RetSig)
+                     prt_str("return A_Continue;", indent);
+                  else if (fnc_ret == RetNoVal)
+                     prt_str("return;", indent);
+                  ForceNl();
+                  if (!brace) {
+                     prt_str("}", indent);
+                     ForceNl();
+                     }
+                  }
+               return 0;
+            case Suspend:
+               if (op_type == OrdFunc)
+                  errt1(t, "'suspend' may not be used in an ordinary C function"
+                     );
+               cur_impl->ret_flag |= DoesSusp; /* note suspension */
+               ForceNl();
+               if (!brace) {
+                  prt_str("{", indent);
+                  ForceNl();
+                  }
+               prt_str("register int signal;", indent + IndentInc);
+               ForceNl();
+               ret_value(t, n->u[0].child, indent);
+               ForceNl();
+               /*
+                * The operator suspends by calling the success continuation
+                *  if there is one or just returns if there is none. For
+                *  the interpreter, interp() is the success continuation.
+                *  A non-A_Resume signal from the success continuation must
+                *  returned to the caller. If there are tended variables
+                *  they must be removed from the tended list before a signal
+                *  is returned.
+                */
+               if (iconx_flg) {
+                  #ifdef EventMon
+		  switch (op_type) {
+		     case TokFunction:
+		        prt_str(
+		        "if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {",
+		           indent);
+		        break;
+		     case Operator:
+		     case Keyword:
+		        prt_str(
+		        "if ((signal = interp(G_Osusp, r_args)) != A_Resume) {",
+		           indent);
+		        break;
+		     default:
+		        prt_str(
+		        "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
+			   indent);
+		     }
+                  #else			/* EventMon */
+		     prt_str(
+		        "if ((signal = interp(G_Csusp, r_args)) != A_Resume) {",
+		           indent);
+                  #endif		/* EventMon */
+		  }
+               else {
+                  prt_str("if (r_s_cont == (continuation)NULL) {", indent);
+                  if (ntend != 0)
+                     untend(indent + IndentInc);
+                  ForceNl();
+                  prt_str("return A_Continue;", indent + IndentInc);
+                  ForceNl();
+                  prt_str("}", indent + IndentInc);
+                  ForceNl();
+                  prt_str("else if ((signal = (*r_s_cont)()) != A_Resume) {",
+                     indent);
+                  }
+               ForceNl();
+               if (ntend != 0)
+                  untend(indent + IndentInc);
+               ForceNl();
+               prt_str("return signal;", indent + IndentInc);
+               ForceNl();
+               prt_str("}", indent + IndentInc);
+               if (!brace) {
+                  prt_str("}", indent);
+                  ForceNl();
+                  }
+               return 1;
+            case '(':
+               /*
+                * Parenthesized expression.
+                */
+               prt_tok(t, indent);     /* ( */
+               fall_thru = c_walk(n->u[0].child, indent, 0);
+               prt_str(")", indent);
+               return fall_thru;
+            default:
+               /*
+                * All other prefix expressions are printed as the token
+                *  image of the operation followed by the operand.
+                */
+               prt_tok(t, indent);
+               c_walk(n->u[0].child, indent, 0);
+               return 1;
+            }
+      case PstfxNd:
+         /*
+          * All postfix expressions are printed as the operand followed
+          *  by the token image of the operation.
+          */
+         fall_thru = c_walk(n->u[0].child, indent, 0);
+         prt_tok(t, indent);
+         return fall_thru;
+      case PreSpcNd:
+         /*
+          * This prefix expression (pointer indication in a declaration) needs
+          *  a space after it.
+          */
+         prt_tok(t, indent);
+         c_walk(n->u[0].child, indent, 0);
+         prt_str(" ", indent);
+         return 1;
+      case SymNd:
+         /*
+          * Identifier.
+          */
+         prt_var(n, indent);
+         return 1;
+      case BinryNd:
+         switch (t->tok_id) {
+            case '[':
+               /*
+                * subscripting expression or declaration: <expr> [ <expr> ]
+                */
+               n1 = n->u[0].child;
+               c_walk(n->u[0].child, indent, 0);
+               prt_str("[", indent);
+               c_walk(n->u[1].child, indent, 0);
+               prt_str("]", indent);
+               return 1;
+            case '(':
+               /*
+                * cast: ( <type> ) <expr>
+                */
+               prt_tok(t, indent);  /* ) */
+               c_walk(n->u[0].child, indent, 0);
+               prt_str(")", indent);
+               c_walk(n->u[1].child, indent, 0);
+               return 1;
+            case ')':
+               /*
+                * function call or declaration: <expr> ( <expr-list> )
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_str("(", indent);
+               c_walk(n->u[1].child, indent, 0);
+               prt_tok(t, indent);   /* ) */
+               return call_ret(n->u[0].child);
+            case Struct:
+            case Union:
+               /*
+                * struct/union <ident>
+                * struct/union <opt-ident> { <field-list> }
+                */
+               prt_tok(t, indent);   /* struct or union */
+               prt_str(" ", indent);
+               c_walk(n->u[0].child, indent, 0);
+               if (n->u[1].child != NULL) {
+                  /*
+                   * Field declaration list.
+                   */
+                  prt_str(" {", indent);
+                  c_walk(n->u[1].child, indent + IndentInc, 0);
+                  ForceNl();
+                  prt_str("}", indent);
+                  }
+               return 1;
+            case TokEnum:
+               /*
+                * enum <ident>
+                * enum <opt-ident> { <enum-list> }
+                */
+               prt_tok(t, indent);   /* enum */
+               prt_str(" ", indent);
+               c_walk(n->u[0].child, indent, 0);
+               if (n->u[1].child != NULL) {
+                  /*
+                   * enumerator list.
+                   */
+                  prt_str(" {", indent);
+                  c_walk(n->u[1].child, indent + IndentInc, 0);
+                  prt_str("}", indent);
+                  }
+               return 1;
+            case ';':
+               /*
+                * <type-specs> <declarator> ;
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_str(" ", indent);
+               c_walk(n->u[1].child, indent, 0);
+               prt_tok(t, indent);  /* ; */
+               return 1;
+            case ':':
+               /*
+                * <label> : <statement>
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_tok(t, indent);   /* : */
+               prt_str(" ", indent);
+               fall_thru = c_walk(n->u[1].child, indent, 0);
+               may_brnchto = 1;
+               return fall_thru;
+            case Case:
+               /*
+                * case <expr> : <statement>
+                */
+               prt_tok(t, indent - IndentInc);  /* case (un-indented) */
+               prt_str(" ", indent);
+               c_walk(n->u[0].child, indent - IndentInc, 0);
+               prt_str(": ", indent - IndentInc);
+               fall_thru = c_walk(n->u[1].child, indent, 0);
+               may_brnchto = 1;
+               return fall_thru;
+            case Switch:
+               /*
+                * switch ( <expr> ) <statement>
+                *
+                * <statement> is double indented so that case and default
+                * statements can be un-indented and come out indented 1
+                * with respect to the switch. Statements that are not
+                * "labeled" with case or default are indented one more
+                * than those that are labeled.
+                */
+               prt_tok(t, indent);  /* switch */
+               prt_str(" (", indent);
+               c_walk(n->u[0].child, indent, 0);
+               prt_str(")", indent);
+               prt_str(" ", indent);
+               save_break = does_break;
+               fall_thru = c_walk(n->u[1].child, indent + 2 * IndentInc, 0);
+               fall_thru |= does_break;
+               does_break = save_break;
+               return fall_thru;
+            case While: {
+               struct node *n0;
+               /*
+                * While ( <expr> ) <statement>
+                */
+               n0 = n->u[0].child;
+               prt_tok(t, indent);  /* while */
+               prt_str(" (", indent);
+               c_walk(n0, indent, 0);
+               prt_str(")", indent);
+               prt_str(" ", indent);
+               save_break = does_break;
+               c_walk(n->u[1].child, indent + IndentInc, 0);
+               /*
+                * check for an infinite loop, while (1) ... :
+                *  a condition consisting of an IntConst with image=="1"
+                *  and no breaks in the body.
+                */
+               if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
+                   !strcmp(n0->tok->image,"1") && !does_break)
+                  fall_thru = 0;
+               else
+                  fall_thru = 1;
+               does_break = save_break;
+               return fall_thru;
+               }
+            case Do:
+               /*
+                * do <statement> <while> ( <expr> )
+                */
+               prt_tok(t, indent);  /* do */
+               prt_str(" ", indent);
+               c_walk(n->u[0].child, indent + IndentInc, 0);
+               ForceNl();
+               prt_str("while (", indent);
+               save_break = does_break;
+               c_walk(n->u[1].child, indent, 0);
+               does_break = save_break;
+               prt_str(");", indent);
+               return 1;
+            case '.':
+            case Arrow:
+               /*
+                * Field access: <expr> . <expr>  and  <expr> -> <expr>
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_tok(t, indent);   /* . or -> */
+               c_walk(n->u[1].child, indent, 0);
+               return 1;
+            case Runerr:
+               /*
+                * runerr ( <error-number> )
+                * runerr ( <error-number> , <offending-value> )
+                */
+               prt_runerr(t, n->u[0].child, n->u[1].child, indent);
+               return 0;
+            case Is:
+               /*
+                * is : <type> ( <expr> )
+                */
+               typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
+                  n->u[0].child->tok, indent);
+               return 1;
+            default:
+               /*
+                * All other binary expressions are infix notation and
+                *  are printed with spaces around the operator.
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_str(" ", indent);
+               prt_tok(t, indent);
+               prt_str(" ", indent);
+               c_walk(n->u[1].child, indent, 0);
+               return 1;
+            }
+      case LstNd:
+         /*
+          * <declaration-part> <declaration-part>
+          *
+          * Need space between parts
+          */
+         c_walk(n->u[0].child, indent, 0);
+         prt_str(" ", indent);
+         c_walk(n->u[1].child, indent, 0);
+         return 1;
+      case ConCatNd:
+         /*
+          * <some-code> <some-code>
+          *
+          * Various lists of code parts that do not need space between them.
+          */
+         if (c_walk(n->u[0].child, indent, 0))
+            return c_walk(n->u[1].child, indent, 0);
+         else {
+            /*
+             * Cannot directly reach the second piece of code, see if
+             *  it is possible to branch into it.
+             */
+            may_brnchto = 0;
+            fall_thru = c_walk(n->u[1].child, indent, 0);
+            return may_brnchto & fall_thru;
+            }
+      case CommaNd:
+         /*
+          * <expr> , <expr>
+          */
+         c_walk(n->u[0].child, indent, 0);
+         prt_tok(t, indent);
+         prt_str(" ", indent);
+         return c_walk(n->u[1].child, indent, 0);
+      case StrDclNd:
+         /*
+          * Structure field declaration. Bit field declarations have
+          *  a semicolon and a field width.
+          */
+         c_walk(n->u[0].child, indent, 0);
+         if (n->u[1].child != NULL) {
+            prt_str(": ", indent);
+            c_walk(n->u[1].child, indent, 0);
+            }
+         return 1;
+      case CompNd:
+         /*
+          * Compound statement.
+          */
+         if (brace)
+            tok_line(t, indent); /* just synch. file name and line number */
+         else
+            prt_tok(t, indent);  /* { */
+         c_walk(n->u[0].child, indent, 0);
+         /*
+          * we are in an inner block. tended locations may need to
+          *  be set to values from declaration initializations.
+          */
+         for (sym = n->u[1].sym; sym!= NULL; sym = sym->u.tnd_var.next) {
+            if (sym->u.tnd_var.init != NULL) {
+               prt_str(tendstrct, IndentInc);
+               fprintf(out_file, ".d[%d]", sym->t_indx);
+               switch (sym->id_type) {
+                  case TndDesc:
+                     prt_str(" = ", IndentInc);
+                     break;
+                  case TndStr:
+                     prt_str(".vword.sptr = ", IndentInc);
+                     break;
+                  case TndBlk:
+                     prt_str(".vword.bptr = (union block *)",
+                        IndentInc);
+                     break;
+                  }
+               c_walk(sym->u.tnd_var.init, 2 * IndentInc, 0);
+               prt_str(";", 2 * IndentInc);
+               ForceNl();
+               }
+            }
+         /*
+          * If there are no declarations, suppress braces that
+          *  may be required for a one-statement body; we already
+          *  have a set.
+          */
+         if (n->u[0].child == NULL && n->u[1].sym == NULL)
+            fall_thru = c_walk(n->u[2].child, indent, 1);
+         else
+            fall_thru = c_walk(n->u[2].child, indent, 0);
+         if (!brace) {
+            ForceNl();
+            prt_str("}", indent);
+            }
+         return fall_thru;
+      case TrnryNd:
+         switch (t->tok_id) {
+            case '?':
+               /*
+                * <expr> ? <expr> : <expr>
+                */
+               c_walk(n->u[0].child, indent, 0);
+               prt_str(" ", indent);
+               prt_tok(t, indent);  /* ? */
+               prt_str(" ", indent);
+               c_walk(n->u[1].child, indent, 0);
+               prt_str(" : ", indent);
+               c_walk(n->u[2].child, indent, 0);
+               return 1;
+            case If:
+               /*
+                * if ( <expr> ) <statement>
+                * if ( <expr> ) <statement> else <statement>
+                */
+               prt_tok(t, indent);  /* if */
+               prt_str(" (", indent);
+               c_walk(n->u[0].child, indent + IndentInc, 0);
+               prt_str(") ", indent);
+               fall_thru = c_walk(n->u[1].child, indent + IndentInc, 0);
+               n1 = n->u[2].child;
+               if (n1 == NULL)
+                  fall_thru = 1;
+               else {
+                  /*
+                   * There is an else statement. Don't indent an
+                   *  "else if"
+                   */
+                  ForceNl();
+                  prt_str("else ", indent);
+                  if (n1->nd_id == TrnryNd && n1->tok->tok_id == If)
+                     fall_thru |= c_walk(n1, indent, 0);
+                  else
+                     fall_thru |= c_walk(n1, indent + IndentInc, 0);
+                  }
+               return fall_thru;
+            case Type_case:
+               /*
+                * type_case <expr> of { <section-list> }
+                * type_case <expr> of { <section-list> <default-clause> }
+                */
+               return typ_case(n->u[0].child, n->u[1].child, n->u[2].child,
+                  c_walk, 1, indent);
+            case Cnv:
+               /*
+                * cnv : <type> ( <source> , <destination> )
+                */
+               cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
+                  n->u[2].child,
+                  indent);
+               return 1;
+            }
+      case QuadNd:
+         switch (t->tok_id) {
+            case For:
+               /*
+                * for ( <expr> ; <expr> ; <expr> ) <statement>
+                */
+               prt_tok(t, indent);  /* for */
+               prt_str(" (", indent);
+               c_walk(n->u[0].child, indent, 0);
+               prt_str("; ", indent);
+               c_walk(n->u[1].child, indent, 0);
+               prt_str("; ", indent);
+               c_walk(n->u[2].child, indent, 0);
+               prt_str(") ", indent);
+               save_break = does_break;
+               c_walk(n->u[3].child, indent + IndentInc, 0);
+               if (n->u[1].child == NULL && !does_break)
+                  fall_thru = 0;
+               else
+                  fall_thru = 1;
+               does_break = save_break;
+               return fall_thru;
+            case Def:
+               /*
+                * def : <type> ( <source> , <default> , <destination> )
+                */
+               cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
+                  n->u[3].child, indent);
+               return 1;
+            }
+      }
+   /*NOTREACHED*/
+   return 0;			/* avoid gcc warning */
+   }
+
+/*
+ * call_ret - decide whether a function being called might return.
+ */
+int call_ret(n)
+struct node *n;
+   {
+   /*
+    * Assume functions return except for c_exit(), fatalerr(), and syserr().
+    */
+   if (n->tok != NULL &&
+      (strcmp("c_exit",   n->tok->image) == 0 ||
+       strcmp("fatalerr", n->tok->image) == 0 ||
+       strcmp("syserr",   n->tok->image) == 0))
+      return 0;
+   else
+      return 1;
+   }
+
+/*
+ * new_prmloc - allocate an array large enough to hold a flag for every
+ *  parameter of the current operation. This flag indicates where
+ *  the parameter is in terms of scopes created by conversions.
+ */
+struct parminfo *new_prmloc()
+   {
+   struct parminfo *parminfo;
+   int nparams;
+   int i;
+
+   if (params == NULL)
+      return NULL;
+   nparams = params->u.param_info.param_num + 1;
+   parminfo = alloc(nparams * sizeof(struct parminfo));
+   for (i = 0; i < nparams; ++i) {
+      parminfo[i].cur_loc = 0;
+      parminfo [i].parm_mod = 0;
+      }
+   return parminfo;
+   }
+
+/*
+ * ld_prmloc - load parameter location information that has been
+ *  saved in an arrary into the symbol table.
+ */
+void ld_prmloc(parminfo)
+struct parminfo *parminfo;
+   {
+   struct sym_entry *sym;
+   int param_num;
+
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
+      param_num = sym->u.param_info.param_num;
+      if (sym->id_type & DrfPrm) {
+         sym->u.param_info.cur_loc = parminfo[param_num].cur_loc;
+         sym->u.param_info.parm_mod = parminfo[param_num].parm_mod;
+         }
+      }
+   }
+
+/*
+ * sv_prmloc - save parameter location information from the the symbol table
+ *  into an array.
+ */
+void sv_prmloc(parminfo)
+struct parminfo *parminfo;
+   {
+   struct sym_entry *sym;
+   int param_num;
+
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
+      param_num = sym->u.param_info.param_num;
+      if (sym->id_type & DrfPrm) {
+         parminfo[param_num].cur_loc = sym->u.param_info.cur_loc;
+         parminfo[param_num].parm_mod = sym->u.param_info.parm_mod;
+         }
+      }
+   }
+
+/*
+ * mrg_prmloc - merge parameter location information in the symbol table
+ *  with other information already saved in an array. This may result
+ *  in conflicting location information, but conflicts are only detected
+ *  when a parameter is actually used.
+ */
+void mrg_prmloc(parminfo)
+struct parminfo *parminfo;
+   {
+   struct sym_entry *sym;
+   int param_num;
+
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
+      param_num = sym->u.param_info.param_num;
+      if (sym->id_type & DrfPrm) {
+         parminfo[param_num].cur_loc |= sym->u.param_info.cur_loc;
+         parminfo[param_num].parm_mod |= sym->u.param_info.parm_mod;
+         }
+      }
+   }
+
+/*
+ * clr_prmloc - indicate that this execution path contributes nothing
+ *   to the location of parameters.
+ */
+void clr_prmloc()
+   {
+   struct sym_entry *sym;
+
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next) {
+      if (sym->id_type & DrfPrm) {
+         sym->u.param_info.cur_loc = 0;
+         sym->u.param_info.parm_mod = 0;
+         }
+      }
+   }
+
+/*
+ * typ_case - translate a type_case statement into C. This is called
+ *  while walking a syntax tree of either RTL code or C code; the parameter
+ *  "walk" is a function used to process the subtrees within the type_case
+ *  statement.
+ */
+static int typ_case(var, slct_lst, dflt, walk, maybe_var, indent)
+struct node *var;
+struct node *slct_lst;
+struct node *dflt;
+int (*walk)(struct node *n, int xindent, int brace);
+int maybe_var;
+int indent;
+   {
+   struct node *lst;
+   struct node *select;
+   struct node *slctor;
+   struct parminfo *strt_prms;
+   struct parminfo *end_prms;
+   int remaining;
+   int first;
+   int fnd_slctrs;
+   int maybe_str = 1;
+   int dflt_lbl;
+   int typcd;
+   int fall_thru;
+   char *s;
+
+   /*
+    * This statement involves multiple paths that may establish new
+    *  scopes for parameters. Remember the starting scope information
+    *  and initialize an array in which to compute the final information.
+    */
+   strt_prms = new_prmloc();
+   sv_prmloc(strt_prms);
+   end_prms = new_prmloc();
+
+   /*
+    * First look for cases that must be checked with "if" statements.
+    *  These include string qualifiers and variables.
+    */
+   remaining = 0;      /* number of cases skipped in first pass */
+   first = 1;          /* next case to be output is the first */
+   if (dflt == NULL)
+      fall_thru = 1;
+   else
+      fall_thru = 0;
+   for (lst = slct_lst; lst != NULL; lst = lst->u[0].child) {
+      select = lst->u[1].child;
+      fnd_slctrs = 0; /* flag: found type selections for clause for this pass */
+      /*
+       * A selection clause may include several types.
+       */
+      for (slctor = select->u[0].child; slctor != NULL; slctor =
+        slctor->u[0].child) {
+         typcd = icn_typ(slctor->u[1].child);
+         if(typ_name(typcd, slctor->u[1].child->tok) == NULL) {
+            /*
+             * This type must be checked with the "if". Is this the
+             *  first condition checked for this clause? Is this the
+             *  first clause output?
+             */
+            if (fnd_slctrs)
+               prt_str(" || ", indent);
+            else {
+               if (first)
+                  first = 0;
+               else {
+                  ForceNl();
+                  prt_str("else ", indent);
+                  }
+               prt_str("if (", indent);
+               fnd_slctrs = 1;
+               }
+
+            /*
+             * Output type check
+             */
+            typ_asrt(typcd, var, slctor->u[1].child->tok, indent + IndentInc);
+
+            if (typcd == str_typ)
+               maybe_str = 0;  /* string has been taken care of */
+            else if (typcd == Variable)
+               maybe_var = 0;  /* variable has been taken care of */
+            }
+         else
+            ++remaining;
+         }
+      if (fnd_slctrs) {
+         /*
+          * We have found and output type selections for this clause;
+          *  output the body of the clause. Remember any changes to
+          *  paramter locations caused by type conversions within the
+          *  clause.
+          */
+         prt_str(") {", indent + IndentInc);
+         ForceNl();
+         if ((*walk)(select->u[1].child, indent + IndentInc, 1)) {
+            fall_thru |= 1;
+            mrg_prmloc(end_prms);
+            }
+         prt_str("}", indent + IndentInc);
+         ForceNl();
+         ld_prmloc(strt_prms);
+         }
+      }
+   /*
+    * The rest of the cases can be checked with a "switch" statement, look
+    *  for them..
+    */
+   if (remaining == 0) {
+      if (dflt != NULL) {
+         /*
+          * There are no cases to handle with a switch statement, but there
+          *  is a default clause; handle it with an "else".
+          */
+         prt_str("else {", indent);
+         ForceNl();
+         fall_thru |= (*walk)(dflt, indent + IndentInc, 1);
+         ForceNl();
+         prt_str("}", indent + IndentInc);
+         ForceNl();
+         }
+      }
+   else {
+      /*
+       * If an "if" statement was output, the "switch" must be in its "else"
+       *   clause.
+       */
+      if (!first)
+         prt_str("else ", indent);
+
+      /*
+       * A switch statement cannot handle types that are not simple type
+       *  codes. If these have not taken care of, output code to check them.
+       *  This will either branch around the switch statement or into
+       *  its default clause.
+       */
+      if (maybe_str || maybe_var) {
+         dflt_lbl = lbl_num++;      /* allocate a label number */
+         prt_str("{", indent);
+         ForceNl();
+         prt_str("if (((", indent);
+         c_walk(var, indent + IndentInc, 0);
+         prt_str(").dword & D_Typecode) != D_Typecode) ", indent);
+         ForceNl();
+         prt_str("goto L", indent + IndentInc);
+         fprintf(out_file, "%d;  /* default */ ", dflt_lbl);
+         ForceNl();
+         }
+
+      no_nl = 1; /* suppress #line directives */
+      prt_str("switch (Type(", indent);
+      c_walk(var, indent + IndentInc, 0);
+      prt_str(")) {", indent + IndentInc);
+      no_nl = 0;
+      ForceNl();
+
+      /*
+       * Loop through the case clauses producing code for them.
+       */
+      for (lst = slct_lst; lst != NULL; lst = lst->u[0].child) {
+         select = lst->u[1].child;
+         fnd_slctrs = 0;
+         /*
+          * A selection clause may include several types.
+          */
+         for (slctor = select->u[0].child; slctor != NULL; slctor =
+           slctor->u[0].child) {
+            typcd = icn_typ(slctor->u[1].child);
+            s = typ_name(typcd, slctor->u[1].child->tok);
+            if (s != NULL) {
+               /*
+                * A type selection has been found that can be checked
+                *  in the switch statement. Note that large integers
+                *  require special handling.
+                */
+               fnd_slctrs = 1;
+
+	       if (typcd == int_typ) {
+		 ForceNl();
+		 prt_str("#ifdef LargeInts", 0);
+		 ForceNl();
+		 prt_str("case T_Lrgint:  ", indent + IndentInc);
+		 ForceNl();
+		 prt_str("#endif /* LargeInts */", 0);
+		 ForceNl();
+	       }
+
+               prt_str("case T_", indent + IndentInc);
+               prt_str(s, indent + IndentInc);
+               prt_str(": ", indent + IndentInc);
+               }
+            }
+         if (fnd_slctrs) {
+            /*
+             * We have found and output type selections for this clause;
+             *  output the body of the clause. Remember any changes to
+             *  paramter locations caused by type conversions within the
+             *  clause.
+             */
+            ForceNl();
+            if ((*walk)(select->u[1].child, indent + 2 * IndentInc, 0)) {
+               fall_thru |= 1;
+               ForceNl();
+               prt_str("break;", indent + 2 * IndentInc);
+               mrg_prmloc(end_prms);
+               }
+            ForceNl();
+            ld_prmloc(strt_prms);
+            }
+         }
+      if (dflt != NULL) {
+         /*
+          * This type_case statement has a default clause. If there is
+          *  a branch into this clause, output the label. Remember any
+          *  changes to paramter locations caused by type conversions
+          *  within the clause.
+          */
+         ForceNl();
+         prt_str("default:", indent + 1 * IndentInc);
+         ForceNl();
+         if (maybe_str || maybe_var) {
+            prt_str("L", 0);
+            fprintf(out_file, "%d: ;  /* default */", dflt_lbl);
+            ForceNl();
+            }
+         if ((*walk)(dflt, indent + 2 * IndentInc, 0)) {
+            fall_thru |= 1;
+            mrg_prmloc(end_prms);
+            }
+         ForceNl();
+         ld_prmloc(strt_prms);
+         }
+      prt_str("}", indent + IndentInc);
+
+      if (maybe_str || maybe_var) {
+         if (dflt == NULL) {
+            /*
+             * There is a branch around the switch statement. Output
+             *  the label.
+             */
+            ForceNl();
+            prt_str("L", 0);
+            fprintf(out_file, "%d: ;  /* default */", dflt_lbl);
+            }
+         ForceNl();
+         prt_str("}", indent + IndentInc);
+         }
+      ForceNl();
+      }
+
+   /*
+    * Put ending parameter locations into effect.
+    */
+   mrg_prmloc(end_prms);
+   ld_prmloc(end_prms);
+   if (strt_prms != NULL)
+      free(strt_prms);
+   if (end_prms != NULL)
+      free(end_prms);
+   return fall_thru;
+   }
+
+/*
+ * chk_conj - see if the left argument of a conjunction is an in-place
+ *   conversion of a parameter other than a conversion to C_integer or
+ *   C_double. If so issue a warning.
+ */
+static void chk_conj(n)
+struct node *n;
+   {
+   struct node *cnv_type;
+   struct node *src;
+   struct node *dest;
+   int typcd;
+
+   if (n->nd_id == BinryNd && n->tok->tok_id == And)
+      n = n->u[1].child;
+
+   switch (n->nd_id) {
+      case TrnryNd:
+         /*
+          * Must be Cnv.
+          */
+         cnv_type = n->u[0].child;
+         src = n->u[1].child;
+         dest = n->u[2].child;
+         break;
+      case QuadNd:
+         /*
+          * Must be Def.
+          */
+         cnv_type = n->u[0].child;
+         src = n->u[1].child;
+         dest = n->u[3].child;
+         break;
+      default:
+         return;   /* not a  conversion */
+      }
+
+   /*
+    * A conversion has been found. See if it meets the criteria for
+    *  issuing a warning.
+    */
+
+   if (src->nd_id != SymNd || !(src->u[0].sym->id_type & DrfPrm))
+      return;  /* not a dereferenced parameter */
+
+   typcd = icn_typ(cnv_type);
+   switch (typcd) {
+      case TypCInt:
+      case TypCDbl:
+      case TypECInt:
+         return;
+      }
+
+   if (dest != NULL)
+      return;   /* not an in-place convertion */
+
+   fprintf(stderr,
+    "%s: file %s, line %d, warning: in-place conversion may or may not be\n",
+      progname, cnv_type->tok->fname, cnv_type->tok->line);
+   fprintf(stderr, "\tundone on subsequent failure.\n");
+   }
+
+/*
+ * len_sel - translate a clause form a len_case statement into a C case
+ *  clause. Return an indication of whether execution falls through the
+ *  clause.
+ */
+static int len_sel(sel, strt_prms, end_prms, indent)
+struct node *sel;
+struct parminfo *strt_prms;
+struct parminfo *end_prms;
+int indent;
+   {
+   int fall_thru;
+
+   prt_str("case ", indent);
+   prt_tok(sel->tok, indent + IndentInc);           /* integer selection */
+   prt_str(":", indent + IndentInc);
+   fall_thru = rt_walk(sel->u[0].child, indent + IndentInc, 0);/* clause body */
+   ForceNl();
+
+   if (fall_thru) {
+      prt_str("break;", indent + IndentInc);
+      ForceNl();
+      /*
+       * Remember any changes to paramter locations caused by type conversions
+       *  within the clause.
+       */
+      mrg_prmloc(end_prms);
+      }
+
+   ld_prmloc(strt_prms);
+   return fall_thru;
+   }
+
+/*
+ * rt_walk - walk the part of the syntax tree containing rtt code, producing
+ *   code for the most-general version of the routine.
+ */
+static int rt_walk(n, indent, brace)
+struct node *n;
+int indent;
+int brace;
+   {
+   struct token *t, *t1;
+   struct node *n1, *errnum;
+   int fall_thru;
+
+   if (n == NULL)
+      return 1;
+
+   t =  n->tok;
+
+   switch (n->nd_id) {
+      case PrefxNd:
+         switch (t->tok_id) {
+            case '{':
+               /*
+                * RTL code: { <actions> }
+                */
+               if (brace)
+                  tok_line(t, indent); /* just synch file name and line num */
+               else
+                  prt_tok(t, indent);  /* { */
+               fall_thru = rt_walk(n->u[0].child, indent, 1);
+               if (!brace)
+                  prt_str("}", indent);
+               return fall_thru;
+            case '!':
+               /*
+                * RTL type-checking and conversions: ! <simple-type-check>
+                */
+               prt_tok(t, indent);
+               rt_walk(n->u[0].child, indent, 0);
+               return 1;
+            case Body:
+            case Inline:
+               /*
+                * RTL code: body { <c-code> }
+                *           inline { <c-code> }
+                */
+               fall_thru = c_walk(n->u[0].child, indent, brace);
+               if (!fall_thru)
+                  clr_prmloc();
+               return fall_thru;
+            }
+         break;
+      case BinryNd:
+         switch (t->tok_id) {
+            case Runerr:
+               /*
+                * RTL code: runerr( <message-number> )
+                *           runerr( <message-number>, <descriptor> )
+                */
+               prt_runerr(t, n->u[0].child, n->u[1].child, indent);
+
+               /*
+                * Execution cannot continue on this execution path.
+                */
+               clr_prmloc();
+               return 0;
+            case And:
+               /*
+                * RTL type-checking and conversions:
+                *   <type-check> && <type_check>
+                */
+               chk_conj(n->u[0].child);  /* is a warning needed? */
+               rt_walk(n->u[0].child, indent, 0);
+               prt_str(" ", indent);
+               prt_tok(t, indent);       /* && */
+               prt_str(" ", indent);
+               rt_walk(n->u[1].child, indent, 0);
+               return 1;
+            case Is:
+               /*
+                * RTL type-checking and conversions:
+                *   is: <icon-type> ( <variable> )
+                */
+               typ_asrt(icn_typ(n->u[0].child), n->u[1].child,
+                  n->u[0].child->tok, indent);
+               return 1;
+            }
+         break;
+      case ConCatNd:
+         /*
+          * "Glue" for two constructs.
+          */
+         fall_thru = rt_walk(n->u[0].child, indent, 0);
+         return fall_thru & rt_walk(n->u[1].child, indent, 0);
+      case AbstrNd:
+         /*
+          * Ignore abstract type computations while producing C code
+          *  for library routines.
+          */
+         return 1;
+      case TrnryNd:
+         switch (t->tok_id) {
+            case If: {
+               /*
+                * RTL code for "if" statements:
+                *  if <type-check> then <action>
+                *  if <type-check> then <action> else <action>
+                *
+                *  <type-check> may include parameter conversions that create
+                *  new scoping. It is necessary to keep track of paramter
+                *  types and locations along success and failure paths of
+                *  these conversions. The "then" and "else" actions may
+                *  also establish new scopes.
+                */
+               struct parminfo *then_prms = NULL;
+               struct parminfo *else_prms;
+
+               /*
+                * Save the current parameter locations. These are in
+                *  effect on the failure path of any type conversions
+                *  in the condition of the "if".
+                */
+               else_prms = new_prmloc();
+               sv_prmloc(else_prms);
+
+               prt_tok(t, indent);       /* if */
+               prt_str(" (", indent);
+               n1 = n->u[0].child;
+               rt_walk(n1, indent + IndentInc, 0);   /* type check */
+               prt_str(") {", indent);
+
+               /*
+                * If the condition is negated, the failure path is to the "then"
+                *  and the success path is to the "else".
+                */
+               if (n1->nd_id == PrefxNd && n1->tok->tok_id == '!') {
+                  then_prms = else_prms;
+                  else_prms = new_prmloc();
+                  sv_prmloc(else_prms);
+                  ld_prmloc(then_prms);
+                  }
+
+               /*
+                * Then Clause.
+                */
+               fall_thru = rt_walk(n->u[1].child, indent + IndentInc, 1);
+               ForceNl();
+               prt_str("}", indent + IndentInc);
+
+               /*
+                * Determine if there is an else clause and merge parameter
+                *  location information from the alternate paths through
+                *  the statement.
+                */
+               n1 = n->u[2].child;
+               if (n1 == NULL) {
+                  if (fall_thru)
+                     mrg_prmloc(else_prms);
+                  ld_prmloc(else_prms);
+                  fall_thru = 1;
+                  }
+               else {
+                  if (then_prms == NULL)
+                     then_prms = new_prmloc();
+                  if (fall_thru)
+                     sv_prmloc(then_prms);
+                  ld_prmloc(else_prms);
+                  ForceNl();
+                  prt_str("else {", indent);
+                  if (rt_walk(n1, indent + IndentInc, 1)) {  /* else clause */
+                     fall_thru = 1;
+                     mrg_prmloc(then_prms);
+                     }
+                  ForceNl();
+                  prt_str("}", indent + IndentInc);
+                  ld_prmloc(then_prms);
+                  }
+               ForceNl();
+               if (then_prms != NULL)
+                  free(then_prms);
+               if (else_prms != NULL)
+                  free(else_prms);
+               }
+               return fall_thru;
+            case Len_case: {
+               /*
+                * RTL code:
+                *   len_case <variable> of {
+                *      <integer>: <action>
+                *        ...
+                *      default: <action>
+                *      }
+                */
+               struct parminfo *strt_prms;
+               struct parminfo *end_prms;
+
+               /*
+                * A case may contain parameter conversions that create new
+                *  scopes. Remember the parameter locations at the start
+                *  of the len_case statement.
+                */
+               strt_prms = new_prmloc();
+               sv_prmloc(strt_prms);
+               end_prms = new_prmloc();
+
+               n1 = n->u[0].child;
+               if (!(n1->u[0].sym->id_type & VArgLen))
+	          errt1(t, "len_case must select on length of vararg");
+               /*
+                * The len_case statement is implemented as a C switch
+                *  statement.
+                */
+               prt_str("switch (", indent);
+               prt_var(n1, indent);
+               prt_str(") {", indent);
+               ForceNl();
+               fall_thru = 0;
+               for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
+                  n1 = n1->u[0].child)
+                     fall_thru |= len_sel(n1->u[1].child, strt_prms, end_prms,
+                        indent + IndentInc);
+               fall_thru |= len_sel(n1, strt_prms, end_prms,
+                  indent + IndentInc);
+
+               /*
+                * Handle default clause.
+                */
+               prt_str("default:", indent + IndentInc);
+               ForceNl();
+               fall_thru |= rt_walk(n->u[2].child, indent + 2 * IndentInc, 0);
+               ForceNl();
+               prt_str("}", indent + IndentInc);
+               ForceNl();
+
+               /*
+                * Put into effect the location of parameters at the end
+                *  of the len_case statement.
+                */
+               mrg_prmloc(end_prms);
+               ld_prmloc(end_prms);
+               if (strt_prms != NULL)
+                  free(strt_prms);
+               if (end_prms != NULL)
+                  free(end_prms);
+               }
+               return fall_thru;
+            case Type_case: {
+               /*
+                * RTL code:
+                *   type_case <variable> of {
+                *       <icon_type> : ... <icon_type> : <action>
+                *          ...
+                *       }
+                *
+                *   last clause may be: default: <action>
+                */
+               int maybe_var;
+               struct node *var;
+               struct sym_entry *sym;
+
+               /*
+                * If we can determine that the value being checked is
+                *  not a variable reference, we don't have to produce code
+                *  to check for that possibility.
+                */
+               maybe_var = 1;
+               var = n->u[0].child;
+               if (var->nd_id == SymNd) {
+                  sym = var->u[0].sym;
+                  switch(sym->id_type) {
+                     case DrfPrm:
+                     case OtherDcl:
+                     case TndDesc:
+                     case TndStr:
+                     case RsltLoc:
+                        if (sym->nest_lvl > 1) {
+                           /*
+                            * The thing being tested is either a
+                            *  dereferenced parameter or a local
+                            *  descriptor which could only have been
+                            *  set by a conversion which does not
+                            *  produce a variable reference.
+                            */
+                           maybe_var = 0;
+                           }
+                      }
+                  }
+               return typ_case(var, n->u[1].child, n->u[2].child, rt_walk,
+                  maybe_var, indent);
+               }
+            case Cnv:
+               /*
+                * RTL code: cnv: <type> ( <source> )
+                *           cnv: <type> ( <source> , <destination> )
+                */
+               cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, NULL,
+                  n->u[2].child, indent);
+               return 1;
+            case Arith_case: {
+               /*
+                * arith_case (<variable>, <variable>) of {
+                *   C_integer: <statement>
+                *   integer: <statement>
+                *   C_double: <statement>
+                *   }
+                *
+                * This construct does type conversions and provides
+                *  alternate execution paths. It is necessary to keep
+                *  track of parameter locations.
+                */
+               struct parminfo *strt_prms;
+               struct parminfo *end_prms;
+               struct parminfo *tmp_prms;
+
+               strt_prms = new_prmloc();
+               sv_prmloc(strt_prms);
+               end_prms = new_prmloc();
+               tmp_prms = new_prmloc();
+
+               fall_thru = 0;
+
+               n1 = n->u[2].child;   /* contains actions for the 3 cases */
+
+               /*
+                * Set up an error number node for use in runerr().
+                */
+               t1 = copy_t(t);
+               t1->tok_id = IntConst;
+               t1->image = "102";
+               errnum = node0(PrimryNd, t1);
+
+               /*
+                * Try converting both arguments to a C_integer.
+                */
+               tok_line(t, indent);
+               prt_str("if (", indent);
+               cnv_fnc(t, TypECInt, n->u[0].child, NULL, NULL, indent);
+               prt_str(" && ", indent);
+               cnv_fnc(t, TypECInt, n->u[1].child, NULL, NULL, indent);
+               prt_str(") ", indent);
+               ForceNl();
+               if (rt_walk(n1->u[0].child, indent + IndentInc, 0)) {
+                  fall_thru |= 1;
+                  mrg_prmloc(end_prms);
+                  }
+               ForceNl();
+
+               /*
+                * Try converting both arguments to an integer.
+                */
+               prt_str("#ifdef LargeInts", 0);
+               ForceNl();
+               ld_prmloc(strt_prms);
+               tok_line(t, indent);
+               prt_str("else if (", indent);
+               cnv_fnc(t, TypEInt, n->u[0].child, NULL, NULL, indent);
+               prt_str(" && ", indent);
+               cnv_fnc(t, TypEInt, n->u[1].child, NULL, NULL, indent);
+               prt_str(") ", indent);
+               ForceNl();
+               if (rt_walk(n1->u[1].child, indent + IndentInc, 0)) {
+                  fall_thru |= 1;
+                  mrg_prmloc(end_prms);
+                  }
+               ForceNl();
+               prt_str("#endif\t\t\t\t\t/* LargeInts */", 0);
+               ForceNl();
+
+               /*
+                * Try converting both arguments to a C_double
+                */
+               ld_prmloc(strt_prms);
+               prt_str("else {", indent);
+               ForceNl();
+               tok_line(t, indent + IndentInc);
+               prt_str("if (!", indent + IndentInc);
+               cnv_fnc(t, TypCDbl, n->u[0].child, NULL, NULL,
+                  indent + IndentInc);
+               prt_str(")", indent + IndentInc);
+               ForceNl();
+               sv_prmloc(tmp_prms);   /* use original parm locs for error */
+               ld_prmloc(strt_prms);
+               prt_runerr(t, errnum, n->u[0].child, indent + 2 * IndentInc);
+               ld_prmloc(tmp_prms);
+               tok_line(t, indent + IndentInc);
+               prt_str("if (!", indent + IndentInc);
+               cnv_fnc(t, TypCDbl, n->u[1].child, NULL, NULL,
+                  indent + IndentInc);
+               prt_str(") ", indent + IndentInc);
+               ForceNl();
+               sv_prmloc(tmp_prms);   /* use original parm locs for error */
+               ld_prmloc(strt_prms);
+               prt_runerr(t, errnum, n->u[1].child, indent + 2 * IndentInc);
+               ld_prmloc(tmp_prms);
+               if (rt_walk(n1->u[2].child, indent + IndentInc, 0)) {
+                  fall_thru |= 1;
+                  mrg_prmloc(end_prms);
+                  }
+               ForceNl();
+               prt_str("}", indent + IndentInc);
+               ForceNl();
+
+               ld_prmloc(end_prms);
+               free(strt_prms);
+               free(end_prms);
+               free(tmp_prms);
+               free_tree(errnum);
+               return fall_thru;
+               }
+            }
+      case QuadNd:
+         /*
+          * RTL code: def: <type> ( <source> , <default>)
+          *           def: <type> ( <source> , <default> , <destination> )
+          */
+         cnv_fnc(t, icn_typ(n->u[0].child), n->u[1].child, n->u[2].child,
+            n->u[3].child, indent);
+         return 1;
+      }
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ * spcl_dcls - print special declarations for tended variables, parameter
+ *  conversions, and buffers.
+ */
+void spcl_dcls(op_params)
+struct sym_entry *op_params; /* operation parameters or NULL */
+   {
+   register struct sym_entry *sym;
+   struct sym_entry *sym1;
+
+   /*
+    * Output declarations for buffers and locations to hold conversions
+    *  to C values.
+    */
+   spcl_start(op_params);
+
+   /*
+    * Determine if this operation takes a variable number of arguments.
+    *  Use that information in deciding how large a tended array to
+    *  declare.
+    */
+   varargs = (op_params != NULL && op_params->id_type & VarPrm);
+   if (varargs)
+      tend_ary(ntend + VArgAlwnc - 1);
+   else
+      tend_ary(ntend);
+
+   if (varargs) {
+      /*
+       * This operation takes a variable number of arguments. A declaration
+       *  for a tended array has been made that will usually hold them, but
+       *  sometimes it is necessary to malloc() a tended array at run
+       *  time. Produce code to check for this.
+       */
+      cur_impl->ret_flag |= DoesEFail;  /* error conversion from allocation */
+      prt_str("struct tend_desc *r_tendp;", IndentInc);
+      ForceNl();
+      prt_str("int r_n;\n", IndentInc);
+      ++line;
+      ForceNl();
+      prt_str("if (r_nargs <= ", IndentInc);
+      fprintf(out_file, "%d)", op_params->u.param_info.param_num + VArgAlwnc);
+      ForceNl();
+      prt_str("r_tendp = (struct tend_desc *)&r_tend;", 2 * IndentInc);
+      ForceNl();
+      prt_str("else {", IndentInc);
+      ForceNl();
+      prt_str(
+       "r_tendp = (struct tend_desc *)malloc((sizeof(struct tend_desc)",
+         2 * IndentInc);
+      ForceNl();
+      prt_str("", 3 * IndentInc);
+      fprintf(out_file, "+ (r_nargs + %d) * sizeof(struct descrip)));",
+         ntend - 2 - op_params->u.param_info.param_num);
+      ForceNl();
+      prt_str("if (r_tendp == NULL) {", 2 * IndentInc);
+      ForceNl();
+      prt_str("err_msg(305, NULL);", 3 * IndentInc);
+      ForceNl();
+      prt_str("return A_Resume;", 3 * IndentInc);
+      ForceNl();
+      prt_str("}", 3 * IndentInc);
+      ForceNl();
+      prt_str("}", 2 * IndentInc);
+      ForceNl();
+      tendstrct = "(*r_tendp)";
+      }
+   else
+      tendstrct = "r_tend";
+
+   /*
+    * Produce code to initialize the tended array. These are for tended
+    *  declarations and parameters.
+    */
+   tend_init();  /* initializations for tended declarations. */
+   if (varargs) {
+      /*
+       * This operation takes a variable number of arguments. Produce code
+       *  to dereference or copy this into its portion of the tended
+       *  array.
+       */
+      prt_str("for (r_n = ", IndentInc);
+      fprintf(out_file, "%d; r_n < r_nargs; ++r_n)",
+          op_params->u.param_info.param_num);
+      ForceNl();
+      if (op_params->id_type & DrfPrm) {
+         prt_str("deref(&r_args[r_n], &", IndentInc * 2);
+         fprintf(out_file, "%s.d[r_n + %d]);", tendstrct, ntend - 1 -
+            op_params->u.param_info.param_num);
+         }
+      else {
+         prt_str(tendstrct, IndentInc * 2);
+         fprintf(out_file, ".d[r_n + %d] = r_args[r_n];", ntend - 1 -
+            op_params->u.param_info.param_num);
+         }
+      ForceNl();
+      sym = op_params->u.param_info.next;
+      }
+   else
+      sym = op_params; /* no variable part of arg list */
+
+   /*
+    * Go through the fixed part of the parameter list, producing code
+    *  to copy/dereference parameters into the tended array.
+    */
+   while (sym != NULL) {
+      /*
+       * A there may be identifiers for dereferenced and/or undereferenced
+       *  versions of a paramater. If there are both, sym1 references the
+       *  second identifier.
+       */
+      sym1 = sym->u.param_info.next;
+      if (sym1 != NULL && sym->u.param_info.param_num !=
+         sym1->u.param_info.param_num)
+            sym1 = NULL;    /* the next entry is not for the same parameter */
+
+      /*
+       * If there are not enough arguments to supply a value for this
+       *  parameter, set it to the null value.
+       */
+      prt_str("if (", IndentInc);
+      fprintf(out_file, "r_nargs > %d) {", sym->u.param_info.param_num);
+      ForceNl();
+      parm_tnd(sym);
+      if (sym1 != NULL) {
+         ForceNl();
+         parm_tnd(sym1);
+         }
+      ForceNl();
+      prt_str("} else {", IndentInc);
+      ForceNl();
+      prt_str(tendstrct, IndentInc * 2);
+      fprintf(out_file, ".d[%d].dword = D_Null;", sym->t_indx);
+      if (sym1 != NULL) {
+         ForceNl();
+         prt_str(tendstrct, IndentInc * 2);
+         fprintf(out_file, ".d[%d].dword = D_Null;", sym1->t_indx);
+         }
+      ForceNl();
+      prt_str("}", 2 * IndentInc);
+      ForceNl();
+      if (sym1 == NULL)
+         sym = sym->u.param_info.next;
+      else
+         sym = sym1->u.param_info.next;
+      }
+
+   /*
+    * Finish setting up the tended array structure and link it into the tended
+    *  list.
+    */
+   if (ntend != 0) {
+      prt_str(tendstrct, IndentInc);
+      if (varargs)
+         fprintf(out_file, ".num = %d + Max(r_nargs - %d, 0);", ntend - 1,
+            op_params->u.param_info.param_num);
+      else
+         fprintf(out_file, ".num = %d;", ntend);
+      ForceNl();
+      prt_str(tendstrct, IndentInc);
+      prt_str(".previous = tend;", IndentInc);
+      ForceNl();
+      prt_str("tend = (struct tend_desc *)&", IndentInc);
+      fprintf(out_file, "%s;", tendstrct);
+      ForceNl();
+      }
+   }
+
+/*
+ * spcl_start - do initial work for outputing special declarations. Output
+ *  declarations for buffers and locations to hold conversions to C values.
+ *  Determine what tended locations are needed for parameters.
+ */
+static void spcl_start(op_params)
+struct sym_entry *op_params;
+   {
+   ForceNl();
+   if (n_tmp_str > 0) {
+      prt_str("char r_sbuf[", IndentInc);
+      fprintf(out_file, "%d][MaxCvtLen];", n_tmp_str);
+      ForceNl();
+      }
+   if (n_tmp_cset > 0) {
+      prt_str("struct b_cset r_cbuf[", IndentInc);
+      fprintf(out_file, "%d];", n_tmp_cset);
+      ForceNl();
+      }
+   if (tend_lst == NULL)
+      ntend = 0;
+   else
+      ntend = tend_lst->t_indx + 1;
+   parm_locs(op_params); /* see what parameter conversion there are */
+   }
+
+/*
+ * tend_ary - write struct containing array of tended descriptors.
+ */
+static void tend_ary(n)
+int n;
+   {
+   if (n == 0)
+      return;
+   prt_str("struct {", IndentInc);
+   ForceNl();
+   prt_str("struct tend_desc *previous;", 2 * IndentInc);
+   ForceNl();
+   prt_str("int num;", 2 * IndentInc);
+   ForceNl();
+   prt_str("struct descrip d[", 2 * IndentInc);
+   fprintf(out_file, "%d];", n);
+   ForceNl();
+   prt_str("} r_tend;\n", 2 * IndentInc);
+   ++line;
+   ForceNl();
+   }
+
+/*
+ * tend_init - produce code to initialize entries in the tended array
+ *  corresponding to tended declarations. Default initializations are
+ *  supplied when there is none in the declaration.
+ */
+static void tend_init()
+   {
+   register struct init_tend *tnd;
+
+   for (tnd = tend_lst; tnd != NULL; tnd = tnd->next) {
+      switch (tnd->init_typ) {
+         case TndDesc:
+            /*
+             * Simple tended declaration.
+             */
+            prt_str(tendstrct, IndentInc);
+            if (tnd->init == NULL)
+               fprintf(out_file, ".d[%d].dword = D_Null;", tnd->t_indx);
+            else {
+               fprintf(out_file, ".d[%d] = ", tnd->t_indx);
+               c_walk(tnd->init, 2 * IndentInc, 0);
+               prt_str(";", 2 * IndentInc);
+               }
+            break;
+         case TndStr:
+            /*
+             * Tended character pointer.
+             */
+            prt_str(tendstrct, IndentInc);
+            if (tnd->init == NULL)
+               fprintf(out_file, ".d[%d] = emptystr;", tnd->t_indx);
+            else {
+               fprintf(out_file, ".d[%d].dword = 0;", tnd->t_indx);
+               ForceNl();
+               prt_str(tendstrct, IndentInc);
+               fprintf(out_file, ".d[%d].vword.sptr = ", tnd->t_indx);
+               c_walk(tnd->init, 2 * IndentInc, 0);
+               prt_str(";", 2 * IndentInc);
+               }
+            break;
+         case TndBlk:
+            /*
+             * A tended block pointer of some kind.
+             */
+            prt_str(tendstrct, IndentInc);
+            if (tnd->init == NULL)
+               fprintf(out_file, ".d[%d] = nullptr;", tnd->t_indx);
+            else {
+               fprintf(out_file, ".d[%d].dword = F_Ptr | F_Nqual;",tnd->t_indx);
+               ForceNl();
+               prt_str(tendstrct, IndentInc);
+               fprintf(out_file, ".d[%d].vword.bptr = (union block *)",
+                   tnd->t_indx);
+               c_walk(tnd->init, 2 * IndentInc, 0);
+               prt_str(";", 2 * IndentInc);
+               }
+            break;
+         }
+      ForceNl();
+      }
+   }
+
+/*
+ * parm_tnd - produce code to put a parameter in its tended location.
+ */
+static void parm_tnd(sym)
+struct sym_entry *sym;
+   {
+   /*
+    * A parameter may either be dereferenced into its tended location
+    *  or copied.
+    */
+   if (sym->id_type & DrfPrm) {
+      prt_str("deref(&r_args[", IndentInc * 2);
+      fprintf(out_file, "%d], &%s.d[%d]);", sym->u.param_info.param_num,
+         tendstrct, sym->t_indx);
+      }
+   else {
+      prt_str(tendstrct, IndentInc * 2);
+      fprintf(out_file, ".d[%d] = r_args[%d];", sym->t_indx,
+         sym->u.param_info.param_num);
+      }
+   }
+
+/*
+ * parm_locs - determine what locations are needed to hold parameters and
+ *  their conversions. Produce declarations for the C_integer and C_double
+ *  locations.
+ */
+static void parm_locs(op_params)
+struct sym_entry *op_params;
+   {
+   struct sym_entry *next_parm;
+
+   /*
+    * Parameters are stored in reverse order: Recurse down the list
+    *  and perform processing on the way back.
+    */
+   if (op_params == NULL)
+      return;
+   next_parm = op_params->u.param_info.next;
+   parm_locs(next_parm);
+
+   /*
+    * For interpreter routines, extra tended descriptors are only needed
+    *  when both dereferenced and undereferenced values are requested.
+    */
+   if (iconx_flg && (next_parm == NULL ||
+      op_params->u.param_info.param_num != next_parm->u.param_info.param_num))
+      op_params->t_indx = -1;
+   else
+      op_params->t_indx = ntend++;
+   if (op_params->u.param_info.non_tend & PrmInt) {
+      prt_str("C_integer r_i", IndentInc);
+      fprintf(out_file, "%d;", op_params->u.param_info.param_num);
+      ForceNl();
+      }
+   if (op_params->u.param_info.non_tend & PrmDbl) {
+      prt_str("double r_d", IndentInc);
+      fprintf(out_file, "%d;", op_params->u.param_info.param_num);
+      ForceNl();
+      }
+   }
+
+/*
+ * real_def - see if a declaration really defines storage.
+ */
+static int real_def(n)
+struct node *n;
+   {
+   struct node *dcl_lst;
+
+   dcl_lst = n->u[1].child;
+   /*
+    * If no variables are being defined this must be a tag declaration.
+    */
+   if (dcl_lst == NULL)
+      return 0;
+
+   if (only_proto(dcl_lst))
+      return 0;
+
+   if (tdef_or_extr(n->u[0].child))
+      return 0;
+
+   return 1;
+   }
+
+/*
+ * only_proto - see if this declarator list contains only function prototypes.
+ */
+static int only_proto(n)
+struct node *n;
+   {
+   switch (n->nd_id) {
+      case CommaNd:
+         return only_proto(n->u[0].child) & only_proto(n->u[1].child);
+      case ConCatNd:
+         /*
+          * Optional pointer.
+          */
+         return only_proto(n->u[1].child);
+      case BinryNd:
+         switch (n->tok->tok_id) {
+            case '=':
+               return only_proto(n->u[0].child);
+            case '[':
+               /*
+                * At this point, assume array declarator is not part of
+                *  prototype.
+                */
+               return 0;
+            case ')':
+               /*
+                * Prototype (or forward declaration).
+                */
+               return 1;
+            }
+      case PrefxNd:
+         /*
+          * Parenthesized.
+          */
+         return only_proto(n->u[0].child);
+      case PrimryNd:
+         /*
+          * At this point, assume it is not a prototype.
+          */
+         return 0;
+      }
+   err1("rtt internal error detected in function only_proto()");
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ * tdef_or_extr - see if this is a typedef or extern.
+ */
+static int tdef_or_extr(n)
+struct node *n;
+   {
+   switch (n->nd_id) {
+      case LstNd:
+         return tdef_or_extr(n->u[0].child) | tdef_or_extr(n->u[1].child);
+      case BinryNd:
+         /*
+          * struct, union, or enum.
+          */
+         return 0;
+      case PrimryNd:
+         if (n->tok->tok_id == Extern || n->tok->tok_id == Typedef)
+            return 1;
+         else
+            return 0;
+      }
+   err1("rtt internal error detected in function tdef_or_extr()");
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+   }
+
+/*
+ * dclout - output an ordinary global C declaration.
+ */
+void dclout(n)
+struct node *n;
+   {
+   if (!enable_out)
+      return;        /* output disabled */
+   if (real_def(n))
+      def_fnd = 1;   /* this declaration defines a run-time object */
+   c_walk(n, 0, 0);
+   free_tree(n);
+   }
+
+/*
+ * fncout - output code for a C function.
+ */
+void fncout(head, prm_dcl, block)
+struct node *head;
+struct node *prm_dcl;
+struct node *block;
+   {
+   if (!enable_out)
+      return;       /* output disabled */
+
+   def_fnd = 1;     /* this declaration defines a run-time object */
+
+   nxt_sbuf = 0;    /* clear number of string buffers */
+   nxt_cbuf = 0;    /* clear number of cset buffers */
+
+   /*
+    * Output the function header and the parameter declarations.
+    */
+   fnc_head = head;
+   c_walk(head, 0, 0);
+   prt_str(" ",  0);
+   c_walk(prm_dcl, 0, 0);
+   prt_str(" ", 0);
+
+   /*
+    * Handle outer block.
+    */
+   prt_tok(block->tok, IndentInc);          /* { */
+   c_walk(block->u[0].child, IndentInc, 0); /* non-tended declarations */
+   spcl_dcls(NULL);                         /* tended declarations */
+   no_ret_val = 1;
+   c_walk(block->u[2].child, IndentInc, 0); /* statement list */
+   if (ntend != 0 && no_ret_val) {
+      /*
+       * This function contains no return statements with values, assume
+       *  that the programmer is using the implicit return at the end
+       *  of the function and update the tending of descriptors.
+       */
+      untend(IndentInc);
+      }
+   ForceNl();
+   prt_str("}", IndentInc);
+   ForceNl();
+
+   /*
+    * free storage.
+    */
+   free_tree(head);
+   free_tree(prm_dcl);
+   free_tree(block);
+   pop_cntxt();
+   clr_def();
+   }
+
+/*
+ * defout - output operation definitions (except for constant keywords)
+ */
+void defout(n)
+struct node *n;
+   {
+   struct sym_entry *sym, *sym1;
+
+   if (!enable_out)
+      return;       /* output disabled */
+
+   nxt_sbuf = 0;
+   nxt_cbuf = 0;
+
+   /*
+    * Somewhat different code is produced for the interpreter and compiler.
+    */
+   if (iconx_flg)
+      interp_def(n);
+   else
+      comp_def(n);
+
+   free_tree(n);
+   /*
+    * The declarations for the declare statement are not associated with
+    *  any compound statement and must be freed here.
+    */
+   sym = dcl_stk->tended;
+   while (sym != NULL) {
+      sym1 = sym;
+      sym = sym->u.tnd_var.next;
+      free_sym(sym1);
+      }
+   while (decl_lst != NULL) {
+      sym1 = decl_lst;
+      decl_lst = decl_lst->u.declare_var.next;
+      free_sym(sym1);
+      }
+   op_type = OrdFunc;
+   pop_cntxt();
+   clr_def();
+   }
+
+/*
+ * comp_def - output code for the compiler for operation definitions.
+ */
+static void comp_def(n)
+struct node *n;
+   {
+   #ifdef Rttx
+      fprintf(stdout,
+         "rtt was compiled to only support the interpreter, use -x\n");
+      exit(EXIT_FAILURE);
+   #else				/* Rttx */
+   struct sym_entry *sym;
+   struct node *n1;
+   FILE *f_save;
+
+   char buf1[5];
+   char buf[MaxPath];
+   char *cname;
+   long min_result;
+   long max_result;
+   int ret_flag;
+   int resume;
+   char *name;
+   char *s;
+
+   f_save = out_file;
+
+   /*
+    * Note if the result location is explicitly referenced and note
+    *  how it is accessed in the generated code.
+    */
+   cur_impl->use_rslt = sym_lkup(str_rslt)->u.referenced;
+   rslt_loc = "(*r_rslt)";
+
+   /*
+    * In several contexts, letters are used to distinguish kinds of operations.
+    */
+   switch (op_type) {
+      case TokFunction:
+         lc_letter = 'f';
+         uc_letter = 'F';
+         break;
+      case Keyword:
+         lc_letter = 'k';
+         uc_letter = 'K';
+         break;
+      case Operator:
+         lc_letter = 'o';
+         uc_letter = 'O';
+      }
+   prfx1 = cur_impl->prefix[0];
+   prfx2 = cur_impl->prefix[1];
+
+   if (op_type != Keyword) {
+      /*
+       * First pass through the operation: produce most general routine.
+       */
+      fnc_ret = RetSig;  /* most general routine always returns a signal */
+
+      /*
+       * Compute the file name in which to output the function.
+       */
+      sprintf(buf1, "%c_%c%c", lc_letter, prfx1, prfx2);
+      cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
+      if ((out_file = fopen(cname, "w")) == NULL)
+         err2("cannot open output file", cname);
+      else
+         addrmlst(cname, out_file);
+
+      prologue(); /* output standard comments and preprocessor directives */
+
+      /*
+       * Output function header that corresponds to standard calling
+       *  convensions. The function name is constructed from the letter
+       *  for the operation type, the prefix that makes the function
+       *  name unique, and the name of the operation.
+       */
+      fprintf(out_file, "int %c%c%c_%s(r_nargs, r_args, r_rslt, r_s_cont)\n",
+         uc_letter, prfx1, prfx2, cur_impl->name);
+      fprintf(out_file, "int r_nargs;\n");
+      fprintf(out_file, "dptr r_args;\n");
+      fprintf(out_file, "dptr r_rslt;\n");
+      fprintf(out_file, "continuation r_s_cont;");
+      fname = cname;
+      line = 12;
+      ForceNl();
+      prt_str("{", IndentInc);
+      ForceNl();
+
+      /*
+       * Output ordinary declarations from declare clause.
+       */
+      for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
+         c_walk(sym->u.declare_var.tqual, IndentInc, 0);
+         prt_str(" ", IndentInc);
+         c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
+         if ((n1 = sym->u.declare_var.init) != NULL) {
+            prt_str(" = ", IndentInc);
+            c_walk(n1, IndentInc, 0);
+            }
+         prt_str(";", IndentInc);
+         }
+
+      /*
+       * Output code for special declarations along with code to initial
+       *  them. This includes buffers and tended locations for parameters
+       *  and tended variables.
+       */
+      spcl_dcls(params);
+
+      if (rt_walk(n, IndentInc, 0)) {  /* body of operation */
+         if (n->nd_id == ConCatNd)
+            s = n->u[1].child->tok->fname;
+         else
+            s = n->tok->fname;
+         fprintf(stderr, "%s: file %s, warning: ", progname, s);
+         fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
+             cur_impl->name);
+         }
+
+      ForceNl();
+      prt_str("}\n", IndentInc);
+      if (fclose(out_file) != 0)
+         err2("cannot close ", cname);
+      put_c_fl(cname, 1);  /* note name of output file for operation */
+      }
+
+   /*
+    * Second pass through operation: produce in-line code and special purpose
+    *  routines.
+    */
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next)
+      if (sym->id_type & DrfPrm)
+         sym->u.param_info.cur_loc = PrmTend;  /* reset location of parameter */
+   in_line(n);
+
+   /*
+    * Insure that the fail/return/suspend statements are consistent
+    *  with the result sequence indicated.
+    */
+   min_result = cur_impl->min_result;
+   max_result = cur_impl->max_result;
+   ret_flag = cur_impl->ret_flag;
+   resume = cur_impl->resume;
+   name = cur_impl->name;
+   if (min_result == NoRsltSeq && ret_flag & (DoesFail|DoesRet|DoesSusp))
+      err2(name,
+         ": result sequence of {}, but fail, return, or suspend present");
+   if (min_result != NoRsltSeq && ret_flag == 0)
+      err2(name,
+         ": result sequence indicated, no fail, return, or suspend present");
+   if (max_result != NoRsltSeq) {
+      if (max_result == 0 && ret_flag & (DoesRet|DoesSusp))
+         err2(name,
+            ": result sequence of 0 length, but return or suspend present");
+      if (max_result != 0 && !(ret_flag & (DoesRet | DoesSusp)))
+         err2(name,
+            ": result sequence length > 0, but no return or suspend present");
+      if ((max_result == UnbndSeq || max_result > 1 || resume) &&
+         !(ret_flag & DoesSusp))
+         err2(name,
+            ": result sequence indicates suspension, but no suspend present");
+      if ((max_result != UnbndSeq && max_result <= 1 && !resume) &&
+         ret_flag & DoesSusp)
+         err2(name,
+            ": result sequence indicates no suspension, but suspend present");
+      }
+   if (min_result != NoRsltSeq && max_result != UnbndSeq &&
+      min_result > max_result)
+      err2(name, ": minimum result sequence length greater than maximum");
+
+   out_file = f_save;
+#endif					/* Rttx */
+   }
+
+/*
+ * interp_def - output code for the interpreter for operation definitions.
+ */
+static void interp_def(n)
+struct node *n;
+   {
+   struct sym_entry *sym;
+   struct node *n1;
+   int nparms;
+   int has_underef;
+   char letter;
+   char *name;
+   char *s;
+
+   /*
+    * Note how result location is accessed in generated code.
+    */
+   rslt_loc = "r_args[0]";
+
+   /*
+    * Determine if the operation has any undereferenced parameters.
+    */
+   has_underef = 0;
+   for (sym = params; sym != NULL; sym = sym->u.param_info.next)
+      if (sym->id_type  & RtParm) {
+         has_underef = 1;
+         break;
+         }
+
+   /*
+    * Determine the nuber of parameters. A negative value is used
+    *  to indicate an operation that takes a variable number of
+    *  arguments.
+    */
+   if (params == NULL)
+      nparms = 0;
+   else {
+      nparms = params->u.param_info.param_num + 1;
+      if (params->id_type & VarPrm)
+         nparms = -nparms;
+      }
+
+   fnc_ret = RetSig;  /* interpreter routine always returns a signal */
+   name = cur_impl->name;
+
+   /*
+    * Determine what letter is used to prefix the operation name.
+    */
+   switch (op_type) {
+      case TokFunction:
+         letter = 'Z';
+         break;
+      case Keyword:
+         letter = 'K';
+         break;
+      case Operator:
+         letter = 'O';
+         }
+
+   fprintf(out_file, "\n");
+   if (op_type != Keyword) {
+      /*
+       * Output prototype. Operations taking a variable number of arguments
+       *   have an extra parameter: the number of arguments.
+       */
+      fprintf(out_file, "int %c%s (", letter, name);
+      if (params != NULL && (params->id_type & VarPrm))
+         fprintf(out_file, "int r_nargs, ");
+      fprintf(out_file, "dptr r_args);\n");
+      ++line;
+
+      /*
+       * Output procedure block.
+       */
+      switch (op_type) {
+         case TokFunction:
+            fprintf(out_file, "FncBlock(%s, %d, %d)\n\n", name, nparms,
+               (has_underef ? -1 : 0));
+            ++line;
+            break;
+         case Operator:
+            if (strcmp(cur_impl->op,"\\") == 0)
+               fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
+                  "\\\\");
+            else
+               fprintf(out_file, "OpBlock(%s, %d, \"%s\", 0)\n\n", name, nparms,
+                  cur_impl->op);
+            ++line;
+         }
+      }
+
+   /*
+    * Output function header. Operations taking a variable number of arguments
+    *   have an extra parameter: the number of arguments.
+    */
+   fprintf(out_file, "int %c%s(", letter, name);
+   if (params != NULL && (params->id_type & VarPrm))
+      fprintf(out_file, "r_nargs, ");
+   fprintf(out_file, "r_args)\n");
+   ++line;
+   if (params != NULL && (params->id_type & VarPrm)) {
+      fprintf(out_file, "int r_nargs;\n");
+      ++line;
+      }
+   fprintf(out_file, "dptr r_args;");
+   ++line;
+   ForceNl();
+   prt_str("{", IndentInc);
+
+   /*
+    * Output ordinary declarations from the declare clause.
+    */
+   ForceNl();
+   for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
+      c_walk(sym->u.declare_var.tqual, IndentInc, 0);
+      prt_str(" ", IndentInc);
+      c_walk(sym->u.declare_var.dcltor, IndentInc, 0);
+      if ((n1 = sym->u.declare_var.init) != NULL) {
+         prt_str(" = ", IndentInc);
+         c_walk(n1, IndentInc, 0);
+         }
+      prt_str(";", IndentInc);
+      }
+
+   /*
+    * Output special declarations and initial processing.
+    */
+   tendstrct = "r_tend";
+   spcl_start(params);
+   tend_ary(ntend);
+   if (has_underef && params != NULL && params->id_type == (VarPrm | DrfPrm))
+      prt_str("int r_n;\n", IndentInc);
+   tend_init();
+
+   /*
+    * See which parameters need to be dereferenced. If all are dereferenced,
+    *  it is done by before the routine is called.
+    */
+   if (has_underef) {
+      sym = params;
+      if (sym != NULL && sym->id_type & VarPrm) {
+         if (sym->id_type & DrfPrm) {
+            /*
+             * There is a variable part of the parameter list and it
+             *  must be dereferenced.
+             */
+            prt_str("for (r_n = ", IndentInc);
+            fprintf(out_file, "%d; r_n <= r_nargs; ++r_n)",
+                sym->u.param_info.param_num + 1);
+            ForceNl();
+            prt_str("Deref(r_args[r_n]);", IndentInc * 2);
+            ForceNl();
+            }
+         sym = sym->u.param_info.next;
+         }
+
+      /*
+       * Produce code to dereference any fixed parameters that need to be.
+       */
+      while (sym != NULL) {
+         if (sym->id_type & DrfPrm) {
+            /*
+             * Tended index of -1 indicates that the parameter can be
+             *  dereferened in-place (this is the usual case).
+             */
+            if (sym->t_indx == -1) {
+               prt_str("Deref(r_args[", IndentInc * 2);
+               fprintf(out_file, "%d]);", sym->u.param_info.param_num + 1);
+               }
+            else {
+               prt_str("deref(&r_args[", IndentInc * 2);
+               fprintf(out_file, "%d], &r_tend.d[%d]);",
+                  sym->u.param_info.param_num + 1, sym->t_indx);
+               }
+            }
+         ForceNl();
+         sym = sym->u.param_info.next;
+         }
+      }
+
+   /*
+    * Finish setting up the tended array structure and link it into the tended
+    *  list.
+    */
+   if (ntend != 0) {
+      prt_str("r_tend.num = ", IndentInc);
+      fprintf(out_file, "%d;", ntend);
+      ForceNl();
+      prt_str("r_tend.previous = tend;", IndentInc);
+      ForceNl();
+      prt_str("tend = (struct tend_desc *)&r_tend;", IndentInc);
+      ForceNl();
+      }
+
+   if (rt_walk(n, IndentInc, 0)) { /* body of operation */
+      if (n->nd_id == ConCatNd)
+         s = n->u[1].child->tok->fname;
+      else
+         s = n->tok->fname;
+      fprintf(stderr, "%s: file %s, warning: ", progname, s);
+      fprintf(stderr, "execution may fall off end of operation \"%s\"\n",
+          cur_impl->name);
+      }
+   ForceNl();
+   prt_str("}\n", IndentInc);
+   }
+
+/*
+ * keyconst - produce code for a constant keyword.
+ */
+void keyconst(t)
+struct token *t;
+   {
+   struct il_code *il;
+   int n;
+
+   if (iconx_flg) {
+      /*
+       * For the interpreter, output a C function implementing the keyword.
+       */
+      rslt_loc = "r_args[0]";  /* result location */
+
+      fprintf(out_file, "\n");
+      fprintf(out_file, "int K%s(r_args)\n", cur_impl->name);
+      fprintf(out_file, "dptr r_args;");
+      line += 2;
+      ForceNl();
+      prt_str("{", IndentInc);
+      ForceNl();
+      switch (t->tok_id) {
+         case StrLit:
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".vword.sptr = \"", IndentInc);
+            n = prt_i_str(out_file, t->image, (int)strlen(t->image));
+            prt_str("\";", IndentInc);
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            fprintf(out_file, ".dword = %d;", n);
+            break;
+         case CharConst:
+            prt_str("static struct b_cset cset_blk = ", IndentInc);
+            cset_init(out_file, bitvect(t->image, (int)strlen(t->image)));
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".dword = D_Cset;", IndentInc);
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".vword.bptr = (union block *)&cset_blk;", IndentInc);
+            break;
+         case DblConst:
+            prt_str("static struct b_real real_blk = {T_Real, ", IndentInc);
+            fprintf(out_file, "%s};", t->image);
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".dword = D_Real;", IndentInc);
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".vword.bptr = (union block *)&real_blk;", IndentInc);
+            break;
+         case IntConst:
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".dword = D_Integer;", IndentInc);
+            ForceNl();
+            prt_str(rslt_loc, IndentInc);
+            prt_str(".vword.integr = ", IndentInc);
+            prt_str(t->image, IndentInc);
+            prt_str(";", IndentInc);
+            break;
+         }
+      ForceNl();
+      prt_str("return A_Continue;", IndentInc);
+      ForceNl();
+      prt_str("}\n", IndentInc);
+      ++line;
+      ForceNl();
+      }
+   else {
+      /*
+       * For the compiler, make an entry in the data base for the keyword.
+       */
+      cur_impl->use_rslt = 0;
+
+      il = new_il(IL_Const, 2);
+      switch (t->tok_id) {
+         case StrLit:
+            il->u[0].n = str_typ;
+            il->u[1].s = alloc(strlen(t->image) + 3);
+            sprintf(il->u[1].s, "\"%s\"", t->image);
+            break;
+         case CharConst:
+            il->u[0].n = cset_typ;
+            il->u[1].s = alloc(strlen(t->image) + 3);
+            sprintf(il->u[1].s, "'%s'", t->image);
+            break;
+         case DblConst:
+            il->u[0].n = real_typ;
+            il->u[1].s = t->image;
+            break;
+         case IntConst:
+            il->u[0].n = int_typ;
+            il->u[1].s = t->image;
+            break;
+         }
+      cur_impl->in_line = il;
+      }
+
+   /*
+    * Reset the translator and free storage.
+    */
+   op_type = OrdFunc;
+   free_t(t);
+   pop_cntxt();
+   clr_def();
+   }
+
+/*
+ * keepdir - A preprocessor directive to be kept has been encountered.
+ *   If it is #passthru, print just the body of the directive, otherwise
+ *   print the whole thing.
+ */
+void keepdir(t)
+struct token *t;
+   {
+   char *s;
+
+   tok_line(t, 0);
+   s = t->image;
+   if (strncmp(s, "#passthru", 9) == 0)
+      s = s + 10;
+   fprintf(out_file, "%s\n", s);
+   line += 1;
+   }
+
+/*
+ * prologue - print standard comments and preprocessor directives at the
+ *   start of an output file.
+ */
+void prologue()
+   {
+   id_comment(out_file);
+   fprintf(out_file, "%s", compiler_def);
+   fprintf(out_file, "#include \"%s\"\n\n", inclname);
+   }
diff --git a/src/rtt/rttparse.c b/src/rtt/rttparse.c
new file mode 100644
index 0000000..9f18ec1
--- /dev/null
+++ b/src/rtt/rttparse.c
@@ -0,0 +1,2992 @@
+
+# line 7 "rttgram.y"
+#include "rtt1.h"
+#define YYMAXDEPTH 250
+
+# line 11 "rttgram.y"
+typedef union  {
+   struct token *t;
+   struct node *n;
+   long i;
+   } YYSTYPE;
+# define Identifier 257
+# define StrLit 258
+# define LStrLit 259
+# define FltConst 260
+# define DblConst 261
+# define LDblConst 262
+# define CharConst 263
+# define LCharConst 264
+# define IntConst 265
+# define UIntConst 266
+# define LIntConst 267
+# define ULIntConst 268
+# define Arrow 269
+# define Incr 270
+# define Decr 271
+# define LShft 272
+# define RShft 273
+# define Leq 274
+# define Geq 275
+# define TokEqual 276
+# define Neq 277
+# define And 278
+# define Or 279
+# define MultAsgn 280
+# define DivAsgn 281
+# define ModAsgn 282
+# define PlusAsgn 283
+# define MinusAsgn 284
+# define LShftAsgn 285
+# define RShftAsgn 286
+# define AndAsgn 287
+# define XorAsgn 288
+# define OrAsgn 289
+# define Sizeof 290
+# define Intersect 291
+# define OpSym 292
+# define Typedef 293
+# define Extern 294
+# define Static 295
+# define Auto 296
+# define TokRegister 297
+# define Tended 298
+# define TokChar 299
+# define TokShort 300
+# define Int 301
+# define TokLong 302
+# define Signed 303
+# define Unsigned 304
+# define Float 305
+# define Doubl 306
+# define Const 307
+# define Volatile 308
+# define Void 309
+# define TypeDefName 310
+# define Struct 311
+# define Union 312
+# define TokEnum 313
+# define Ellipsis 314
+# define Case 315
+# define Default 316
+# define If 317
+# define Else 318
+# define Switch 319
+# define While 320
+# define Do 321
+# define For 322
+# define Goto 323
+# define Continue 324
+# define Break 325
+# define Return 326
+# define Runerr 327
+# define Is 328
+# define Cnv 329
+# define Def 330
+# define Exact 331
+# define Empty_type 332
+# define IconType 333
+# define Component 334
+# define Variable 335
+# define Any_value 336
+# define Named_var 337
+# define Struct_var 338
+# define C_Integer 339
+# define Arith_case 340
+# define C_Double 341
+# define C_String 342
+# define Tmp_string 343
+# define Tmp_cset 344
+# define Body 345
+# define End 346
+# define TokFunction 347
+# define Keyword 348
+# define Operator 349
+# define Underef 350
+# define Declare 351
+# define Suspend 352
+# define Fail 353
+# define Inline 354
+# define Abstract 355
+# define Store 356
+# define TokType 357
+# define New 358
+# define All_fields 359
+# define Then 360
+# define Type_case 361
+# define Of 362
+# define Len_case 363
+# define Constant 364
+# define Errorfail 365
+# define IfStmt 366
+#define yyclearin yychar = -1
+#define yyerrok yyerrflag = 0
+extern int yychar;
+extern int yyerrflag;
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 150
+#endif
+YYSTYPE yylval, yyval;
+# define YYERRCODE 256
+
+# line 1089 "rttgram.y"
+
+
+/*
+ * 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,
+	0, 279,
+	258, 299,
+	347, 299,
+	348, 299,
+	349, 299,
+	-2, 193,
+-1, 1,
+	0, -1,
+	-2, 0,
+-1, 2,
+	0, 280,
+	258, 299,
+	347, 299,
+	348, 299,
+	349, 299,
+	-2, 193,
+-1, 51,
+	44, 113,
+	59, 113,
+	-2, 290,
+-1, 58,
+	44, 115,
+	59, 115,
+	-2, 289,
+-1, 100,
+	123, 166,
+	-2, 168,
+-1, 138,
+	125, 257,
+	59, 86,
+	-2, 230,
+-1, 238,
+	125, 257,
+	59, 86,
+	-2, 230,
+-1, 239,
+	125, 258,
+	59, 86,
+	-2, 230,
+-1, 255,
+	58, 293,
+	-2, 1,
+-1, 256,
+	58, 294,
+	-2, 98,
+-1, 262,
+	59, 86,
+	-2, 230,
+-1, 308,
+	41, 212,
+	-2, 193,
+-1, 371,
+	41, 204,
+	44, 204,
+	-2, 193,
+-1, 396,
+	59, 86,
+	-2, 230,
+-1, 398,
+	59, 86,
+	-2, 230,
+-1, 452,
+	41, 214,
+	44, 214,
+	-2, 194,
+-1, 516,
+	59, 86,
+	-2, 230,
+-1, 545,
+	40, 193,
+	91, 193,
+	-2, 219,
+-1, 617,
+	293, 219,
+	294, 219,
+	295, 219,
+	296, 219,
+	297, 219,
+	299, 219,
+	300, 219,
+	301, 219,
+	302, 219,
+	303, 219,
+	304, 219,
+	305, 219,
+	306, 219,
+	307, 219,
+	308, 219,
+	309, 219,
+	310, 219,
+	311, 219,
+	312, 219,
+	313, 219,
+	41, 219,
+	339, 219,
+	341, 219,
+	342, 219,
+	-2, 193,
+-1, 624,
+	59, 86,
+	-2, 230,
+-1, 625,
+	59, 86,
+	-2, 230,
+-1, 627,
+	59, 86,
+	-2, 230,
+-1, 677,
+	59, 86,
+	-2, 230,
+-1, 725,
+	59, 86,
+	-2, 230,
+-1, 730,
+	58, 453,
+	-2, 317,
+-1, 731,
+	58, 454,
+	-2, 321,
+-1, 732,
+	58, 455,
+	-2, 324,
+-1, 733,
+	58, 456,
+	-2, 337,
+-1, 771,
+	59, 86,
+	-2, 230,
+-1, 792,
+	59, 86,
+	-2, 230,
+	};
+# define YYNPROD 481
+# define YYLAST 3082
+int yyact[]={
+
+   166,   644,   439,   665,   196,   272,   241,   718,   245,   720,
+   565,   350,   645,    16,   676,   257,    63,   657,   105,     9,
+   662,     9,   646,   492,   365,   212,   552,   370,   104,     8,
+   358,     8,    11,   658,   240,    88,   186,    50,   143,   234,
+   222,   346,    58,   638,    97,    97,   227,   761,   271,   213,
+   420,   486,   140,   484,    97,   147,   745,    98,    98,    12,
+   478,    51,   642,   551,   193,    13,   475,    98,   728,    55,
+   118,   120,   119,   541,   146,    56,   683,    25,   238,   709,
+   523,   746,   684,    90,   436,   437,   364,   438,   435,   137,
+   725,   652,   553,   553,   345,   436,   437,   123,   438,   435,
+   436,   437,   179,   438,   435,   347,   348,   349,   666,    93,
+   132,   663,    23,    24,   144,    18,    19,    20,    21,    22,
+   144,    33,    34,    35,    36,    39,    40,    37,    38,    23,
+    24,    32,   308,    45,    46,    44,    97,   307,   141,   255,
+   132,   132,   185,   181,   132,   180,   141,   182,   393,    98,
+   670,   144,   256,   191,    56,   165,   301,   780,   751,    15,
+   394,   395,   713,   228,   189,    55,   696,   184,    53,   479,
+   124,    56,   288,   789,   154,   663,   446,   215,   650,   317,
+   560,   318,   223,   246,   274,   315,   316,   695,   490,   298,
+   321,   322,   312,    61,   183,   336,   214,   237,   338,   334,
+   337,   131,   339,   412,   351,   352,   295,   297,   215,   299,
+   820,   360,   800,   328,   127,   200,    31,   368,   770,    18,
+    19,    20,    21,    22,   756,   691,   612,   306,   233,   384,
+   510,   128,   132,    23,    24,   373,   422,    97,   496,   255,
+   255,   491,   476,   215,   305,   372,   390,   384,   387,   786,
+    98,   626,   256,   391,   561,   559,   138,   235,   477,   130,
+   332,   313,   214,   255,    53,   409,   236,    53,   211,   406,
+   210,    53,   750,   389,   378,    88,   391,   209,   391,   382,
+   215,   423,   135,   413,   413,   215,   126,    59,   802,    53,
+   738,    92,    97,    97,   200,   420,   429,   397,   690,   214,
+   660,    95,   100,   215,   214,    98,    98,   447,   357,   404,
+   509,   110,   471,   363,   312,   637,   700,   421,   651,   696,
+   765,   485,   214,   312,   312,   434,   781,   385,   383,   114,
+   368,   108,   226,   545,   696,   696,   334,   425,   426,   399,
+   695,   218,   772,   215,   535,   306,   334,   768,   373,   306,
+   666,   188,   451,   735,   351,   695,   695,   215,   372,   220,
+   194,   215,   468,   469,   470,   487,   636,   764,   521,   215,
+   215,   215,   215,   215,   215,   215,   215,   215,   215,   215,
+   215,   215,   215,   215,   546,    97,   452,   480,   287,   347,
+   348,   349,   230,   319,   320,   512,   514,   255,    98,   255,
+    52,   190,   187,   515,   500,   517,   518,   671,   448,   202,
+   391,   474,   391,   228,    31,   501,   472,   503,   629,   208,
+   527,   528,   529,   524,   507,   122,   531,   505,   144,   223,
+   511,    49,   205,    55,   359,   508,   388,   206,   432,    56,
+   530,   215,   454,   455,   488,   489,   207,   201,   408,   452,
+   220,   519,   520,   203,   522,   204,   195,   433,   457,   456,
+   214,   533,   424,   458,   459,   386,   466,   467,   453,   440,
+   436,   437,   417,   438,   435,   441,   121,   442,   443,   444,
+   445,    23,    24,   554,   526,   557,   558,   543,   202,   464,
+   465,   525,   566,   419,   649,   647,   648,   566,   208,   614,
+   418,   696,   411,    63,   556,   567,   215,   613,   142,   389,
+   567,   205,   460,   461,   462,   463,   206,   255,   373,   361,
+   362,   555,   695,   621,   611,   207,   201,   616,   372,   410,
+   391,   502,   203,   420,   204,   401,    53,   818,   290,   242,
+     5,    31,     5,   631,   291,   632,   633,   534,   635,   430,
+   431,   107,    53,   331,   618,   380,   619,   229,   376,    31,
+   215,   341,   215,   351,   815,   351,   620,   810,   113,   107,
+   379,   771,   640,   375,   664,   224,   667,   643,   759,   214,
+   758,   214,   659,   112,   106,   757,   715,   712,   103,   289,
+   215,   516,   483,   482,   481,   398,   396,   381,   377,   304,
+   303,   164,   215,   302,   697,   775,   159,   327,   178,   630,
+   160,   161,   325,   162,   323,   798,   324,   326,   799,   794,
+   755,   214,   795,   452,   753,   255,   255,   754,   255,   672,
+   734,   673,   674,   420,   678,   669,   685,   627,   391,   391,
+   420,   391,   139,   625,   692,   680,   420,   682,   693,   659,
+   123,   562,   701,   702,   351,   351,   351,   703,   373,   499,
+   677,   498,   686,   710,   689,   704,   705,   706,   372,   721,
+   624,   699,   622,   420,   708,   623,   420,   679,   494,   659,
+   563,   711,   714,   564,   536,   812,   729,   537,   736,    31,
+   727,   737,   215,   811,   163,   452,   741,   806,   659,   351,
+   711,   790,   749,   494,   493,   453,   373,   742,   743,   677,
+   747,   214,   739,   797,   449,   792,   372,   420,   777,   776,
+   760,   762,   774,   766,   566,   763,   255,   752,   740,   724,
+   717,   716,   769,   688,   767,   681,   634,   567,   547,   391,
+   538,   497,   450,   330,   217,   748,   698,   668,   655,   654,
+   779,   773,   653,   628,   542,   540,   539,   407,   405,   403,
+   782,   783,   784,   402,   785,   787,   721,   292,   293,   294,
+   400,   356,   353,   314,   355,   788,     3,   502,   354,    47,
+   791,   793,   641,   796,   342,   719,   723,   495,   117,   801,
+   803,   721,   192,   255,   116,   115,    60,   807,   804,   805,
+   808,    10,    48,     6,     4,   809,   391,     2,   392,   249,
+   687,   639,   216,   329,   136,   813,   814,    99,   506,   817,
+   816,   200,   504,   819,     1,    75,   167,   168,   169,   170,
+   171,   172,   173,   174,   175,   176,   177,   778,   150,   151,
+   550,   164,   549,   661,   344,   675,   159,   726,   178,   707,
+   160,   161,   656,   162,   343,   197,   199,   198,   153,   340,
+     7,    18,    19,    20,    21,    22,   243,    33,    34,    35,
+    36,    39,    40,    37,    38,    23,    24,    32,    26,    45,
+    46,    44,   253,   247,   248,   258,   252,   259,   261,   262,
+   263,   264,   265,   266,   267,   254,   156,   157,   158,    73,
+    71,    74,    69,    87,    67,    77,    81,    27,    75,    28,
+    29,    84,    83,    68,    72,   251,   250,   239,    86,    70,
+   268,   269,    76,    65,    80,    85,    78,    66,    82,   260,
+    79,   101,   102,   270,   163,   244,   273,   544,   366,   369,
+   367,   599,    62,   109,   605,   582,   600,   568,   594,   604,
+   571,   597,   589,   592,   598,   607,   584,   578,   573,   609,
+   608,    26,   601,   606,   580,    42,   570,   576,   588,   579,
+   603,   610,   577,   585,   587,   574,   569,   595,   596,   590,
+   572,   575,    73,    71,    74,    69,    87,    67,    77,    81,
+    27,   225,    28,    29,    84,    83,    68,    72,   586,   591,
+   593,    86,    70,   602,   583,    76,    65,    80,    85,    78,
+    66,    82,   164,    79,   221,   202,   581,   159,   133,   178,
+   129,   160,   161,    41,   162,   208,   309,    54,    17,   371,
+   436,   437,   276,   438,   435,   148,   428,   149,   205,   155,
+   744,   694,   335,   206,    43,   275,   152,     0,     0,     0,
+     0,     0,   207,   201,     0,     0,   111,     0,     0,   203,
+     0,   204,     0,     0,     0,    75,   167,   168,   169,   170,
+   171,   172,   173,   174,   175,   176,   177,     0,   150,   151,
+    33,    34,    35,    36,    39,    40,    37,    38,    23,    24,
+    32,     0,    45,    46,    44,     0,     0,     0,   153,     0,
+     0,     0,     0,     0,     0,   163,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,    26,    75,
+     0,     0,     0,   247,   248,   258,     0,   259,   261,   262,
+   263,   264,   265,   266,   267,   254,   156,   157,   158,    73,
+    71,    74,    69,    87,    67,    77,    81,    27,     0,    28,
+    29,    84,    83,    68,    72,     0,     0,     0,    86,    70,
+   268,   269,    76,    65,    80,    85,    78,    66,    82,   260,
+    79,   164,    26,   270,     0,     0,   159,     0,   178,     0,
+   160,   161,     0,   162,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,    73,    71,    74,    69,    87,    67,    77,
+    81,    27,     0,    28,    29,    84,    83,    68,    72,     0,
+     0,     0,    86,    70,     0,     0,    76,    65,    80,    85,
+    78,    66,    82,     0,    79,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,    75,   167,   168,   169,
+   170,   171,   172,   173,   174,   175,   176,   177,     0,   150,
+   151,   277,   278,   279,   280,   281,   282,   283,   284,   285,
+   286,     0,     0,     0,   163,     0,     0,     0,     0,   153,
+     0,     0,     0,    75,     0,     0,     0,     0,    33,    34,
+    35,    36,    39,    40,    37,    38,    23,    24,    32,    26,
+    45,    46,    44,   164,     0,     0,     0,     0,   159,     0,
+   178,     0,   160,   161,     0,   162,     0,   156,   157,   158,
+    73,    71,    74,    69,    87,    67,    77,    81,    27,     0,
+    28,    29,    84,    83,    68,    72,    26,     0,     0,    86,
+    70,     0,     0,    76,    65,    80,    85,    78,    66,    82,
+     0,    79,     0,     0,     0,     0,     0,    73,    71,    74,
+    69,    87,    67,    77,    81,    27,     0,    28,    29,    84,
+    83,    68,    72,     0,     0,     0,    86,    70,     0,     0,
+    76,    65,    80,    85,    78,    66,    82,     0,    79,     0,
+     0,     0,     0,     0,     0,     0,   163,     0,     0,     0,
+     0,     0,     0,     0,     0,    75,   167,   168,   169,   170,
+   171,   172,   173,   174,   175,   176,   177,     0,   150,   151,
+     0,   164,     0,     0,     0,     0,   159,     0,   178,     0,
+   160,   161,     0,   162,     0,     0,     0,     0,   153,     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,   258,     0,   259,   261,   262,
+   263,   264,   265,   266,   267,   254,   156,   157,   158,    73,
+    71,    74,    69,    87,    67,    77,    81,     0,     0,     0,
+     0,    84,    83,    68,    72,     0,     0,     0,    86,    70,
+   268,   269,    76,    65,    80,    85,    78,    66,    82,   260,
+    79,     0,     0,   270,   163,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,    75,   167,   168,
+   169,   170,   171,   172,   173,   174,   175,   176,   177,     0,
+   150,   151,     0,     0,   164,     0,     0,     0,     0,   159,
+     0,   178,     0,   160,   161,     0,   162,     0,     0,     0,
+   153,     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,   258,     0,   259,
+   261,   262,   263,   264,   265,   266,   267,   254,   156,   157,
+   158,    73,   731,   732,    69,   733,   730,    77,    81,     0,
+     0,     0,     0,    84,    83,    68,    72,     0,     0,     0,
+    86,    70,   268,   269,    76,    65,    80,    85,    78,    66,
+    82,   260,    79,     0,   145,   270,   532,   163,     0,     0,
+     0,     0,     0,     0,     0,    75,   167,   168,   169,   170,
+   171,   172,   173,   174,   175,   176,   177,     0,   150,   151,
+   164,     0,     0,     0,     0,   159,     0,   178,   427,   160,
+   161,     0,   162,     0,     0,     0,     0,     0,   153,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,   164,     0,     0,     0,     0,
+   159,     0,   178,     0,   160,   161,     0,   162,     0,     0,
+     0,     0,     0,     0,     0,     0,   156,   157,   158,    73,
+    71,    74,    69,    87,    67,    77,    81,   414,   374,   415,
+   416,    84,    83,    68,    72,     0,     0,     0,    86,    70,
+     0,     0,    76,    65,    80,    85,    78,    66,    82,     0,
+    79,     0,     0,   163,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,    75,   167,
+   168,   169,   170,   171,   172,   173,   174,   175,   176,   177,
+     0,   150,   151,     0,     0,   145,     0,     0,   163,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,   153,     0,   164,     0,     0,     0,     0,   159,     0,
+   178,     0,   160,   161,     0,   162,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,   156,
+   157,   158,    73,    71,    74,    69,    87,    67,    77,    81,
+     0,     0,     0,     0,    84,    83,    68,    72,     0,     0,
+     0,    86,    70,     0,     0,    76,    65,    80,    85,    78,
+    66,    82,     0,    79,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,    75,   167,   168,   169,   170,   171,
+   172,   173,   174,   175,   176,   177,   163,   150,   151,     0,
+     0,     0,    33,    34,    35,    36,    39,    40,    37,    38,
+    23,    24,    32,    26,    45,    46,    44,   153,     0,    75,
+   167,   168,   169,   170,   171,   172,   173,   174,   175,   176,
+   177,     0,   150,   151,     0,     0,     0,     0,     0,     0,
+     0,     0,    27,     0,    28,    29,     0,     0,     0,     0,
+     0,     0,   153,     0,     0,   156,   157,   158,    73,    71,
+    74,    69,    87,    67,    77,    81,     0,     0,     0,     0,
+    84,    83,    68,    72,     0,     0,     0,    86,    70,     0,
+     0,    76,    65,    80,    85,    78,    66,    82,     0,    79,
+   156,   157,   158,    73,    71,    74,    69,    87,    67,    77,
+    81,     0,     0,     0,     0,    84,    83,    68,    72,     0,
+     0,     0,    86,    70,     0,     0,    76,    65,    80,    85,
+    78,    66,    82,     0,    79,     0,     0,    75,   167,   168,
+   169,   170,   171,   172,   173,   174,   175,   176,   177,     0,
+   150,   151,   164,     0,     0,     0,     0,   159,     0,   300,
+     0,   160,   161,     0,   162,     0,     0,     0,     0,     0,
+   153,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,   164,     0,     0,
+     0,     0,   159,     0,   296,     0,   160,   161,     0,   162,
+     0,     0,     0,     0,     0,     0,     0,     0,   156,   157,
+   158,    73,    71,    74,    69,    87,    67,    77,    81,    75,
+   219,     0,     0,    84,    83,    68,    72,     0,     0,     0,
+    86,    70,     0,     0,    76,    65,    80,    85,    78,    66,
+    82,     0,    79,     0,     0,   163,     0,     0,     0,     0,
+     0,    75,     0,     0,     0,    18,    19,    20,    21,    22,
+     0,    33,    34,    35,    36,    39,    40,    37,    38,    23,
+    24,    32,    26,    45,    46,    44,     0,     0,     0,     0,
+   163,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,    73,    71,    74,    69,    87,    67,    77,
+    81,    27,     0,    28,    29,    84,    83,    68,    72,     0,
+     0,     0,    86,    70,     0,     0,    76,    65,    80,    85,
+    78,    66,    82,   617,    79,    73,    71,    74,    69,    87,
+    67,    77,    81,     0,     0,     0,     0,    84,    83,    68,
+    72,     0,     0,     0,   722,    70,     0,     0,    76,    65,
+    80,    85,    78,    66,    82,     0,    79,     0,     0,    96,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,   546,     0,    75,   167,   168,   169,
+   170,   171,   172,   173,   174,   175,   176,   177,     0,   150,
+   151,     0,     0,     0,    33,    34,    35,    36,    39,    40,
+    37,    38,    23,    24,    32,    26,    45,    46,    44,   153,
+     0,    75,   167,   168,   169,   170,   171,   172,   173,   174,
+   175,   176,   177,     0,   150,   151,     0,     0,    14,     0,
+     0,     0,     0,     0,    27,     0,    28,    29,    57,    64,
+     0,     0,     0,     0,   153,     0,    91,   156,   157,   158,
+    73,    71,    74,    69,    87,    67,    77,    81,     0,     0,
+    94,     0,    84,    83,    68,    72,     0,     0,     0,    86,
+    70,     0,     0,    76,    65,    80,    85,    78,    66,    82,
+     0,    79,   156,   157,   158,    73,    71,    74,    69,    87,
+    67,    77,    81,    75,     0,     0,     0,    84,    83,    68,
+    72,     0,     0,     0,    86,    70,     0,     0,    76,    65,
+    80,    85,    78,    66,    82,     0,    79,    57,     0,     0,
+     0,   125,     0,     0,     0,    94,     0,     0,     0,     0,
+     0,     0,     0,     0,    57,     0,     0,     0,     0,     0,
+    75,     0,     0,     0,     0,     0,    26,     0,     0,     0,
+     0,     0,     0,     0,     0,    94,    94,     0,     0,   125,
+     0,    94,   232,     0,     0,     0,     0,    73,    71,    74,
+    69,    87,    67,    77,    81,    27,     0,    28,    29,    84,
+    83,    68,    72,     0,     0,     0,    86,    70,     0,     0,
+    76,    65,    80,    85,    78,    66,    82,    75,    79,     0,
+   200,     0,     0,   200,     0,     0,     0,   310,     0,     0,
+     0,     0,     0,     0,    73,    71,    74,    69,    87,    67,
+    77,    81,     0,     0,     0,     0,    84,    83,    68,    72,
+     0,     0,     0,    86,    70,     0,     0,    76,    65,    80,
+    85,    78,    66,    82,     0,    79,     0,    94,     0,     0,
+   513,     0,     0,     0,     0,     0,    75,     0,     0,   125,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,    73,    71,    74,    69,    87,    67,    77,    81,   548,
+     0,     0,     0,    84,    83,    68,    72,     0,    75,    31,
+    86,    70,     0,     0,    76,    65,    80,    85,    78,    66,
+    82,     0,    79,     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,   310,
+    73,    71,    74,    69,    87,    67,    77,    81,   310,   310,
+     0,     0,    84,    83,    68,    72,     0,     0,     0,    86,
+    70,     0,     0,    76,    65,    80,    85,    78,    66,    82,
+     0,    79,    73,    71,    74,    69,    87,    67,    77,    81,
+     0,     0,     0,     0,    84,    83,    68,    72,     0,     0,
+     0,    86,    70,    31,     0,    76,    65,    80,    85,    78,
+    66,    82,     0,    79,   202,     0,     0,   202,     0,   229,
+     0,     0,    57,     0,   208,     0,     0,   208,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,   205,     0,     0,
+   205,     0,   206,   473,     0,   206,   333,     0,     0,     0,
+     0,   207,   201,     0,   207,   201,     0,     0,   203,     0,
+   204,   203,     0,   204,     0,     0,     0,    18,    19,    20,
+    21,    22,   243,    33,    34,    35,    36,    39,    40,    37,
+    38,    23,    24,    32,    26,    45,    46,    44,    18,    19,
+    20,    21,    22,     0,    33,    34,    35,    36,    39,    40,
+    37,    38,    23,    24,    32,    26,    45,    46,    44,   615,
+    30,     0,     0,    27,     0,    28,    29,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,    89,     0,
+     0,     0,     0,     0,    27,     0,    28,    29,    18,    19,
+    20,    21,    22,   243,    33,    34,    35,    36,    39,    40,
+    37,    38,    23,    24,    32,    26,    45,    46,    44,     0,
+    18,    19,    20,    21,    22,     0,    33,    34,    35,    36,
+    39,    40,    37,    38,    23,    24,    32,    26,    45,    46,
+    44,     0,     0,     0,    27,     0,    28,    29,     0,     0,
+     0,    33,    34,    35,    36,    39,    40,    37,    38,    23,
+    24,    32,    26,    45,    46,    44,    27,   134,    28,    29,
+    18,    19,    20,    21,    22,     0,    33,    34,    35,    36,
+    39,    40,    37,    38,    23,    24,    32,    26,    45,    46,
+    44,    27,     0,    28,    29,     0,     0,   134,   134,     0,
+     0,   134,     0,     0,   231,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,    27,     0,    28,    29,
+    33,    34,    35,    36,    39,    40,    37,    38,    23,    24,
+    32,    26,    45,    46,    44,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,   311,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+    27,     0,    28,    29,     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,   134,
+     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,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,   311,     0,     0,     0,     0,     0,     0,     0,     0,
+   311,   311 };
+int yypact[]={
+
+  2527, -1000,  2527, -1000, -1000, -1000, -1000, -1000,   372,  2527,
+   -65, -1000, -1000, -1000, -1000,  2279,   -74,  -178, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000,   174, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000,  2116,   862, -1000, -1000, -1000,  2577, -1000,
+   525,   270, -1000,  1016,   524, -1000, -1000, -1000,   268, -1000,
+  -277, -1000,   385, -1000,   647, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,   -74, -1000,
+ -1000, -1000,   174, -1000, -1000,   163,  2552, -1000, -1000,   159,
+ -1000,   133,  2577, -1000,   372,  2527, -1000,   647,  1652,   311,
+ -1000,   647, -1000,   647,  1652, -1000,  -287,    92,   154,   147,
+   145,  1760, -1000,   703, -1000, -1000,  2552,  1975, -1000,   517,
+  2621, -1000,  -195,   781, -1000,   862,   143, -1000,   568, -1000,
+   270,   268, -1000, -1000, -1000,  1652, -1000,   971,   109,   498,
+  2034,  2034,  1760,  1999,  -122, -1000,   545,   542,   541, -1000,
+ -1000, -1000, -1000, -1000, -1000,   120, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,   979,   167,
+   735,   -91,   119,   -82,   571,   570, -1000,  1760, -1000,   702,
+ -1000, -1000,   171,   137,  2360,   -63, -1000, -1000, -1000, -1000,
+   171, -1000,    61,  2311,  2311,   732, -1000, -1000,   731,   169,
+   169,   169,   220, -1000, -1000, -1000,  1842, -1000,  1593, -1000,
+ -1000,   514, -1000,   540,  1760,   511, -1000, -1000,   539,  1760,
+  -195, -1000, -1000,   203, -1000,   266,   862,   123,   568,   808,
+ -1000, -1000, -1000,  -151, -1000, -1000,   538,  1760,   537,   133,
+ -1000, -1000, -1000, -1000,   730, -1000,   -74,   476,   723,   719,
+  1760,   718,   808,   717,   862,   470,   443,  1378,  1378,   441,
+   434,   632, -1000,   192, -1000,  1760, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000,  1760,  1760,  1760,
+  1617,   862,   862, -1000, -1000, -1000,  1760, -1000, -1000, -1000,
+   979,  1760,  -232,   136,   136,  1760,   673,   701,   647,  2552,
+  2552, -1000, -1000,  1760,  1760,  1760,  1760,  1760,  1760,  1760,
+  1760,  1760,  1760,  1760,  1760,  1760,  1760,  1760,   219,  1842,
+ -1000,  2357,  2505, -1000, -1000,  -280, -1000, -1000, -1000, -1000,
+   117,   171,   135,  -300,  -109,  -223, -1000,   536,   535,   534,
+  -309,   230,  -311,  2311,   133,   133,   -77,   116,   660, -1000,
+ -1000, -1000,   113, -1000,   700, -1000,   617, -1000, -1000,   615,
+ -1000,   647, -1000,  2577, -1000, -1000,   517, -1000, -1000, -1000,
+   499, -1000, -1000, -1000,   862,  1760,   185, -1000,   105, -1000,
+ -1000, -1000,   647, -1000,  2220,  2311,   808,   533,   808, -1000,
+  1760, -1000,  1760,  1760,     6,  1760,  -240,  1760,   432, -1000,
+ -1000, -1000,   425, -1000,  1760,  1760,  1760,   381, -1000, -1000,
+  1760, -1000,  1501, -1000,  -122,   489,   251, -1000,   643, -1000,
+ -1000, -1000,   699,   120,   716, -1000, -1000, -1000, -1000,   715,
+ -1000, -1000, -1000, -1000, -1000, -1000,  -258,   714,   167, -1000,
+  1760, -1000, -1000,   293, -1000, -1000,   735,   -91,   119,   119,
+   -82,   -82,   -82,   -82,   571,   571,   570,   570, -1000, -1000,
+ -1000, -1000,   697, -1000,  2434, -1000, -1000,  -263,   171,  -223,
+ -1000,  -232,   136,   136,   132,   -85,   131,   607, -1000, -1000,
+   639,   651, -1000,   169, -1000,   101,   651, -1000,  2311,  2455,
+ -1000, -1000,  2163, -1000,  1760, -1000,  1760, -1000, -1000, -1000,
+ -1000,   507, -1000, -1000, -1000, -1000,   808, -1000,   631,   629,
+   602,   128,   596,   713,   359, -1000, -1000, -1000, -1000, -1000,
+ -1000, -1000, -1000, -1000,  1760, -1000, -1000,  1760, -1000,  1760,
+  1760,   695,  1760, -1000,   275,   647,  1760, -1000, -1000, -1000,
+  -264,   138, -1000,   227,  -227, -1000,   712,   709,   708,  -232,
+   207,   -90,  2311,   291,  2311,   707, -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, -1000,
+ -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000,
+ -1000,   635,  -142, -1000, -1000, -1000, -1000,   647, -1000, -1000,
+ -1000, -1000,   348,  1760,   808,   808,  -232,   808,  1760,  1760,
+ -1000, -1000,   694,   603,  -257,   592,  1760, -1000,   692,  2577,
+   205,   100,   138, -1000,    49,   558, -1000,   706,  -232,   225,
+   138,   138,   171,  2311,  2311,  2311,  -237, -1000,   698,   529,
+ -1000,  -154, -1000,   528,   690, -1000, -1000,   689,  1874, -1000,
+ -1000, -1000,   688,  -228, -1000,  -248, -1000,  1260, -1000,   589,
+   294, -1000,  1760, -1000, -1000,  1760,   197,  2577, -1000,   687,
+ -1000, -1000,    49, -1000,   138,   138, -1000,  -278,  2311,   705,
+   138,   231,    65, -1000,   686,   583,   576,    99, -1000,   527,
+ -1000,   522, -1000,   520, -1000,   171,  -315,   291,   684,   276,
+ -1000, -1000,  2311,   651,   288,   808,    93, -1000,   513, -1000,
+ -1000, -1000, -1000, -1000,   283,  1760,   681,   561, -1000,   678,
+ -1000, -1000,   558,   558, -1000, -1000, -1000,   677,   138,    64,
+ -1000,   265, -1000, -1000,  1760,  1760, -1000,   171, -1000,   171,
+ -1000,   126, -1000, -1000,  2311,  1874,   -96,   661, -1000, -1000,
+ -1000,  1138, -1000,   674, -1000,  1760, -1000, -1000,   578,  -104,
+ -1000,   138,   672,   574, -1000,    87,   136,   195, -1000,  2311,
+  1874, -1000,   808,   656, -1000,   138,    49, -1000, -1000,  1760,
+ -1000,   509, -1000, -1000,   652, -1000, -1000,  -104, -1000,   644,
+   171, -1000, -1000,   136,   506,   171,   136,   479,   171,    85,
+ -1000 };
+int yypgo[]={
+
+     0,  1046,  1045,  1044,    13,     0,    10,  1042,  1041,  1040,
+   257,    65,  2308,  1039,  1037,  1036,    55,    36,   142,   167,
+   194,   147,   143,   145,   102,   155,   174,  1035,    74,     5,
+    48,    15,    49,    25,   539,    28,  1029,    59,  1028,    18,
+    37,  1027,   400,   287,  1026,  2770,  1023,   214,   231,  1020,
+   201,  1018,  1014,    40,   991,    46,   965,   228,    39,    52,
+    32,   943,   942,    77,   159,   259,   940,    24,   939,    27,
+   938,   132,   137,    43,   937,    38,   936,     6,   935,    89,
+   932,   931,   917,   916,   915,   886,   882,    86,   860,   197,
+    78,    34,     2,    22,   859,   360,     4,   203,   857,   856,
+    11,   855,   183,   854,   852,   849,    17,    33,   847,    14,
+   845,     8,   844,    41,   843,    20,   842,   840,    26,     1,
+    12,   837,    23,    30,   824,   822,   818,   817,   814,   813,
+   812,   811,   810,   809,   808,   807,   776,   804,   803,   802,
+   801,   796,   795,   794,   792,   788,   308,     7,   787,   786,
+   785,     9,   784,   782,   778,   774,     3 };
+int yyr1[]={
+
+     0,    13,    13,    13,    13,    13,    13,    13,    13,    13,
+    13,    13,    13,    13,    14,    14,    14,    14,    14,    14,
+    14,    14,    14,    14,    14,    15,    15,    16,    16,    16,
+    16,    16,    16,     1,     1,     1,     1,     1,     1,    17,
+    17,    18,    18,    18,    18,    19,    19,    19,    20,    20,
+    20,    21,    21,    21,    21,    21,    22,    22,    22,    23,
+    23,    24,    24,    25,    25,    26,    26,    27,    27,    28,
+    28,    29,    29,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,    30,    30,    31,    31,    32,    33,
+    33,    34,    34,    34,    35,    35,    36,    36,    37,    37,
+    37,    38,    38,    38,    38,    39,    39,    39,    39,    40,
+    40,    41,    41,    42,    42,    43,    43,    11,    11,    11,
+    11,    11,    44,    44,    45,    45,    45,    45,    45,    45,
+    45,    45,    45,    45,    45,    46,    46,    46,     3,     3,
+    47,    47,    48,    48,    49,    49,    50,    50,    50,    51,
+    51,    51,    52,    52,    53,    53,   125,    53,    54,    54,
+    55,    55,   126,    55,   127,    56,   128,    56,    56,    57,
+    57,    58,    58,    12,    12,    59,    60,    61,    61,    61,
+   129,    61,    62,    62,    62,   130,    62,    87,    87,    63,
+    63,    63,    63,    64,    64,    65,    65,    66,    66,    67,
+    67,    68,    68,    69,    69,    69,    70,    70,    71,    71,
+    71,    71,    72,    72,    73,    73,    74,    74,    74,   131,
+    74,   132,    74,    75,    75,    75,    76,    76,    77,    77,
+   133,   111,   111,   111,   111,   111,   111,   111,    78,    78,
+    78,    79,    79,    80,    80,    81,    81,    90,    90,    91,
+    91,   134,   134,   134,   134,    82,    82,    89,    89,    83,
+    84,    84,    84,    84,   110,   110,   109,   108,   108,    85,
+    85,    85,    86,    86,    86,    86,    86,    86,    86,   124,
+   124,   135,   135,   136,   136,   136,   139,   137,    88,    88,
+    88,    10,    10,   102,   102,     4,     4,     4,     4,   140,
+   138,   142,   142,   142,   141,   141,   143,   148,   149,   143,
+   145,     7,     7,     7,     7,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     5,     5,     5,     5,     5,
+     5,     5,     5,     5,     5,     5,     5,     5,     6,     6,
+     6,     6,     6,     6,     6,     6,     6,     6,     6,     6,
+     6,     6,     6,     6,     6,     6,     6,     6,     6,     6,
+     6,     6,     6,     6,     6,     6,     6,     6,     6,     6,
+     6,     6,     6,     6,     6,     6,     6,     6,     6,     6,
+     6,     6,     6,   146,   146,   146,   123,   123,   122,   122,
+   147,   147,   147,   150,   150,   151,   151,   151,   144,   144,
+    94,    94,    95,    95,    96,    96,    96,    96,   152,   153,
+    96,   101,   101,   101,   101,   101,   104,   104,   106,   105,
+   105,   107,   107,   114,   114,   115,   103,   103,   112,   112,
+   113,   113,   113,   113,   113,   154,    98,   155,    98,    99,
+    99,   156,   156,   100,   100,    92,    92,    92,    92,    92,
+    92,    92,    92,    93,    93,    93,    93,    97,    97,    97,
+    97,   116,   116,   116,   117,   117,   118,   119,   119,   119,
+   120,   120,   120,   120,   120,   120,     8,   121,   121,     9,
+     9 };
+int yyr2[]={
+
+     0,     3,     3,     3,     3,     3,     3,     3,     3,     3,
+     3,     3,     3,     7,     2,     9,     7,     9,     7,     7,
+     5,     5,    13,    17,    21,     2,     7,     2,     5,     5,
+     5,     5,     9,     2,     2,     2,     2,     2,     2,     2,
+     9,     2,     7,     7,     7,     2,     7,     7,     2,     7,
+     7,     2,     7,     7,     7,     7,     2,     7,     7,     2,
+     7,     2,     7,     2,     7,     2,     7,     2,     7,     2,
+    11,     2,     7,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     7,     1,     2,     2,     1,
+     2,     5,     7,     7,     2,     5,     2,     2,     3,     5,
+     2,     2,     5,     5,     5,     2,     2,     5,     5,     2,
+     7,     2,     7,     3,     7,     3,     7,     3,     3,     3,
+     3,     3,     2,     3,     3,     3,     3,     3,     3,     3,
+     3,     3,     3,     2,     2,    11,     9,     5,     2,     2,
+     2,     5,     7,     7,     2,     5,     3,     5,     2,     2,
+     5,     5,     2,     7,     3,     5,     1,     9,     2,     7,
+     3,     5,     1,     9,     1,    11,     1,    13,     5,     2,
+     7,     3,     7,     3,     3,     5,     5,     2,     7,     9,
+     1,    11,     3,     7,     9,     1,    11,     2,     2,     3,
+     5,     5,     7,     1,     2,     2,     5,     2,     7,     1,
+     2,     2,     7,     5,     2,     5,     3,     7,     2,     2,
+     5,     5,     2,     5,     2,     5,     7,     7,     9,     1,
+     9,     1,    11,     2,     7,     9,     2,     7,     2,     2,
+     1,     5,     2,     2,     2,     2,    11,    15,     7,     9,
+     7,     7,     9,     2,     5,     1,     2,     2,     5,     2,
+     9,     3,     5,     5,     5,     2,     5,     1,     2,     5,
+    11,    15,    11,    15,     3,     5,     5,     1,     7,    11,
+    15,    19,     7,     5,     5,     7,     7,     5,     5,     0,
+     2,     2,     4,     2,     3,     2,     1,     9,     3,     5,
+     5,     3,     3,     3,     3,     2,     2,     2,     2,     1,
+     6,     9,     7,     9,     1,     3,    17,     1,     1,    23,
+    11,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     2,     2,     2,     1,     5,     9,     3,     3,     1,     3,
+     0,     2,     9,     2,     7,     3,     5,     9,     1,     9,
+     1,     2,     2,     5,     2,     2,     2,     7,     1,     1,
+    13,     9,    13,    15,    19,    37,     3,     5,     5,     1,
+     7,     5,     7,     2,     5,     7,     2,     5,     2,     7,
+    13,    13,    17,    17,    21,     1,     7,     1,     7,    11,
+    15,     0,     3,     3,     9,     3,     3,     3,     3,     3,
+     3,     9,     9,     3,     3,     3,     3,     2,     5,     5,
+     5,     9,     7,     3,     2,     5,    15,     2,     7,     7,
+     3,     9,    11,     9,     7,     7,     2,     2,     7,     2,
+     2 };
+int yychk[]={
+
+ -1000,  -124,  -135,  -136,  -137,   -34,  -138,   -88,   -35,   -39,
+  -140,   -60,   -37,   -11,   -12,   -64,    -4,   -38,   293,   294,
+   295,   296,   297,   307,   308,   -63,   310,   339,   341,   342,
+   -45,    42,   309,   299,   300,   301,   302,   305,   306,   303,
+   304,   -46,   -56,    -3,   313,   311,   312,  -136,  -139,    59,
+   -40,   -59,   -42,   -64,   -41,   -37,   -11,   -12,   -60,   -43,
+  -141,   258,   -62,    -5,    40,   355,   359,   336,   345,   334,
+   351,   332,   346,   331,   333,   257,   354,   337,   358,   362,
+   356,   338,   360,   344,   343,   357,   350,   335,   -39,   -45,
+   -11,   -12,   -65,   -63,   -12,   -10,   123,    -5,    -4,  -127,
+   -10,   -81,   -80,   -34,   -35,   -39,    59,    44,    61,   -61,
+   -10,    40,    59,    44,    61,  -142,  -143,  -145,   347,   349,
+   348,    91,    40,   -60,   -63,   -12,   123,   -47,   -48,   -49,
+   -65,   -50,    -4,   -51,   -45,   123,  -128,   -79,   123,   -34,
+   -59,   -60,   -42,   -75,   -29,   123,   -28,   -16,   -27,   -14,
+   270,   271,    -1,   290,   -26,   -13,   328,   329,   330,    38,
+    42,    43,    45,   126,    33,   -25,    -5,   258,   259,   260,
+   261,   262,   263,   264,   265,   266,   267,   268,    40,   -24,
+   -23,   -22,   -21,   -20,   -19,   -18,   -17,    91,    40,   -59,
+   -43,   -75,  -144,   351,   -95,   364,   -96,  -101,   -98,   -99,
+   123,   355,   317,   361,   363,   340,   345,   354,   327,   123,
+   123,   123,   -33,   -32,   -28,   -16,  -130,    41,   -47,   125,
+   -48,   -52,   -53,   -59,    58,   -54,   -50,   -55,   -60,    58,
+   -65,   -45,   -12,   -57,   -58,   -10,   123,   -89,   -90,   -82,
+   -91,   -77,   -34,   298,   -78,  -111,  -102,   315,   316,  -133,
+   -83,   -84,   -85,   -86,   327,    -5,    -4,   -31,   317,   319,
+   361,   320,   321,   322,   323,   324,   325,   326,   352,   353,
+   365,   -30,   -29,   -76,   -75,    -2,    61,   280,   281,   282,
+   283,   284,   285,   286,   287,   288,   289,   279,    63,    91,
+    40,    46,   269,   270,   271,   -16,    40,   -16,   -17,   -16,
+    40,   278,    58,    58,    58,   124,   -30,   -72,   -71,   -44,
+   -12,   -45,    -4,    94,    38,   276,   277,    60,    62,   274,
+   275,   272,   273,    43,    45,    42,    47,    37,   -33,  -129,
+    41,   -95,   123,   346,   -96,    -7,   258,   263,   261,   265,
+   -94,   -95,  -152,  -103,  -112,    33,  -113,   328,   329,   330,
+  -100,    -5,    -5,    40,  -154,  -155,    40,  -146,  -123,   265,
+    42,  -146,  -146,    93,   -87,   -67,   -70,   -66,    -5,   -68,
+   -69,   -36,   -35,   -39,   125,    59,    44,    58,   -32,    59,
+    44,    58,   -32,   125,    44,    61,   -57,   125,   -89,   -91,
+   -77,    -4,  -134,   299,   311,   312,    58,   -32,    58,   -79,
+    40,    59,    40,    40,   -30,    40,   -77,    40,  -102,    -5,
+    59,    59,   -97,   -31,   339,   341,   342,   -97,    59,    59,
+    44,   125,    44,   -29,   -26,   -30,   -30,    41,   -15,   -29,
+   -10,   -10,   -72,   -25,   -93,   336,   332,   333,   335,   -92,
+   333,   339,   341,   342,   343,   344,    40,   -92,   -24,    41,
+    41,   -73,   -63,   -64,   -71,   -71,   -23,   -22,   -21,   -21,
+   -20,   -20,   -20,   -20,   -19,   -19,   -18,   -18,   -17,   -17,
+   -17,    93,   -87,   346,   -90,   346,   125,   123,   360,   278,
+  -113,    58,    58,    58,   362,    91,   362,  -100,   -79,   -79,
+   265,   125,  -122,    44,    43,  -148,   125,    41,    44,    44,
+   -60,   -73,   -64,   -53,  -125,   -55,  -126,   -58,   -32,   125,
+   125,   -40,    -5,   310,    -5,   -77,    58,   -77,   -29,   -30,
+   -30,   362,   -30,   320,   -31,    59,    59,   -29,   -29,   -29,
+    59,   -29,   125,   -75,    58,    93,    41,    44,    41,    40,
+    40,   331,    40,   -17,   -74,    40,    91,    41,   125,  -116,
+  -117,   326,  -118,   356,   -96,  -113,   -93,   -92,   -92,   123,
+   265,   123,    44,    41,    44,    -6,    -5,    -4,   296,   325,
+   315,   299,   329,   307,   324,   330,   316,   321,   306,   318,
+   313,   365,   294,   353,   305,   322,   347,   323,   317,   301,
+   328,   348,   302,   349,   297,   326,   327,   300,   303,   290,
+   295,   311,   352,   319,   298,   293,   312,   304,   309,   308,
+   320,  -123,   125,    -6,    -5,   314,   -69,    40,   -32,   -32,
+    59,   -77,    41,    44,    41,    41,   123,    41,    40,    59,
+   -28,   -29,   -29,   -29,    41,   -29,    91,    40,   -73,  -131,
+   -33,  -153,   326,  -118,  -119,  -120,   -93,   357,   358,   356,
+    40,    91,   318,    40,    40,    40,  -104,  -106,  -107,   -93,
+    93,  -114,  -115,   265,  -100,  -156,    59,  -100,    40,  -122,
+   292,    59,   -29,   -77,   -77,  -110,  -109,  -107,   -77,   -30,
+   -31,    41,    44,   333,   339,    44,   -33,  -132,    41,   -67,
+    93,   125,  -119,  -156,    -8,   291,   270,    46,    40,   -93,
+    91,  -119,  -119,   -96,  -100,  -100,  -100,  -105,  -106,   316,
+   -96,   -93,    58,   316,  -115,    58,    41,    41,  -147,  -150,
+  -151,    -5,   350,  -149,    41,   318,  -108,  -109,   316,  -111,
+   336,   332,   333,   335,    41,    59,   -29,   -29,    93,   -67,
+    41,  -156,  -120,  -120,    -9,   334,   359,  -100,    40,  -119,
+    41,    93,    41,    41,    44,    44,   125,    58,    58,    58,
+   -96,   362,  -156,    41,    91,    44,    -5,    -6,    59,   -77,
+   125,    58,    59,   -31,    41,    44,    41,    41,  -121,  -119,
+    93,    61,   -29,   -29,   -96,   -96,   123,    -5,  -151,   269,
+    40,  -111,    41,   -29,    41,    44,  -119,    41,    41,    44,
+   125,   -92,    93,    -5,  -147,   -77,    41,  -119,  -156,   -29,
+    58,    41,    41,   -96,   -92,    58,   -96,   -92,    58,   -96,
+   125 };
+int yydef[]={
+
+    -2,    -2,    -2,   281,   283,   284,   285,   286,   193,   193,
+   304,   288,    94,   105,   106,     0,    98,   100,   117,   118,
+   119,   120,   121,   173,   174,   194,   295,   296,   297,   298,
+   101,   189,   124,   125,   126,   127,   128,   129,   130,   131,
+   132,   133,   134,     0,   164,   138,   139,   282,   245,    91,
+     0,    -2,   109,     0,     0,    95,   107,   108,    -2,   111,
+     0,   305,   176,   182,   193,   315,   316,   317,   318,   319,
+   320,   321,   322,   323,   324,   325,   326,   327,   328,   329,
+   330,   331,   332,   333,   334,   335,   336,   337,    99,   102,
+   103,   104,   190,   191,   195,   137,     0,   291,   292,     0,
+    -2,     0,   246,   243,   193,   193,    92,   193,     0,   175,
+   177,   193,    93,   193,     0,   300,   398,     0,     0,     0,
+     0,    89,   185,     0,   192,   196,     0,     0,   140,   193,
+   193,   144,   146,   148,   149,     0,     0,   287,    -2,   244,
+   113,   115,   110,   114,   223,     0,    71,    39,    69,    27,
+     0,     0,     0,     0,    67,    14,     0,     0,     0,    33,
+    34,    35,    36,    37,    38,    65,     1,     2,     3,     4,
+     5,     6,     7,     8,     9,    10,    11,    12,     0,    63,
+    61,    59,    56,    51,    48,    45,    41,    89,   180,     0,
+   112,   116,     0,     0,     0,     0,   402,   404,   405,   406,
+   400,   408,     0,     0,     0,     0,   435,   437,     0,   383,
+   383,   383,     0,    90,    88,    39,   199,   183,     0,   136,
+   141,     0,   152,   154,     0,     0,   145,   158,   160,     0,
+   147,   150,   151,     0,   169,   171,     0,     0,    -2,    -2,
+   247,   255,   249,     0,   228,   229,     0,     0,     0,     0,
+   232,   233,   234,   235,     0,    -2,    -2,     0,     0,     0,
+     0,     0,    -2,     0,     0,     0,     0,    86,    86,     0,
+     0,    87,    84,     0,   226,     0,    73,    74,    75,    76,
+    77,    78,    79,    80,    81,    82,    83,     0,     0,     0,
+     0,     0,     0,    20,    21,    28,     0,    29,    30,    31,
+     0,     0,     0,     0,     0,     0,     0,     0,    -2,   208,
+   209,   122,   123,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,   199,
+   178,     0,     0,   302,   403,     0,   311,   312,   313,   314,
+     0,   401,     0,     0,   426,     0,   428,     0,     0,     0,
+     0,   443,     0,     0,     0,     0,     0,     0,   388,   386,
+   387,   307,     0,   184,     0,   187,   188,   200,   206,   197,
+   201,    -2,    96,    97,   135,   142,   193,   156,   155,   143,
+   193,   162,   161,   165,     0,     0,     0,   241,     0,   248,
+   256,   294,   193,   251,     0,     0,    -2,     0,    -2,   231,
+     0,   259,     0,     0,     0,     0,     0,    86,     0,   293,
+   273,   274,     0,   457,     0,     0,     0,     0,   277,   278,
+     0,   224,     0,    72,    68,     0,     0,    16,     0,    25,
+    18,    19,     0,    66,     0,   453,   454,   455,   456,     0,
+   445,   446,   447,   448,   449,   450,     0,     0,    64,    13,
+     0,   213,    -2,     0,   210,   211,    62,    60,    57,    58,
+    52,    53,    54,    55,    49,    50,    46,    47,    42,    43,
+    44,   179,     0,   301,     0,   303,   407,     0,     0,     0,
+   427,     0,     0,     0,     0,     0,     0,     0,   436,   438,
+     0,     0,   384,     0,   389,     0,     0,   186,     0,     0,
+   203,   205,     0,   153,     0,   159,     0,   170,   172,   167,
+   242,     0,   252,   253,   254,   238,    -2,   240,     0,     0,
+     0,     0,     0,     0,     0,   272,   275,   458,   459,   460,
+   276,    85,   225,   227,     0,    15,    17,     0,    32,     0,
+     0,     0,     0,    40,   215,    -2,    89,   181,   399,   409,
+   463,     0,   464,     0,   411,   429,     0,     0,     0,     0,
+     0,     0,     0,   441,     0,     0,   338,   339,   340,   341,
+   342,   343,   344,   345,   346,   347,   348,   349,   350,   351,
+   352,   353,   354,   355,   356,   357,   358,   359,   360,   361,
+   362,   363,   364,   365,   366,   367,   368,   369,   370,   371,
+   372,   373,   374,   375,   376,   377,   378,   379,   380,   381,
+   382,   388,     0,   310,   207,   198,   202,    -2,   157,   163,
+   250,   239,     0,     0,    -2,    -2,     0,    -2,     0,    86,
+    70,    26,     0,     0,     0,     0,    89,   221,     0,   199,
+     0,     0,     0,   465,   441,   467,   470,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,   419,   416,     0,     0,
+   444,     0,   423,     0,     0,   439,   442,     0,   390,   385,
+   308,   236,     0,   260,   262,   267,   264,    -2,   269,     0,
+     0,    22,     0,   451,   452,     0,     0,   199,   216,     0,
+   217,   410,   441,   462,     0,     0,   476,     0,     0,     0,
+     0,     0,     0,   412,     0,     0,     0,     0,   417,     0,
+   418,     0,   421,     0,   424,     0,     0,   441,     0,   391,
+   393,   395,   336,     0,     0,    -2,     0,   265,     0,   266,
+    -2,    -2,    -2,    -2,     0,    86,     0,     0,   218,     0,
+   220,   461,   468,   469,   474,   479,   480,     0,     0,     0,
+   475,     0,   430,   431,     0,     0,   413,     0,   422,     0,
+   425,     0,   440,   306,     0,     0,   396,     0,   237,   261,
+   263,    -2,   270,     0,    23,     0,   222,   471,     0,   477,
+   473,     0,     0,     0,   420,     0,     0,     0,   394,     0,
+   390,   268,    -2,     0,   472,     0,   441,   432,   433,     0,
+   414,     0,   392,   397,     0,   271,    24,   478,   466,     0,
+     0,   309,   434,     0,     0,     0,     0,     0,     0,     0,
+   415 };
+typedef struct { char *t_name; int t_val; } yytoktype;
+#ifndef YYDEBUG
+#	define YYDEBUG	0	/* don't allow debugging */
+#endif
+
+#if YYDEBUG
+
+yytoktype yytoks[] =
+{
+	"Identifier",	257,
+	"StrLit",	258,
+	"LStrLit",	259,
+	"FltConst",	260,
+	"DblConst",	261,
+	"LDblConst",	262,
+	"CharConst",	263,
+	"LCharConst",	264,
+	"IntConst",	265,
+	"UIntConst",	266,
+	"LIntConst",	267,
+	"ULIntConst",	268,
+	"Arrow",	269,
+	"Incr",	270,
+	"Decr",	271,
+	"LShft",	272,
+	"RShft",	273,
+	"Leq",	274,
+	"Geq",	275,
+	"Equal",	276,
+	"Neq",	277,
+	"And",	278,
+	"Or",	279,
+	"MultAsgn",	280,
+	"DivAsgn",	281,
+	"ModAsgn",	282,
+	"PlusAsgn",	283,
+	"MinusAsgn",	284,
+	"LShftAsgn",	285,
+	"RShftAsgn",	286,
+	"AndAsgn",	287,
+	"XorAsgn",	288,
+	"OrAsgn",	289,
+	"Sizeof",	290,
+	"Intersect",	291,
+	"OpSym",	292,
+	"Typedef",	293,
+	"Extern",	294,
+	"Static",	295,
+	"Auto",	296,
+	"Register",	297,
+	"Tended",	298,
+	"Char",	299,
+	"Short",	300,
+	"Int",	301,
+	"Long",	302,
+	"Signed",	303,
+	"Unsigned",	304,
+	"Float",	305,
+	"Doubl",	306,
+	"Const",	307,
+	"Volatile",	308,
+	"Void",	309,
+	"TypeDefName",	310,
+	"Struct",	311,
+	"Union",	312,
+	"Enum",	313,
+	"Ellipsis",	314,
+	"Case",	315,
+	"Default",	316,
+	"If",	317,
+	"Else",	318,
+	"Switch",	319,
+	"While",	320,
+	"Do",	321,
+	"For",	322,
+	"Goto",	323,
+	"Continue",	324,
+	"Break",	325,
+	"Return",	326,
+	"%",	37,
+	"&",	38,
+	"(",	40,
+	")",	41,
+	"*",	42,
+	"+",	43,
+	",",	44,
+	"-",	45,
+	".",	46,
+	"/",	47,
+	"{",	123,
+	"|",	124,
+	"}",	125,
+	"~",	126,
+	"[",	91,
+	"]",	93,
+	"^",	94,
+	":",	58,
+	";",	59,
+	"<",	60,
+	"=",	61,
+	">",	62,
+	"?",	63,
+	"!",	33,
+	"@",	64,
+	"\\",	92,
+	"Runerr",	327,
+	"Is",	328,
+	"Cnv",	329,
+	"Def",	330,
+	"Exact",	331,
+	"Empty_type",	332,
+	"IconType",	333,
+	"Component",	334,
+	"Variable",	335,
+	"Any_value",	336,
+	"Named_var",	337,
+	"Struct_var",	338,
+	"C_Integer",	339,
+	"Arith_case",	340,
+	"C_Double",	341,
+	"C_String",	342,
+	"Tmp_string",	343,
+	"Tmp_cset",	344,
+	"Body",	345,
+	"End",	346,
+	"Function",	347,
+	"Keyword",	348,
+	"Operator",	349,
+	"Underef",	350,
+	"Declare",	351,
+	"Suspend",	352,
+	"Fail",	353,
+	"Inline",	354,
+	"Abstract",	355,
+	"Store",	356,
+	"Type",	357,
+	"New",	358,
+	"All_fields",	359,
+	"Then",	360,
+	"Type_case",	361,
+	"Of",	362,
+	"Len_case",	363,
+	"Constant",	364,
+	"Errorfail",	365,
+	"IfStmt",	366,
+	"-unknown-",	-1	/* ends search */
+};
+
+char * yyreds[] =
+{
+	"-no such reduction-",
+	"primary_expr : identifier",
+	"primary_expr : StrLit",
+	"primary_expr : LStrLit",
+	"primary_expr : FltConst",
+	"primary_expr : DblConst",
+	"primary_expr : LDblConst",
+	"primary_expr : CharConst",
+	"primary_expr : LCharConst",
+	"primary_expr : IntConst",
+	"primary_expr : UIntConst",
+	"primary_expr : LIntConst",
+	"primary_expr : ULIntConst",
+	"primary_expr : '(' expr ')'",
+	"postfix_expr : primary_expr",
+	"postfix_expr : postfix_expr '[' expr ']'",
+	"postfix_expr : postfix_expr '(' ')'",
+	"postfix_expr : postfix_expr '(' arg_expr_lst ')'",
+	"postfix_expr : postfix_expr '.' any_ident",
+	"postfix_expr : postfix_expr Arrow any_ident",
+	"postfix_expr : postfix_expr Incr",
+	"postfix_expr : postfix_expr Decr",
+	"postfix_expr : Is ':' i_type_name '(' assign_expr ')'",
+	"postfix_expr : Cnv ':' dest_type '(' assign_expr ',' assign_expr ')'",
+	"postfix_expr : Def ':' dest_type '(' assign_expr ',' assign_expr ',' assign_expr ')'",
+	"arg_expr_lst : assign_expr",
+	"arg_expr_lst : arg_expr_lst ',' assign_expr",
+	"unary_expr : postfix_expr",
+	"unary_expr : Incr unary_expr",
+	"unary_expr : Decr unary_expr",
+	"unary_expr : unary_op cast_expr",
+	"unary_expr : Sizeof unary_expr",
+	"unary_expr : Sizeof '(' type_name ')'",
+	"unary_op : '&'",
+	"unary_op : '*'",
+	"unary_op : '+'",
+	"unary_op : '-'",
+	"unary_op : '~'",
+	"unary_op : '!'",
+	"cast_expr : unary_expr",
+	"cast_expr : '(' type_name ')' cast_expr",
+	"multiplicative_expr : cast_expr",
+	"multiplicative_expr : multiplicative_expr '*' cast_expr",
+	"multiplicative_expr : multiplicative_expr '/' cast_expr",
+	"multiplicative_expr : multiplicative_expr '%' cast_expr",
+	"additive_expr : multiplicative_expr",
+	"additive_expr : additive_expr '+' multiplicative_expr",
+	"additive_expr : additive_expr '-' multiplicative_expr",
+	"shift_expr : additive_expr",
+	"shift_expr : shift_expr LShft additive_expr",
+	"shift_expr : shift_expr RShft additive_expr",
+	"relational_expr : shift_expr",
+	"relational_expr : relational_expr '<' shift_expr",
+	"relational_expr : relational_expr '>' shift_expr",
+	"relational_expr : relational_expr Leq shift_expr",
+	"relational_expr : relational_expr Geq shift_expr",
+	"equality_expr : relational_expr",
+	"equality_expr : equality_expr Equal relational_expr",
+	"equality_expr : equality_expr Neq relational_expr",
+	"and_expr : equality_expr",
+	"and_expr : and_expr '&' equality_expr",
+	"exclusive_or_expr : and_expr",
+	"exclusive_or_expr : exclusive_or_expr '^' and_expr",
+	"inclusive_or_expr : exclusive_or_expr",
+	"inclusive_or_expr : inclusive_or_expr '|' exclusive_or_expr",
+	"logical_and_expr : inclusive_or_expr",
+	"logical_and_expr : logical_and_expr And inclusive_or_expr",
+	"logical_or_expr : logical_and_expr",
+	"logical_or_expr : logical_or_expr Or logical_and_expr",
+	"conditional_expr : logical_or_expr",
+	"conditional_expr : logical_or_expr '?' expr ':' conditional_expr",
+	"assign_expr : conditional_expr",
+	"assign_expr : unary_expr assign_op assign_expr",
+	"assign_op : '='",
+	"assign_op : MultAsgn",
+	"assign_op : DivAsgn",
+	"assign_op : ModAsgn",
+	"assign_op : PlusAsgn",
+	"assign_op : MinusAsgn",
+	"assign_op : LShftAsgn",
+	"assign_op : RShftAsgn",
+	"assign_op : AndAsgn",
+	"assign_op : XorAsgn",
+	"assign_op : OrAsgn",
+	"expr : assign_expr",
+	"expr : expr ',' assign_expr",
+	"opt_expr : /* empty */",
+	"opt_expr : expr",
+	"constant_expr : conditional_expr",
+	"opt_constant_expr : /* empty */",
+	"opt_constant_expr : constant_expr",
+	"dcltion : typ_dcltion_specs ';'",
+	"dcltion : typ_dcltion_specs init_dcltor_lst ';'",
+	"dcltion : storcl_tqual_lst no_tdn_init_dcltor_lst ';'",
+	"typ_dcltion_specs : type_ind",
+	"typ_dcltion_specs : storcl_tqual_lst type_ind",
+	"dcltion_specs : typ_dcltion_specs",
+	"dcltion_specs : storcl_tqual_lst",
+	"type_ind : typedefname",
+	"type_ind : typedefname storcl_tqual_lst",
+	"type_ind : type_storcl_tqual_lst",
+	"type_storcl_tqual_lst : stnd_type",
+	"type_storcl_tqual_lst : type_storcl_tqual_lst stnd_type",
+	"type_storcl_tqual_lst : type_storcl_tqual_lst storage_class_spec",
+	"type_storcl_tqual_lst : type_storcl_tqual_lst type_qual",
+	"storcl_tqual_lst : storage_class_spec",
+	"storcl_tqual_lst : type_qual",
+	"storcl_tqual_lst : storcl_tqual_lst storage_class_spec",
+	"storcl_tqual_lst : storcl_tqual_lst type_qual",
+	"init_dcltor_lst : init_dcltor",
+	"init_dcltor_lst : init_dcltor_lst ',' init_dcltor",
+	"no_tdn_init_dcltor_lst : no_tdn_init_dcltor",
+	"no_tdn_init_dcltor_lst : no_tdn_init_dcltor_lst ',' no_tdn_init_dcltor",
+	"init_dcltor : dcltor",
+	"init_dcltor : dcltor '=' initializer",
+	"no_tdn_init_dcltor : no_tdn_dcltor",
+	"no_tdn_init_dcltor : no_tdn_dcltor '=' initializer",
+	"storage_class_spec : Typedef",
+	"storage_class_spec : Extern",
+	"storage_class_spec : Static",
+	"storage_class_spec : Auto",
+	"storage_class_spec : Register",
+	"type_spec : stnd_type",
+	"type_spec : typedefname",
+	"stnd_type : Void",
+	"stnd_type : Char",
+	"stnd_type : Short",
+	"stnd_type : Int",
+	"stnd_type : Long",
+	"stnd_type : Float",
+	"stnd_type : Doubl",
+	"stnd_type : Signed",
+	"stnd_type : Unsigned",
+	"stnd_type : struct_or_union_spec",
+	"stnd_type : enum_spec",
+	"struct_or_union_spec : struct_or_union any_ident '{' struct_dcltion_lst '}'",
+	"struct_or_union_spec : struct_or_union '{' struct_dcltion_lst '}'",
+	"struct_or_union_spec : struct_or_union any_ident",
+	"struct_or_union : Struct",
+	"struct_or_union : Union",
+	"struct_dcltion_lst : struct_dcltion",
+	"struct_dcltion_lst : struct_dcltion_lst struct_dcltion",
+	"struct_dcltion : struct_dcltion_specs struct_dcltor_lst ';'",
+	"struct_dcltion : tqual_lst struct_no_tdn_dcltor_lst ';'",
+	"struct_dcltion_specs : struct_type_ind",
+	"struct_dcltion_specs : tqual_lst struct_type_ind",
+	"struct_type_ind : typedefname",
+	"struct_type_ind : typedefname tqual_lst",
+	"struct_type_ind : struct_type_lst",
+	"struct_type_lst : stnd_type",
+	"struct_type_lst : struct_type_lst stnd_type",
+	"struct_type_lst : struct_type_lst type_qual",
+	"struct_dcltor_lst : struct_dcltor",
+	"struct_dcltor_lst : struct_dcltor_lst ',' struct_dcltor",
+	"struct_dcltor : dcltor",
+	"struct_dcltor : ':' constant_expr",
+	"struct_dcltor : dcltor ':'",
+	"struct_dcltor : dcltor ':' constant_expr",
+	"struct_no_tdn_dcltor_lst : struct_no_tdn_dcltor",
+	"struct_no_tdn_dcltor_lst : struct_no_tdn_dcltor_lst ',' struct_no_tdn_dcltor",
+	"struct_no_tdn_dcltor : no_tdn_dcltor",
+	"struct_no_tdn_dcltor : ':' constant_expr",
+	"struct_no_tdn_dcltor : no_tdn_dcltor ':'",
+	"struct_no_tdn_dcltor : no_tdn_dcltor ':' constant_expr",
+	"enum_spec : Enum",
+	"enum_spec : Enum '{' enumerator_lst '}'",
+	"enum_spec : Enum any_ident",
+	"enum_spec : Enum any_ident '{' enumerator_lst '}'",
+	"enum_spec : Enum any_ident",
+	"enumerator_lst : enumerator",
+	"enumerator_lst : enumerator_lst ',' enumerator",
+	"enumerator : any_ident",
+	"enumerator : any_ident '=' constant_expr",
+	"type_qual : Const",
+	"type_qual : Volatile",
+	"dcltor : opt_pointer direct_dcltor",
+	"no_tdn_dcltor : opt_pointer no_tdn_direct_dcltor",
+	"direct_dcltor : any_ident",
+	"direct_dcltor : '(' dcltor ')'",
+	"direct_dcltor : direct_dcltor '[' opt_constant_expr ']'",
+	"direct_dcltor : direct_dcltor '('",
+	"direct_dcltor : direct_dcltor '(' parm_dcls_or_ids ')'",
+	"no_tdn_direct_dcltor : identifier",
+	"no_tdn_direct_dcltor : '(' no_tdn_dcltor ')'",
+	"no_tdn_direct_dcltor : no_tdn_direct_dcltor '[' opt_constant_expr ']'",
+	"no_tdn_direct_dcltor : no_tdn_direct_dcltor '('",
+	"no_tdn_direct_dcltor : no_tdn_direct_dcltor '(' parm_dcls_or_ids ')'",
+	"parm_dcls_or_ids : opt_param_type_lst",
+	"parm_dcls_or_ids : ident_lst",
+	"pointer : '*'",
+	"pointer : '*' tqual_lst",
+	"pointer : '*' pointer",
+	"pointer : '*' tqual_lst pointer",
+	"opt_pointer : /* empty */",
+	"opt_pointer : pointer",
+	"tqual_lst : type_qual",
+	"tqual_lst : tqual_lst type_qual",
+	"param_type_lst : param_lst",
+	"param_type_lst : param_lst ',' Ellipsis",
+	"opt_param_type_lst : /* empty */",
+	"opt_param_type_lst : param_type_lst",
+	"param_lst : param_dcltion",
+	"param_lst : param_lst ',' param_dcltion",
+	"param_dcltion : dcltion_specs no_tdn_dcltor",
+	"param_dcltion : dcltion_specs",
+	"param_dcltion : dcltion_specs abstract_dcltor",
+	"ident_lst : identifier",
+	"ident_lst : ident_lst ',' identifier",
+	"type_tqual_lst : type_spec",
+	"type_tqual_lst : type_qual",
+	"type_tqual_lst : type_spec type_tqual_lst",
+	"type_tqual_lst : type_qual type_tqual_lst",
+	"type_name : type_tqual_lst",
+	"type_name : type_tqual_lst abstract_dcltor",
+	"abstract_dcltor : pointer",
+	"abstract_dcltor : opt_pointer direct_abstract_dcltor",
+	"direct_abstract_dcltor : '(' abstract_dcltor ')'",
+	"direct_abstract_dcltor : '[' opt_constant_expr ']'",
+	"direct_abstract_dcltor : direct_abstract_dcltor '[' opt_constant_expr ']'",
+	"direct_abstract_dcltor : '('",
+	"direct_abstract_dcltor : '(' opt_param_type_lst ')'",
+	"direct_abstract_dcltor : direct_abstract_dcltor '('",
+	"direct_abstract_dcltor : direct_abstract_dcltor '(' opt_param_type_lst ')'",
+	"initializer : assign_expr",
+	"initializer : '{' initializer_lst '}'",
+	"initializer : '{' initializer_lst ',' '}'",
+	"initializer_lst : initializer",
+	"initializer_lst : initializer_lst ',' initializer",
+	"stmt : labeled_stmt",
+	"stmt : non_lbl_stmt",
+	"non_lbl_stmt : /* empty */",
+	"non_lbl_stmt : compound_stmt",
+	"non_lbl_stmt : expr_stmt",
+	"non_lbl_stmt : selection_stmt",
+	"non_lbl_stmt : iteration_stmt",
+	"non_lbl_stmt : jump_stmt",
+	"non_lbl_stmt : Runerr '(' assign_expr ')' ';'",
+	"non_lbl_stmt : Runerr '(' assign_expr ',' assign_expr ')' ';'",
+	"labeled_stmt : label ':' stmt",
+	"labeled_stmt : Case constant_expr ':' stmt",
+	"labeled_stmt : Default ':' stmt",
+	"compound_stmt : '{' opt_stmt_lst '}'",
+	"compound_stmt : '{' local_dcls opt_stmt_lst '}'",
+	"dcltion_lst : dcltion",
+	"dcltion_lst : dcltion_lst dcltion",
+	"opt_dcltion_lst : /* empty */",
+	"opt_dcltion_lst : dcltion_lst",
+	"local_dcls : local_dcl",
+	"local_dcls : local_dcls local_dcl",
+	"local_dcl : dcltion",
+	"local_dcl : Tended tended_type init_dcltor_lst ';'",
+	"tended_type : Char",
+	"tended_type : Struct identifier",
+	"tended_type : Struct TypeDefName",
+	"tended_type : Union identifier",
+	"stmt_lst : stmt",
+	"stmt_lst : stmt_lst stmt",
+	"opt_stmt_lst : /* empty */",
+	"opt_stmt_lst : stmt_lst",
+	"expr_stmt : opt_expr ';'",
+	"selection_stmt : If '(' expr ')' stmt",
+	"selection_stmt : If '(' expr ')' stmt Else stmt",
+	"selection_stmt : Switch '(' expr ')' stmt",
+	"selection_stmt : Type_case expr Of '{' c_type_select_lst c_opt_default '}'",
+	"c_type_select_lst : c_type_select",
+	"c_type_select_lst : c_type_select_lst c_type_select",
+	"c_type_select : selector_lst non_lbl_stmt",
+	"c_opt_default : /* empty */",
+	"c_opt_default : Default ':' non_lbl_stmt",
+	"iteration_stmt : While '(' expr ')' stmt",
+	"iteration_stmt : Do stmt While '(' expr ')' ';'",
+	"iteration_stmt : For '(' opt_expr ';' opt_expr ';' opt_expr ')' stmt",
+	"jump_stmt : Goto label ';'",
+	"jump_stmt : Continue ';'",
+	"jump_stmt : Break ';'",
+	"jump_stmt : Return ret_val ';'",
+	"jump_stmt : Suspend ret_val ';'",
+	"jump_stmt : Fail ';'",
+	"jump_stmt : Errorfail ';'",
+	"translation_unit : /* empty */",
+	"translation_unit : extrn_decltn_lst",
+	"extrn_decltn_lst : external_dcltion",
+	"extrn_decltn_lst : extrn_decltn_lst external_dcltion",
+	"external_dcltion : function_definition",
+	"external_dcltion : dcltion",
+	"external_dcltion : definition",
+	"function_definition : func_head",
+	"function_definition : func_head opt_dcltion_lst compound_stmt",
+	"func_head : no_tdn_dcltor",
+	"func_head : storcl_tqual_lst no_tdn_dcltor",
+	"func_head : typ_dcltion_specs dcltor",
+	"any_ident : identifier",
+	"any_ident : typedefname",
+	"label : identifier",
+	"label : typedefname",
+	"typedefname : TypeDefName",
+	"typedefname : C_Integer",
+	"typedefname : C_Double",
+	"typedefname : C_String",
+	"definition : /* empty */",
+	"definition : description operation",
+	"operation : fnc_oper op_declare actions End",
+	"operation : keyword actions End",
+	"operation : keyword Constant key_const End",
+	"description : /* empty */",
+	"description : StrLit",
+	"fnc_oper : Function '{' result_seq '}' op_name '(' opt_s_parm_lst ')'",
+	"fnc_oper : Operator '{' result_seq",
+	"fnc_oper : Operator '{' result_seq '}' OpSym",
+	"fnc_oper : Operator '{' result_seq '}' OpSym op_name '(' opt_s_parm_lst ')'",
+	"keyword : Keyword '{' result_seq '}' op_name",
+	"key_const : StrLit",
+	"key_const : CharConst",
+	"key_const : DblConst",
+	"key_const : IntConst",
+	"identifier : Abstract",
+	"identifier : All_fields",
+	"identifier : Any_value",
+	"identifier : Body",
+	"identifier : Component",
+	"identifier : Declare",
+	"identifier : Empty_type",
+	"identifier : End",
+	"identifier : Exact",
+	"identifier : IconType",
+	"identifier : Identifier",
+	"identifier : Inline",
+	"identifier : Named_var",
+	"identifier : New",
+	"identifier : Of",
+	"identifier : Store",
+	"identifier : Struct_var",
+	"identifier : Then",
+	"identifier : Tmp_cset",
+	"identifier : Tmp_string",
+	"identifier : TokType",
+	"identifier : Underef",
+	"identifier : Variable",
+	"op_name : identifier",
+	"op_name : typedefname",
+	"op_name : Auto",
+	"op_name : Break",
+	"op_name : Case",
+	"op_name : Char",
+	"op_name : Cnv",
+	"op_name : Const",
+	"op_name : Continue",
+	"op_name : Def",
+	"op_name : Default",
+	"op_name : Do",
+	"op_name : Doubl",
+	"op_name : Else",
+	"op_name : Enum",
+	"op_name : Errorfail",
+	"op_name : Extern",
+	"op_name : Fail",
+	"op_name : Float",
+	"op_name : For",
+	"op_name : Function",
+	"op_name : Goto",
+	"op_name : If",
+	"op_name : Int",
+	"op_name : Is",
+	"op_name : Keyword",
+	"op_name : Long",
+	"op_name : Operator",
+	"op_name : Register",
+	"op_name : Return",
+	"op_name : Runerr",
+	"op_name : Short",
+	"op_name : Signed",
+	"op_name : Sizeof",
+	"op_name : Static",
+	"op_name : Struct",
+	"op_name : Suspend",
+	"op_name : Switch",
+	"op_name : Tended",
+	"op_name : Typedef",
+	"op_name : Union",
+	"op_name : Unsigned",
+	"op_name : Void",
+	"op_name : Volatile",
+	"op_name : While",
+	"result_seq : /* empty */",
+	"result_seq : length opt_plus",
+	"result_seq : length ',' length opt_plus",
+	"length : IntConst",
+	"length : '*'",
+	"opt_plus : /* empty */",
+	"opt_plus : '+'",
+	"opt_s_parm_lst : /* empty */",
+	"opt_s_parm_lst : s_parm_lst",
+	"opt_s_parm_lst : s_parm_lst '[' identifier ']'",
+	"s_parm_lst : s_parm",
+	"s_parm_lst : s_parm_lst ',' s_parm",
+	"s_parm : identifier",
+	"s_parm : Underef identifier",
+	"s_parm : Underef identifier Arrow identifier",
+	"op_declare : /* empty */",
+	"op_declare : Declare '{' local_dcls '}'",
+	"opt_actions : /* empty */",
+	"opt_actions : actions",
+	"actions : action",
+	"actions : actions action",
+	"action : checking_conversions",
+	"action : detail_code",
+	"action : runerr",
+	"action : '{' opt_actions '}'",
+	"action : Abstract",
+	"action : Abstract '{' type_computations",
+	"action : Abstract '{' type_computations '}'",
+	"checking_conversions : If type_check Then action",
+	"checking_conversions : If type_check Then action Else action",
+	"checking_conversions : Type_case variable Of '{' type_select_lst opt_default '}'",
+	"checking_conversions : Len_case identifier Of '{' len_select_lst Default ':' action '}'",
+	"checking_conversions : Arith_case '(' variable ',' variable ')' Of '{' dest_type ':' action dest_type ':' action dest_type ':' action '}'",
+	"type_select_lst : type_select",
+	"type_select_lst : type_select_lst type_select",
+	"type_select : selector_lst action",
+	"opt_default : /* empty */",
+	"opt_default : Default ':' action",
+	"selector_lst : i_type_name ':'",
+	"selector_lst : selector_lst i_type_name ':'",
+	"len_select_lst : len_select",
+	"len_select_lst : len_select_lst len_select",
+	"len_select : IntConst ':' action",
+	"type_check : simple_check_conj",
+	"type_check : '!' simple_check",
+	"simple_check_conj : simple_check",
+	"simple_check_conj : simple_check_conj And simple_check",
+	"simple_check : Is ':' i_type_name '(' variable ')'",
+	"simple_check : Cnv ':' dest_type '(' variable ')'",
+	"simple_check : Cnv ':' dest_type '(' variable ',' assign_expr ')'",
+	"simple_check : Def ':' dest_type '(' variable ',' assign_expr ')'",
+	"simple_check : Def ':' dest_type '(' variable ',' assign_expr ',' assign_expr ')'",
+	"detail_code : Body",
+	"detail_code : Body compound_stmt",
+	"detail_code : Inline",
+	"detail_code : Inline compound_stmt",
+	"runerr : Runerr '(' IntConst ')' opt_semi",
+	"runerr : Runerr '(' IntConst ',' variable ')' opt_semi",
+	"opt_semi : /* empty */",
+	"opt_semi : ';'",
+	"variable : identifier",
+	"variable : identifier '[' IntConst ']'",
+	"dest_type : IconType",
+	"dest_type : C_Integer",
+	"dest_type : C_Double",
+	"dest_type : C_String",
+	"dest_type : Tmp_string",
+	"dest_type : Tmp_cset",
+	"dest_type : '(' Exact ')' IconType",
+	"dest_type : '(' Exact ')' C_Integer",
+	"i_type_name : Any_value",
+	"i_type_name : Empty_type",
+	"i_type_name : IconType",
+	"i_type_name : Variable",
+	"ret_val : opt_expr",
+	"ret_val : C_Integer assign_expr",
+	"ret_val : C_Double assign_expr",
+	"ret_val : C_String assign_expr",
+	"type_computations : side_effect_lst Return type opt_semi",
+	"type_computations : Return type opt_semi",
+	"type_computations : side_effect_lst",
+	"side_effect_lst : side_effect",
+	"side_effect_lst : side_effect_lst side_effect",
+	"side_effect : Store '[' type ']' '=' type opt_semi",
+	"type : basic_type",
+	"type : type union basic_type",
+	"type : type Intersect basic_type",
+	"basic_type : i_type_name",
+	"basic_type : TokType '(' variable ')'",
+	"basic_type : New i_type_name '(' type_lst ')'",
+	"basic_type : Store '[' type ']'",
+	"basic_type : basic_type '.' attrb_name",
+	"basic_type : '(' type ')'",
+	"union : Incr",
+	"type_lst : type",
+	"type_lst : type_lst ',' type",
+	"attrb_name : Component",
+	"attrb_name : All_fields",
+};
+#endif /* YYDEBUG */
+#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 )\
+	{\
+		yyerror( "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)
+	{
+		yyerror( "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 /* YYDEBUG */
+		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)
+			{
+				yyerror( "yacc 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 /* YYDEBUG */
+		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 /* YYDEBUG */
+			/*
+			** 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( "syntax error" );
+				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 /* YYDEBUG */
+				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 81 "rttgram.y"
+{yyval.n = sym_node(yypvt[-0].t);} break;
+case 2:
+# line 82 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 3:
+# line 83 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 4:
+# line 84 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 5:
+# line 85 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 6:
+# line 86 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 7:
+# line 87 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 8:
+# line 88 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 9:
+# line 89 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 10:
+# line 90 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 11:
+# line 91 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 12:
+# line 92 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 13:
+# line 93 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 15:
+# line 98 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, yypvt[-3].n, yypvt[-1].n);
+                                        free_t(yypvt[-0].t);} break;
+case 16:
+# line 100 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-2].n, NULL);
+                                        free_t(yypvt[-1].t);} break;
+case 17:
+# line 102 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-3].n, yypvt[-1].n);
+                                        free_t(yypvt[-2].t);} break;
+case 18:
+# line 104 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 19:
+# line 105 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 20:
+# line 106 "rttgram.y"
+{yyval.n = node1(PstfxNd, yypvt[-0].t, yypvt[-1].n);} break;
+case 21:
+# line 107 "rttgram.y"
+{yyval.n = node1(PstfxNd, yypvt[-0].t, yypvt[-1].n);} break;
+case 22:
+# line 109 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-5].t, yypvt[-3].n, yypvt[-1].n); free_t(yypvt[-4].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 23:
+# line 111 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-7].t, yypvt[-5].n, yypvt[-3].n, yypvt[-1].n), free_t(yypvt[-6].t); free_t(yypvt[-4].t); free_t(yypvt[-2].t);
+       free_t(yypvt[-0].t);} break;
+case 24:
+# line 114 "rttgram.y"
+{yyval.n = node4(QuadNd, yypvt[-9].t, yypvt[-7].n, yypvt[-5].n, yypvt[-3].n, yypvt[-1].n), free_t(yypvt[-8].t); free_t(yypvt[-6].t);
+       free_t(yypvt[-4].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 26:
+# line 120 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 28:
+# line 125 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 29:
+# line 126 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 30:
+# line 127 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 31:
+# line 128 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 32:
+# line 129 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-3].t, yypvt[-1].n);
+                               free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 40:
+# line 144 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-3].t, yypvt[-2].n, yypvt[-0].n); free_t(yypvt[-1].t);} break;
+case 42:
+# line 149 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 43:
+# line 150 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 44:
+# line 151 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 46:
+# line 156 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 47:
+# line 157 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 49:
+# line 162 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 50:
+# line 163 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 52:
+# line 168 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 53:
+# line 169 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 54:
+# line 170 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 55:
+# line 171 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 57:
+# line 176 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 58:
+# line 177 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 60:
+# line 182 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 62:
+# line 187 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 64:
+# line 192 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 66:
+# line 197 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 68:
+# line 202 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 70:
+# line 208 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-3].t, yypvt[-4].n, yypvt[-2].n, yypvt[-0].n);
+                                          free_t(yypvt[-1].t);} break;
+case 72:
+# line 214 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 85:
+# line 233 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 86:
+# line 237 "rttgram.y"
+{yyval.n = NULL;} break;
+case 89:
+# line 246 "rttgram.y"
+{yyval.n = NULL;} break;
+case 91:
+# line 251 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-1].n, NULL);
+                                             dcl_stk->kind_dcl = OtherDcl;} break;
+case 92:
+# line 253 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-2].n, yypvt[-1].n);
+                                             dcl_stk->kind_dcl = OtherDcl;} break;
+case 93:
+# line 256 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-2].n, yypvt[-1].n);
+                                             dcl_stk->kind_dcl = OtherDcl;} break;
+case 95:
+# line 262 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 98:
+# line 271 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 99:
+# line 273 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, node0(PrimryNd, yypvt[-1].t), yypvt[-0].n);} break;
+case 102:
+# line 279 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 103:
+# line 280 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 104:
+# line 281 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 107:
+# line 287 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 108:
+# line 288 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 110:
+# line 293 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 112:
+# line 299 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 113:
+# line 303 "rttgram.y"
+{yyval.n = yypvt[-0].n; id_def(yypvt[-0].n, NULL);} break;
+case 114:
+# line 304 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n); id_def(yypvt[-2].n, yypvt[-0].n);} break;
+case 115:
+# line 308 "rttgram.y"
+{yyval.n = yypvt[-0].n; id_def(yypvt[-0].n, NULL);} break;
+case 116:
+# line 310 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n); id_def(yypvt[-2].n, yypvt[-0].n);} break;
+case 117:
+# line 314 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t); dcl_stk->kind_dcl = IsTypedef;} break;
+case 118:
+# line 315 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 119:
+# line 316 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 120:
+# line 317 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 121:
+# line 318 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 123:
+# line 323 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 124:
+# line 327 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 125:
+# line 328 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 126:
+# line 329 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 127:
+# line 330 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 128:
+# line 331 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 129:
+# line 332 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 130:
+# line 333 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 131:
+# line 334 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 132:
+# line 335 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 135:
+# line 342 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, yypvt[-3].n, yypvt[-1].n);
+                                             free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 136:
+# line 345 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-3].t, NULL, yypvt[-1].n);
+                                             free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 137:
+# line 347 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-0].n, NULL);} break;
+case 141:
+# line 357 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 142:
+# line 362 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-2].n, yypvt[-1].n);} break;
+case 143:
+# line 363 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-2].n, yypvt[-1].n);} break;
+case 145:
+# line 368 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 146:
+# line 372 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 147:
+# line 373 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, node0(PrimryNd, yypvt[-1].t), yypvt[-0].n);} break;
+case 150:
+# line 379 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 151:
+# line 380 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 153:
+# line 384 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 154:
+# line 388 "rttgram.y"
+{yyval.n = node2(StrDclNd, NULL, yypvt[-0].n, NULL);
+                               if (dcl_stk->parms_done) pop_cntxt();} break;
+case 155:
+# line 390 "rttgram.y"
+{yyval.n = node2(StrDclNd, yypvt[-1].t, NULL, yypvt[-0].n);} break;
+case 156:
+# line 391 "rttgram.y"
+{if (dcl_stk->parms_done) pop_cntxt();} break;
+case 157:
+# line 392 "rttgram.y"
+{yyval.n = node2(StrDclNd, yypvt[-2].t, yypvt[-3].n, yypvt[-0].n);} break;
+case 159:
+# line 398 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 160:
+# line 402 "rttgram.y"
+{yyval.n = node2(StrDclNd, NULL, yypvt[-0].n, NULL);
+                                      if (dcl_stk->parms_done) pop_cntxt();} break;
+case 161:
+# line 404 "rttgram.y"
+{yyval.n = node2(StrDclNd, yypvt[-1].t, NULL, yypvt[-0].n);} break;
+case 162:
+# line 405 "rttgram.y"
+{if (dcl_stk->parms_done) pop_cntxt();} break;
+case 163:
+# line 406 "rttgram.y"
+{yyval.n = node2(StrDclNd, yypvt[-2].t, yypvt[-3].n, yypvt[-0].n);} break;
+case 164:
+# line 410 "rttgram.y"
+{push_cntxt(0);} break;
+case 165:
+# line 411 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, NULL, yypvt[-1].n); pop_cntxt(); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 166:
+# line 412 "rttgram.y"
+{push_cntxt(0);} break;
+case 167:
+# line 413 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-5].t, yypvt[-4].n,  yypvt[-1].n); pop_cntxt(); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 168:
+# line 414 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-0].n,  NULL);} break;
+case 170:
+# line 419 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 171:
+# line 423 "rttgram.y"
+{yyval.n = yypvt[-0].n; id_def(yypvt[-0].n, NULL);} break;
+case 172:
+# line 425 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n); id_def(yypvt[-2].n, yypvt[-0].n);} break;
+case 173:
+# line 429 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 174:
+# line 430 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 175:
+# line 435 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 176:
+# line 439 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 178:
+# line 444 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n);
+                                               free_t(yypvt[-0].t);} break;
+case 179:
+# line 446 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, yypvt[-3].n, yypvt[-1].n);
+                                               free_t(yypvt[-0].t);} break;
+case 180:
+# line 448 "rttgram.y"
+{push_cntxt(1);} break;
+case 181:
+# line 449 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-4].n, yypvt[-1].n);
+                                               if (dcl_stk->nest_lvl == 2)
+                                                  dcl_stk->parms_done = 1;
+                                                else
+                                                  pop_cntxt();
+                                               free_t(yypvt[-3].t);} break;
+case 182:
+# line 458 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 183:
+# line 459 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n);
+                                               free_t(yypvt[-0].t);} break;
+case 184:
+# line 462 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, yypvt[-3].n, yypvt[-1].n);
+                                               free_t(yypvt[-0].t);} break;
+case 185:
+# line 464 "rttgram.y"
+{push_cntxt(1);} break;
+case 186:
+# line 465 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-4].n, yypvt[-1].n);
+                                               if (dcl_stk->nest_lvl == 2)
+                                                  dcl_stk->parms_done = 1;
+                                                else
+                                                  pop_cntxt();
+                                               free_t(yypvt[-3].t);} break;
+case 189:
+# line 479 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 190:
+# line 480 "rttgram.y"
+{yyval.n = node1(PreSpcNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 191:
+# line 481 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 192:
+# line 482 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, node2(LstNd, NULL, yypvt[-1].n,yypvt[-0].n));} break;
+case 193:
+# line 486 "rttgram.y"
+{yyval.n = NULL;} break;
+case 196:
+# line 492 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 198:
+# line 497 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, node0(PrimryNd, yypvt[-0].t));} break;
+case 199:
+# line 501 "rttgram.y"
+{yyval.n = NULL;} break;
+case 202:
+# line 507 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 203:
+# line 511 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);
+                                    id_def(yypvt[-0].n, NULL);} break;
+case 205:
+# line 514 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 206:
+# line 518 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 207:
+# line 519 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, node0(PrimryNd,yypvt[-0].t));} break;
+case 210:
+# line 525 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 211:
+# line 526 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 213:
+# line 531 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 215:
+# line 536 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 216:
+# line 540 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n);
+                                             free_t(yypvt[-0].t);} break;
+case 217:
+# line 543 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, NULL, yypvt[-1].n);
+                                             free_t(yypvt[-0].t);} break;
+case 218:
+# line 546 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, yypvt[-3].n, yypvt[-1].n);
+                                             free_t(yypvt[-0].t);} break;
+case 219:
+# line 548 "rttgram.y"
+{push_cntxt(1);} break;
+case 220:
+# line 549 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, NULL, yypvt[-1].n);
+                                             pop_cntxt();
+                                             free_t(yypvt[-3].t);} break;
+case 221:
+# line 552 "rttgram.y"
+{push_cntxt(1);} break;
+case 222:
+# line 553 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-0].t, yypvt[-4].n, yypvt[-1].n);
+                                             pop_cntxt();
+                                             free_t(yypvt[-3].t);} break;
+case 224:
+# line 561 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 225:
+# line 563 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-3].t, node2(CommaNd, yypvt[-1].t, yypvt[-2].n, NULL));
+                          free_t(yypvt[-0].t);} break;
+case 227:
+# line 569 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 230:
+# line 578 "rttgram.y"
+{push_cntxt(1);} break;
+case 231:
+# line 578 "rttgram.y"
+{yyval.n = yypvt[-0].n; pop_cntxt();} break;
+case 236:
+# line 584 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, yypvt[-2].n, NULL); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 237:
+# line 586 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-6].t, yypvt[-4].n, yypvt[-2].n); free_t(yypvt[-5].t); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 238:
+# line 590 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 239:
+# line 591 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-3].t, yypvt[-2].n, yypvt[-0].n); free_t(yypvt[-1].t);} break;
+case 240:
+# line 592 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-0].n); free_t(yypvt[-1].t);} break;
+case 241:
+# line 596 "rttgram.y"
+{yyval.n = comp_nd(yypvt[-2].t, NULL, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 242:
+# line 597 "rttgram.y"
+{yyval.n = comp_nd(yypvt[-3].t, yypvt[-2].n,   yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 244:
+# line 602 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 245:
+# line 606 "rttgram.y"
+{yyval.n = NULL;} break;
+case 248:
+# line 612 "rttgram.y"
+{yyval.n = (yypvt[-0].n == NULL ? yypvt[-1].n : node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n));} break;
+case 250:
+# line 618 "rttgram.y"
+{yyval.n = NULL; free_t(yypvt[-3].t); free_t(yypvt[-0].t); dcl_stk->kind_dcl = OtherDcl;} break;
+case 251:
+# line 622 "rttgram.y"
+{tnd_char(); free_t(yypvt[-0].t);} break;
+case 252:
+# line 623 "rttgram.y"
+{tnd_strct(yypvt[-0].t); free_t(yypvt[-1].t);} break;
+case 253:
+# line 624 "rttgram.y"
+{tnd_strct(yypvt[-0].t); free_t(yypvt[-1].t);} break;
+case 254:
+# line 625 "rttgram.y"
+{tnd_union(yypvt[-0].t); free_t(yypvt[-1].t);} break;
+case 256:
+# line 630 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 257:
+# line 634 "rttgram.y"
+{yyval.n = NULL;} break;
+case 259:
+# line 638 "rttgram.y"
+{yyval.n = node1(PstfxNd, yypvt[-0].t, yypvt[-1].n);} break;
+case 260:
+# line 642 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-4].t, yypvt[-2].n, yypvt[-0].n,NULL);
+                                          free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 261:
+# line 644 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-6].t, yypvt[-4].n, yypvt[-2].n, yypvt[-0].n);
+                                          free_t(yypvt[-5].t); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 262:
+# line 646 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, yypvt[-2].n, yypvt[-0].n);
+                                          free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 263:
+# line 649 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-6].t, yypvt[-5].n, yypvt[-2].n, yypvt[-1].n); free_t(yypvt[-4].t); free_t(yypvt[-3].t); free_t(yypvt[-0].t);} break;
+case 264:
+# line 653 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, NULL, yypvt[-0].n);} break;
+case 265:
+# line 654 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL,   yypvt[-1].n, yypvt[-0].n);} break;
+case 266:
+# line 658 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 267:
+# line 662 "rttgram.y"
+{yyval.n = NULL;} break;
+case 268:
+# line 663 "rttgram.y"
+{yyval.n = yypvt[-0].n; free_t(yypvt[-2].t); free_t(yypvt[-1].t);} break;
+case 269:
+# line 667 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, yypvt[-2].n, yypvt[-0].n);
+                                        free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 270:
+# line 669 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-6].t, yypvt[-5].n, yypvt[-2].n);
+                                        free_t(yypvt[-4].t); free_t(yypvt[-3].t); free_t(yypvt[-1].t);
+                                        free_t(yypvt[-0].t);} break;
+case 271:
+# line 673 "rttgram.y"
+{yyval.n = node4(QuadNd, yypvt[-8].t, yypvt[-6].n, yypvt[-4].n, yypvt[-2].n, yypvt[-0].n);
+                                        free_t(yypvt[-7].t); free_t(yypvt[-5].t); free_t(yypvt[-3].t);
+                                        free_t(yypvt[-1].t);} break;
+case 272:
+# line 679 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 273:
+# line 680 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-1].t); free_t(yypvt[-0].t);} break;
+case 274:
+# line 681 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-1].t); free_t(yypvt[-0].t);} break;
+case 275:
+# line 682 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 276:
+# line 683 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 277:
+# line 684 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-1].t); free_t(yypvt[-0].t);} break;
+case 278:
+# line 685 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-1].t); free_t(yypvt[-0].t);} break;
+case 284:
+# line 700 "rttgram.y"
+{dclout(yypvt[-0].n);} break;
+case 286:
+# line 705 "rttgram.y"
+{func_def(yypvt[-0].n);} break;
+case 287:
+# line 706 "rttgram.y"
+{fncout(yypvt[-3].n, yypvt[-1].n, yypvt[-0].n);} break;
+case 288:
+# line 710 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, NULL, yypvt[-0].n);} break;
+case 289:
+# line 711 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 290:
+# line 712 "rttgram.y"
+{yyval.n = node2(LstNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 291:
+# line 716 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 292:
+# line 717 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 293:
+# line 721 "rttgram.y"
+{yyval.n = lbl(yypvt[-0].t);} break;
+case 294:
+# line 722 "rttgram.y"
+{yyval.n = lbl(yypvt[-0].t);} break;
+case 299:
+# line 737 "rttgram.y"
+{strt_def();} break;
+case 301:
+# line 741 "rttgram.y"
+{defout(yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 302:
+# line 742 "rttgram.y"
+{defout(yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 303:
+# line 743 "rttgram.y"
+{keyconst(yypvt[-1].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 304:
+# line 747 "rttgram.y"
+{comment = NULL;} break;
+case 305:
+# line 748 "rttgram.y"
+{comment = yypvt[-0].t;} break;
+case 306:
+# line 753 "rttgram.y"
+{impl_fnc(yypvt[-3].t); free_t(yypvt[-7].t); free_t(yypvt[-6].t); free_t(yypvt[-4].t); free_t(yypvt[-2].t);
+       free_t(yypvt[-0].t);} break;
+case 307:
+# line 755 "rttgram.y"
+{lex_state = OpHead;} break;
+case 308:
+# line 756 "rttgram.y"
+{lex_state = DfltLex;} break;
+case 309:
+# line 757 "rttgram.y"
+{impl_op(yypvt[-5].t, yypvt[-3].t); free_t(yypvt[-10].t); free_t(yypvt[-9].t); free_t(yypvt[-6].t); free_t(yypvt[-2].t);
+       free_t(yypvt[-0].t);} break;
+case 310:
+# line 762 "rttgram.y"
+{impl_key(yypvt[-0].t); free_t(yypvt[-4].t); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 383:
+# line 853 "rttgram.y"
+{set_r_seq(NoRsltSeq, NoRsltSeq, 0);} break;
+case 384:
+# line 854 "rttgram.y"
+{set_r_seq(yypvt[-1].i, yypvt[-1].i, (int)yypvt[-0].i);} break;
+case 385:
+# line 855 "rttgram.y"
+{set_r_seq(yypvt[-3].i, yypvt[-1].i, (int)yypvt[-0].i); free_t(yypvt[-2].t);} break;
+case 386:
+# line 859 "rttgram.y"
+{yyval.i = ttol(yypvt[-0].t); free_t(yypvt[-0].t);} break;
+case 387:
+# line 860 "rttgram.y"
+{yyval.i = UnbndSeq; free_t(yypvt[-0].t);} break;
+case 388:
+# line 864 "rttgram.y"
+{yyval.i = 0;} break;
+case 389:
+# line 865 "rttgram.y"
+{yyval.i = 1; free_t(yypvt[-0].t);} break;
+case 392:
+# line 871 "rttgram.y"
+{var_args(yypvt[-1].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 394:
+# line 876 "rttgram.y"
+{free_t(yypvt[-1].t);} break;
+case 395:
+# line 880 "rttgram.y"
+{s_prm_def(NULL, yypvt[-0].t);} break;
+case 396:
+# line 881 "rttgram.y"
+{s_prm_def(yypvt[-0].t, NULL); free_t(yypvt[-1].t);} break;
+case 397:
+# line 882 "rttgram.y"
+{s_prm_def(yypvt[-2].t, yypvt[-0].t);   free_t(yypvt[-3].t);
+                                          free_t(yypvt[-1].t);} break;
+case 398:
+# line 887 "rttgram.y"
+{} break;
+case 399:
+# line 888 "rttgram.y"
+{d_lst_typ(yypvt[-1].n); free_t(yypvt[-3].t); free_t(yypvt[-2].t);
+                                 free_t(yypvt[-0].t);} break;
+case 400:
+# line 893 "rttgram.y"
+{yyval.n = NULL;} break;
+case 403:
+# line 899 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 407:
+# line 906 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-1].n); free_t(yypvt[-0].t);} break;
+case 408:
+# line 907 "rttgram.y"
+{lex_state = TypeComp;} break;
+case 409:
+# line 908 "rttgram.y"
+{lex_state = DfltLex;} break;
+case 410:
+# line 909 "rttgram.y"
+{yyval.n = yypvt[-2].n; free_t(yypvt[-5].t); free_t(yypvt[-3].t); free_t(yypvt[-0].t);} break;
+case 411:
+# line 914 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-3].t, yypvt[-2].n, yypvt[-0].n, NULL); free_t(yypvt[-1].t);} break;
+case 412:
+# line 916 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-5].t, yypvt[-4].n, yypvt[-2].n, yypvt[-0].n); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 413:
+# line 918 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-6].t, yypvt[-5].n, yypvt[-2].n, yypvt[-1].n); free_t(yypvt[-4].t); free_t(yypvt[-3].t); free_t(yypvt[-0].t);} break;
+case 414:
+# line 920 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-8].t, sym_node(yypvt[-7].t), yypvt[-4].n, yypvt[-1].n); free_t(yypvt[-6].t), free_t(yypvt[-5].t);
+       free_t(yypvt[-3].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 415:
+# line 924 "rttgram.y"
+{yyval.n = arith_nd(yypvt[-17].t, yypvt[-15].n, yypvt[-13].n, yypvt[-9].n, yypvt[-7].n, yypvt[-6].n, yypvt[-4].n, yypvt[-3].n, yypvt[-1].n); free_t(yypvt[-16].t);
+       free_t(yypvt[-14].t), free_t(yypvt[-12].t); free_t(yypvt[-11].t); free_t(yypvt[-10].t); free_t(yypvt[-8].t);
+       free_t(yypvt[-5].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 416:
+# line 930 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, NULL, yypvt[-0].n);} break;
+case 417:
+# line 931 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL,   yypvt[-1].n, yypvt[-0].n);} break;
+case 418:
+# line 935 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 419:
+# line 939 "rttgram.y"
+{yyval.n = NULL;} break;
+case 420:
+# line 940 "rttgram.y"
+{yyval.n = yypvt[-0].n; free_t(yypvt[-2].t); free_t(yypvt[-1].t);} break;
+case 421:
+# line 944 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, NULL, yypvt[-1].n);
+                                   free_t(yypvt[-0].t);} break;
+case 422:
+# line 946 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL,   yypvt[-2].n, yypvt[-1].n);
+                                   free_t(yypvt[-0].t);} break;
+case 424:
+# line 952 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 425:
+# line 956 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-0].n); free_t(yypvt[-1].t);} break;
+case 427:
+# line 961 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 429:
+# line 966 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 430:
+# line 971 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-5].t, yypvt[-3].n, yypvt[-1].n); free_t(yypvt[-4].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 431:
+# line 973 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-5].t, yypvt[-3].n, yypvt[-1].n, NULL), dst_alloc(yypvt[-3].n, yypvt[-1].n); free_t(yypvt[-4].t);
+       free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 432:
+# line 976 "rttgram.y"
+{yyval.n = node3(TrnryNd, yypvt[-7].t, yypvt[-5].n, yypvt[-3].n, yypvt[-1].n), free_t(yypvt[-6].t); free_t(yypvt[-4].t); free_t(yypvt[-2].t);
+       free_t(yypvt[-0].t);} break;
+case 433:
+# line 979 "rttgram.y"
+{yyval.n = node4(QuadNd, yypvt[-7].t, yypvt[-5].n, yypvt[-3].n, yypvt[-1].n, NULL), dst_alloc(yypvt[-5].n, yypvt[-3].n); free_t(yypvt[-6].t);
+       free_t(yypvt[-4].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 434:
+# line 982 "rttgram.y"
+{yyval.n = node4(QuadNd, yypvt[-9].t, yypvt[-7].n, yypvt[-5].n, yypvt[-3].n, yypvt[-1].n), free_t(yypvt[-8].t); free_t(yypvt[-6].t);
+       free_t(yypvt[-4].t); free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 435:
+# line 987 "rttgram.y"
+{push_cntxt(1);} break;
+case 436:
+# line 988 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-0].n); pop_cntxt();} break;
+case 437:
+# line 989 "rttgram.y"
+{push_cntxt(1);} break;
+case 438:
+# line 990 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-2].t, yypvt[-0].n); pop_cntxt();} break;
+case 439:
+# line 995 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, node0(PrimryNd, yypvt[-2].t), NULL);
+                     free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 440:
+# line 998 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-6].t, node0(PrimryNd, yypvt[-4].t), yypvt[-2].n);
+                     free_t(yypvt[-5].t); free_t(yypvt[-3].t); free_t(yypvt[-1].t);} break;
+case 442:
+# line 1004 "rttgram.y"
+{free_t(yypvt[-0].t);} break;
+case 443:
+# line 1008 "rttgram.y"
+{yyval.n = sym_node(yypvt[-0].t);} break;
+case 444:
+# line 1009 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, sym_node(yypvt[-3].t),
+                                    node0(PrimryNd, yypvt[-1].t));
+                                  free_t(yypvt[-0].t);} break;
+case 445:
+# line 1014 "rttgram.y"
+{yyval.n = dest_node(yypvt[-0].t);} break;
+case 446:
+# line 1015 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 447:
+# line 1016 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 448:
+# line 1017 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 449:
+# line 1018 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t); ++n_tmp_str;} break;
+case 450:
+# line 1019 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t); ++n_tmp_cset;} break;
+case 451:
+# line 1020 "rttgram.y"
+{yyval.n = node0(ExactCnv, chk_exct(yypvt[-0].t)); free_t(yypvt[-3].t);
+                              free_t(yypvt[-2].t); free_t(yypvt[-1].t);} break;
+case 452:
+# line 1022 "rttgram.y"
+{yyval.n = node0(ExactCnv, yypvt[-0].t); free_t(yypvt[-3].t); free_t(yypvt[-2].t);
+                              free_t(yypvt[-1].t);} break;
+case 453:
+# line 1027 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 454:
+# line 1028 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 455:
+# line 1029 "rttgram.y"
+{yyval.n = sym_node(yypvt[-0].t);} break;
+case 456:
+# line 1030 "rttgram.y"
+{yyval.n = node0(PrimryNd, yypvt[-0].t);} break;
+case 458:
+# line 1035 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 459:
+# line 1036 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 460:
+# line 1037 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-1].t, yypvt[-0].n);} break;
+case 461:
+# line 1041 "rttgram.y"
+{yyval.n = node2(AbstrNd, yypvt[-2].t,   yypvt[-3].n,   yypvt[-1].n);} break;
+case 462:
+# line 1042 "rttgram.y"
+{yyval.n = node2(AbstrNd, yypvt[-2].t,   NULL, yypvt[-1].n);} break;
+case 463:
+# line 1043 "rttgram.y"
+{yyval.n = node2(AbstrNd, NULL, yypvt[-0].n, NULL);} break;
+case 465:
+# line 1048 "rttgram.y"
+{yyval.n = node2(ConCatNd, NULL, yypvt[-1].n, yypvt[-0].n);} break;
+case 466:
+# line 1052 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-2].t, yypvt[-4].n, yypvt[-1].n);
+                                           free_t(yypvt[-6].t); free_t(yypvt[-5].t); free_t(yypvt[-3].t);} break;
+case 468:
+# line 1058 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 469:
+# line 1059 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+case 470:
+# line 1062 "rttgram.y"
+{yyval.n = node1(IcnTypNd,
+                                         copy_t(yypvt[-0].n->tok), yypvt[-0].n);} break;
+case 471:
+# line 1064 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-3].t, yypvt[-1].n);
+                                         free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 472:
+# line 1066 "rttgram.y"
+{yyval.n = node2(BinryNd, yypvt[-4].t, yypvt[-3].n, yypvt[-1].n);
+                                         free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 473:
+# line 1068 "rttgram.y"
+{yyval.n = node1(PrefxNd, yypvt[-3].t, yypvt[-1].n);
+                                         free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 474:
+# line 1070 "rttgram.y"
+{yyval.n = node1(PstfxNd, yypvt[-0].t, yypvt[-2].n);
+                                         free_t(yypvt[-1].t);} break;
+case 475:
+# line 1072 "rttgram.y"
+{yyval.n = yypvt[-1].n; free_t(yypvt[-2].t); free_t(yypvt[-0].t);} break;
+case 478:
+# line 1081 "rttgram.y"
+{yyval.n = node2(CommaNd, yypvt[-1].t, yypvt[-2].n, yypvt[-0].n);} break;
+	}
+	goto yystack;		/* reset registers in driver code */
+}
diff --git a/src/rtt/rttproto.h b/src/rtt/rttproto.h
new file mode 100644
index 0000000..315286b
--- /dev/null
+++ b/src/rtt/rttproto.h
@@ -0,0 +1,92 @@
+void           add_dpnd  (struct srcfile *sfile, char *objname);
+int               alloc_tnd (int typ, struct node *init, int lvl);
+struct node      *arith_nd (struct token *tok, struct node *p1,
+                             struct node *p2, struct node *c_int,
+                             struct node *ci_act, struct node *intgr,
+                             struct node *i_act, struct node *dbl,
+                             struct node *d_act);
+struct il_c      *bdy_prm   (int addr_of, int just_desc, struct sym_entry *sym, int may_mod);
+int               c_walk    (struct node *n, int indent, int brace);
+int               call_ret  (struct node *n);
+struct token     *chk_exct  (struct token *tok);
+void           chkabsret (struct token *tok, int ret_typ);
+void           clr_def   (void);
+void           clr_dpnd  (char *srcname);
+void           clr_prmloc (void);
+struct token     *cnv_to_id (struct token *t);
+char             *cnv_name  (int typcd, struct node *dflt, int *dflt_to_ptr);
+struct node      *comp_nd   (struct token *tok, struct node *dcls,
+                              struct node *stmts);
+int               creat_obj (void);
+void           d_lst_typ (struct node *dcls);
+void           dclout    (struct node *n);
+struct node      *dest_node (struct token *tok);
+void           dst_alloc (struct node *cnv_typ, struct node *var);
+void           dumpdb    (char *dbname);
+void           fncout    (struct node *head, struct node *prm_dcl,
+                              struct node *block);
+void           force_nl  (int indent);
+void           free_sym  (struct sym_entry *sym);
+void           free_tree (struct node *n);
+void           free_tend (void);
+void           full_lst  (char *fname);
+void           func_def  (struct node *dcltor);
+void           id_def    (struct node *dcltor, struct node *x);
+void           keepdir   (struct token *s);
+int               icn_typ   (struct node *n);
+struct il_c      *ilc_dcl   (struct node *tqual, struct node *dcltor,
+                              struct node *init);
+void           impl_fnc  (struct token *name);
+void           impl_key  (struct token *name);
+void           impl_op   (struct token *op_sym, struct token *name);
+void           init_lex  (void);
+void           init_sym  (void);
+struct il_c      *inlin_c   (struct node *n, int may_mod);
+void           in_line   (struct node *n);
+void           just_type (struct node *typ, int indent, int ilc);
+void           keyconst  (struct token *t);
+struct node      *lbl       (struct token *t);
+void           ld_prmloc (struct parminfo *parminfo);
+void           loaddb    (char *db);
+void           mrg_prmloc (struct parminfo *parminfo);
+struct parminfo  *new_prmloc (void);
+struct node      *node0     (int id, struct token *tok);
+struct node      *node1     (int id, struct token *tok, struct node *n1);
+struct node      *node2     (int id, struct token *tok, struct node *n1,
+                              struct node *n2);
+struct node      *node3     (int id, struct token *tok, struct node *n1,
+                              struct node *n2, struct node *n3);
+struct node      *node4     (int id, struct token *tok, struct node *n1,
+                              struct node *n2, struct node *n3,
+                              struct node *n4);
+struct il_c      *parm_dcl  (int addr_of, struct sym_entry *sym);
+void	pop_cntxt	(void);
+void           pop_lvl   (void);
+void           prologue  (void);
+void           prt_str   (char *s, int indent);
+void		  ptout	    (struct token * x);
+void	push_cntxt	(int lvl_incr);
+void           push_lvl  (void);
+void           put_c_fl  (char *fname, int keep);
+void           defout    (struct node *n);
+void           set_r_seq (long min, long max, int resume);
+struct il_c      *simpl_dcl (char *tqual, int addr_of, struct sym_entry *sym);
+void           spcl_dcls (struct sym_entry *op_params);
+struct srcfile   *src_lkup  (char *srcname);
+void           strt_def  (void);
+void           sv_prmloc (struct parminfo *parminfo);
+struct sym_entry *sym_add  (int tok_id, char *image, int id_type, int nest_lvl);
+struct sym_entry *sym_lkup  (char *image);
+struct node      *sym_node  (struct token *tok);
+void           s_prm_def (struct token *u_ident, struct token *d_ident);
+void           tnd_char  (void);
+void           tnd_strct (struct token *t);
+void           tnd_union (struct token *t);
+void           trans     (char *src_file);
+long              ttol      (struct token *t);
+char             *typ_name  (int typ, struct token *tok);
+void           unuse     (struct init_tend *t_lst, int lvl);
+void           var_args  (struct token *ident);
+void           yyerror   (char *s);
+int               yylex     (void);
+int               yyparse   (void);
diff --git a/src/rtt/rttsym.c b/src/rtt/rttsym.c
new file mode 100644
index 0000000..9e1901b
--- /dev/null
+++ b/src/rtt/rttsym.c
@@ -0,0 +1,722 @@
+/*
+ * rttsym.c contains symbol table routines.
+ */
+#include "rtt.h"
+
+#define HashSize 149
+
+/*
+ * Prototype for static function.
+ */
+static void add_def    (struct node *dcltor);
+static void add_s_prm  (struct token *ident, int param_num, int flags);
+static void dcl_typ    (struct node *dcl);
+static void dcltor_typ (struct node *dcltor, struct node *tqual);
+
+word lbl_num = 0;                   /* next unused label number */
+struct lvl_entry *dcl_stk;          /* stack of declaration contexts */
+
+char *str_rslt;                     /* string "result" in string table */
+struct init_tend *tend_lst = NULL;  /* list of tended descriptors */
+struct sym_entry *decl_lst = NULL;  /* declarations from "declare {...}" */
+struct sym_entry *v_len = NULL;     /* entry for length of varargs */
+int il_indx = 0;                    /* data base symbol table index */
+
+static struct sym_entry *sym_tbl[HashSize]; /* symbol table */
+
+/*
+ * The following strings are put in the string table and used for
+ *  recognizing valid tended declarations.
+ */
+static char *block = "block";
+static char *descrip = "descrip";
+
+/*
+ * init_sym - initialize  symbol table.
+ */
+void init_sym()
+   {
+   static int first_time = 1;
+   int hash_val;
+   register struct sym_entry *sym;
+   int i;
+
+   /*
+    * Initialize the symbol table and declaration stack. When called for
+    *  the first time, put strings in string table.
+    */
+   if (first_time) {
+      first_time = 0;
+      for (i = 0; i < HashSize; ++i)
+         sym_tbl[i] = NULL;
+      dcl_stk = NewStruct(lvl_entry);
+      dcl_stk->nest_lvl = 1;
+      dcl_stk->next = NULL;
+      block = spec_str(block);
+      descrip = spec_str(descrip);
+      }
+   else {
+      for (hash_val = 0; hash_val < HashSize; ++ hash_val) {
+         for (sym = sym_tbl[hash_val]; sym != NULL &&
+           sym->nest_lvl > 0; sym = sym_tbl[hash_val]) {
+            sym_tbl[hash_val] = sym->next;
+            free((char *)sym);
+            }
+         }
+      }
+   dcl_stk->kind_dcl = OtherDcl;
+   dcl_stk->parms_done = 0;
+   }
+
+/*
+ * sym_lkup - look up a string in the symbol table. Return NULL If it is not
+ *  there.
+ */
+struct sym_entry *sym_lkup(image)
+char *image;
+   {
+   register struct sym_entry *sym;
+
+   for (sym = sym_tbl[(unsigned int)(unsigned long)image % HashSize];
+         sym != NULL;
+         sym = sym->next)
+      if (sym->image == image)
+         return sym;
+   return NULL;
+   }
+
+/*
+ * sym_add - add a symbol to the symbol table. For some types of entries
+ *  it is illegal to redefine them. In that case, NULL is returned otherwise
+ *  the entry is returned.
+ */
+struct sym_entry *sym_add(tok_id, image, id_type, nest_lvl)
+int tok_id;
+char *image;
+int id_type;
+int nest_lvl;
+   {
+   register struct sym_entry **symp;
+   register struct sym_entry *sym;
+
+   symp = &sym_tbl[(unsigned int)(unsigned long)image % HashSize];
+   while (*symp != NULL && (*symp)->nest_lvl > nest_lvl)
+      symp = &((*symp)->next);
+   while (*symp != NULL && (*symp)->nest_lvl == nest_lvl) {
+      if ((*symp)->image == image) {
+         /*
+          * Redeclaration:
+          *
+          * An explicit typedef may be given for a built-in typedef
+          * name. A label appears in multiply gotos and as a label
+          * on a statement. Assume a global redeclaration is for an
+          * extern. Return the entry for these situations but don't
+          * try too hard to detect errors. If actual errors are not
+          * caught here, the C compiler will find them.
+          */
+         if (tok_id == TypeDefName && ((*symp)->tok_id == C_Integer ||
+            (*symp)->tok_id == TypeDefName))
+            return *symp;
+         if (id_type == Label && (*symp)->id_type == Label)
+            return *symp;
+         if ((*symp)->nest_lvl == 1)
+            return *symp;
+         return NULL;	/* illegal redeclarations */
+         }
+      symp = &((*symp)->next);
+      }
+
+   /*
+    * No entry exists for the symbol, create one, fill in its fields, and add
+    *  it to the table.
+    */
+   sym = NewStruct(sym_entry);
+   sym->tok_id = tok_id;
+   sym->image = image;
+   sym->id_type =  id_type;
+   sym->nest_lvl = nest_lvl;
+   sym->ref_cnt = 1;
+   sym->il_indx = -1;
+   sym->may_mod = 0;
+   if (id_type == Label)
+      sym->u.lbl_num = lbl_num++;
+   sym->next = *symp;
+   *symp = sym;
+
+   return sym;     /* success */
+   }
+
+/*
+ * lbl - make sure the label is in the symbol table and return a node
+ *  referencing the symbol table entry.
+ */
+struct node *lbl(t)
+struct token *t;
+   {
+   struct sym_entry *sym;
+   struct node *n;
+
+   sym = sym_add(Identifier, t->image, Label, 2);
+   if (sym == NULL)
+      errt2(t, "conflicting definitions for ", t->image);
+   n = sym_node(t);
+   if (n->u[0].sym != sym)
+      errt2(t, "conflicting definitions for ", t->image);
+   return n;
+   }
+
+/*
+ * push_cntxt - push a level of declaration context (this may or may not
+ *  be level of declaration nesting).
+ */
+void push_cntxt(lvl_incr)
+int lvl_incr;
+   {
+   struct lvl_entry *entry;
+
+   entry = NewStruct(lvl_entry);
+   entry->nest_lvl = dcl_stk->nest_lvl + lvl_incr;
+   entry->kind_dcl = OtherDcl;
+   entry->parms_done = 0;
+   entry->tended = NULL;
+   entry->next = dcl_stk;
+   dcl_stk = entry;
+   }
+
+/*
+ * pop_cntxt - end a level of declaration context
+ */
+void pop_cntxt()
+   {
+   int hash_val;
+   int old_lvl;
+   int new_lvl;
+   register struct sym_entry *sym;
+   struct lvl_entry *entry;
+
+   /*
+    * Move the top entry of the stack to the free list.
+    */
+   old_lvl = dcl_stk->nest_lvl;
+   entry = dcl_stk;
+   dcl_stk = dcl_stk->next;
+   free((char *)entry);
+
+   /*
+    * If this pop reduced the declaration nesting level, remove obsolete
+    *  entries from the symbol table.
+    */
+   new_lvl = dcl_stk->nest_lvl;
+   if (old_lvl > new_lvl) {
+      for (hash_val = 0; hash_val < HashSize; ++ hash_val) {
+         for (sym = sym_tbl[hash_val]; sym != NULL &&
+           sym->nest_lvl > new_lvl; sym = sym_tbl[hash_val]) {
+            sym_tbl[hash_val] = sym->next;
+            free_sym(sym);
+            }
+         }
+      unuse(tend_lst, old_lvl);
+      }
+   }
+
+/*
+ * unuse - mark tended slots in at the given level of declarations nesting
+ *  as being no longer in use, and leave the slots available for reuse
+ *  for declarations that occur in pararallel compound statements.
+ */
+void unuse(t_lst, lvl)
+struct init_tend *t_lst;
+int lvl;
+   {
+   while (t_lst != NULL) {
+      if (t_lst->nest_lvl >= lvl)
+         t_lst->in_use = 0;
+      t_lst = t_lst->next;
+      }
+   }
+
+/*
+ * free_sym - remove a reference to a symbol table entry and free storage
+ *  related to it if no references remain.
+ */
+void free_sym(sym)
+struct sym_entry *sym;
+   {
+   if (--sym->ref_cnt <= 0) {
+      switch (sym->id_type) {
+         case TndDesc:
+         case TndStr:
+         case TndBlk:
+            free_tree(sym->u.tnd_var.init); /* initializer expression */
+         }
+      free((char *)sym);
+      }
+   }
+
+/*
+ * alloc_tnd - allocated a slot in a tended array for a variable and return
+ *  its index.
+ */
+int alloc_tnd(typ, init, lvl)
+int typ;
+struct node *init;
+int lvl;
+   {
+   register struct init_tend *tnd;
+
+   if (lvl > 2) {
+     /*
+      * This declaration occurs in an inner compound statement. There
+      *  may be slots created for parallel compound statement, but were
+      *  freed and can be reused here.
+      */
+     tnd = tend_lst;
+     while (tnd != NULL && (tnd->in_use || tnd->init_typ != typ))
+       tnd = tnd->next;
+     if (tnd != NULL) {
+         tnd->in_use = 1;
+         tnd->nest_lvl = lvl;
+         return tnd->t_indx;
+         }
+      }
+
+   /*
+    * Allocate a new tended slot, compute its index in the array, and
+    *  set initialization and other information.
+    */
+   tnd = NewStruct(init_tend);
+
+   if (tend_lst == NULL)
+      tnd->t_indx = 0;
+   else
+      tnd->t_indx = tend_lst->t_indx + 1;
+   tnd->init_typ = typ;
+   /*
+    * The initialization from the declaration will only be used to
+    *  set up the tended location if the declaration is in the outermost
+    *  "block". Otherwise a generic initialization will be done during
+    *  the set up and the one from the declaration will be put off until
+    *  the block is entered.
+    */
+   if (lvl == 2)
+      tnd->init = init;
+   else
+      tnd->init = NULL;
+   tnd->in_use = 1;
+   tnd->nest_lvl = lvl;
+   tnd->next = tend_lst;
+   tend_lst = tnd;
+   return tnd->t_indx;
+   }
+
+/*
+ * free_tend - put the list of tended descriptors on the free list.
+ */
+void free_tend()
+   {
+   register struct init_tend *tnd, *tnd1;
+
+   for (tnd = tend_lst; tnd != NULL; tnd = tnd1) {
+      tnd1 = tnd->next;
+      free((char *)tnd);
+      }
+   tend_lst = NULL;
+   }
+
+/*
+ * dst_alloc - the conversion of a parameter is encountered during
+ *  parsing; make sure a place is allocated to act as the destination.
+ */
+void dst_alloc(cnv_typ, var)
+struct node *cnv_typ;
+struct node *var;
+   {
+   struct sym_entry *sym;
+
+   if (var->nd_id == SymNd) {
+      sym = var->u[0].sym;
+      if (sym->id_type & DrfPrm) {
+         switch (cnv_typ->tok->tok_id) {
+            case C_Integer:
+               sym->u.param_info.non_tend |= PrmInt;
+               break;
+            case C_Double:
+               sym->u.param_info.non_tend |= PrmDbl;
+               break;
+            }
+         }
+      }
+   }
+
+/*
+ * strt_def - the start of an operation definition is encountered during
+ *  parsing; establish an new declaration context and make "result"
+ *  a special identifier.
+ */
+void strt_def()
+   {
+   struct sym_entry *sym;
+
+   push_cntxt(1);
+   sym = sym_add(Identifier, str_rslt, RsltLoc, dcl_stk->nest_lvl);
+   sym->u.referenced = 0;
+   }
+
+/*
+ * add_def - update the symbol table for the given declarator.
+ */
+static void add_def(dcltor)
+struct node *dcltor;
+   {
+   struct sym_entry *sym;
+   struct token *t;
+   int tok_id;
+
+   /*
+    * find the identifier within the declarator.
+    */
+   for (;;) {
+      switch (dcltor->nd_id) {
+         case BinryNd:
+            /* ')' or '[' */
+            dcltor = dcltor->u[0].child;
+            break;
+         case ConCatNd:
+            /* pointer direct-declarator */
+            dcltor = dcltor->u[1].child;
+            break;
+         case PrefxNd:
+            /* ( ... ) */
+            dcltor =  dcltor->u[0].child;
+            break;
+         case PrimryNd:
+            t = dcltor->tok;
+            if (t->tok_id == Identifier || t->tok_id == TypeDefName) {
+               /*
+                * We have found the identifier, add an entry to the
+                *  symbol table based on information in the declaration
+                *  context.
+                */
+               if (dcl_stk->kind_dcl == IsTypedef)
+                  tok_id = TypeDefName;
+               else
+                  tok_id = Identifier;
+               sym = sym_add(tok_id, t->image, OtherDcl, dcl_stk->nest_lvl);
+               if (sym == NULL)
+                  errt2(t, "redefinition of ", t->image);
+               }
+            return;
+         default:
+            return;
+         }
+      }
+   }
+
+/*
+ * id_def - a declarator has been parsed. Determine what to do with it
+ *  based on information put in the declaration context while parsing
+ *  the "storage class type qualifier list".
+ */
+void id_def(dcltor, init)
+struct node *dcltor;
+struct node *init;
+   {
+   struct node *chld0, *chld1;
+   struct sym_entry *sym;
+
+   if (dcl_stk->parms_done)
+      pop_cntxt();
+
+   /*
+    * Look in the declaration context (the top of the declaration stack)
+    *  to see if this is a tended declaration.
+    */
+   switch (dcl_stk->kind_dcl) {
+      case TndDesc:
+      case TndStr:
+      case TndBlk:
+         /*
+          * Tended variables are either simple identifiers or pointers to
+          *  simple identifiers.
+          */
+         chld0 = dcltor->u[0].child;
+         chld1 = dcltor->u[1].child;
+         if (chld1->nd_id != PrimryNd || (chld1->tok->tok_id != Identifier &&
+           chld1->tok->tok_id != TypeDefName))
+             errt1(chld1->tok, "unsupported tended declaration");
+         if (dcl_stk->kind_dcl == TndDesc) {
+            /*
+             * Declared as full tended descriptor - must not be a pointer.
+             */
+            if (chld0 != NULL)
+               errt1(chld1->tok, "unsupported tended declaration");
+            }
+         else {
+            /*
+             * Must be a tended pointer.
+             */
+            if (chld0 == NULL || chld0->nd_id != PrimryNd)
+               errt1(chld1->tok, "unsupported tended declaration");
+            }
+
+         /*
+          * This is a legal tended declaration, make a symbol table entry
+          *  for it and allocated a tended slot. Add the symbol table
+          *  entry to the list of tended variables in this context.
+          */
+         sym = sym_add(Identifier, chld1->tok->image, dcl_stk->kind_dcl,
+            dcl_stk->nest_lvl);
+         if (sym == NULL)
+            errt2(chld1->tok, "redefinition of ", chld1->tok->image);
+         sym->u.tnd_var.blk_name = dcl_stk->blk_name;
+         sym->u.tnd_var.init = init;
+         sym->t_indx = alloc_tnd(dcl_stk->kind_dcl, init, dcl_stk->nest_lvl);
+         sym->u.tnd_var.next = dcl_stk->tended;
+         dcl_stk->tended = sym;
+         ++sym->ref_cnt;
+         return;
+      default:
+         add_def(dcltor); /* ordinary declaration */
+      }
+   }
+
+/*
+ * func_def - a function header has been parsed. Add the identifier for
+ *  the function to the symbol table.
+ */
+void func_def(head)
+struct node *head;
+   {
+   /*
+    * If this is really a function header, the current declaration
+    *  context indicates that a parameter list has been completed.
+    *  Parameter lists at other than at nesting level 2 are part of
+    *  nested declaration information and do not show up here. The
+    *  function parameters must remain in the symbol table, so the
+    *  context is just updated, not popped.
+    */
+   if (!dcl_stk->parms_done)
+      yyerror("invalid declaration");
+   dcl_stk->parms_done = 0;
+   if (dcl_stk->next->kind_dcl == IsTypedef)
+      yyerror("a typedef may not be a function definition");
+   add_def(head->u[1].child);
+   }
+
+/*
+ * s_prm_def - add symbol table entries for a parameter to an operation.
+ *  Undereferenced and/or dereferenced versions of the parameter may be
+ *  specified.
+ */
+void s_prm_def(u_ident, d_ident)
+struct token *u_ident;
+struct token *d_ident;
+   {
+   int param_num;
+
+   if (params == NULL)
+      param_num = 0;
+   else
+      param_num = params->u.param_info.param_num + 1;
+   if (u_ident != NULL)
+      add_s_prm(u_ident, param_num, RtParm);
+   if (d_ident != NULL)
+      add_s_prm(d_ident, param_num, DrfPrm);
+   }
+
+/*
+ * add_s_prm - add a symbol table entry for either a dereferenced or
+ *  undereferenced version of a parameter. Put it on the current
+ *  list of parameters.
+ */
+static void add_s_prm(ident, param_num, flags)
+struct token *ident;
+int param_num;
+int flags;
+   {
+   struct sym_entry *sym;
+
+   sym = sym_add(Identifier, ident->image, flags, dcl_stk->nest_lvl);
+   if (sym == NULL)
+      errt2(ident, "redefinition of ", ident->image);
+   sym->u.param_info.param_num = param_num;
+   sym->u.param_info.non_tend = 0;
+   sym->u.param_info.cur_loc = PrmTend;
+   sym->u.param_info.parm_mod = 0;
+   sym->u.param_info.next = params;
+   sym->il_indx = il_indx++;
+   params = sym;
+   ++sym->ref_cnt;
+   }
+
+/*
+ * var_args - a variable length parameter list for an operation is parsed.
+ */
+void var_args(ident)
+struct token *ident;
+   {
+   struct sym_entry *sym;
+
+   /*
+    * The last parameter processed represents the variable part of the list;
+    *  update the symbol table entry. It may be dereferenced or undereferenced
+    *  but not both.
+    */
+   sym = params->u.param_info.next;
+   if (sym != NULL && sym->u.param_info.param_num ==
+      params->u.param_info.param_num)
+         errt1(ident, "only one version of variable parameter list allowed");
+   params->id_type |= VarPrm;
+
+   /*
+    * Add the identifier for the length of the variable part of the list
+    *  to the symbol table.
+    */
+   sym = sym_add(Identifier, ident->image, VArgLen, dcl_stk->nest_lvl);
+   if (sym == NULL)
+      errt2(ident, "redefinition of ", ident->image);
+   sym->il_indx = il_indx++;
+   v_len = sym;
+   ++v_len->ref_cnt;
+   }
+
+/*
+ * d_lst_typ - the end of a "declare {...}" is encountered. Go through a
+ *   declaration list adding storage class, type qualifier, declarator
+ *   and initializer information to the symbol table entry for each
+ *   identifier. Add the entry onto the list associated with the "declare"
+ */
+void d_lst_typ(dcls)
+struct node *dcls;
+   {
+   if (dcls == NULL)
+      return;
+   for ( ; dcls != NULL && dcls->nd_id == LstNd; dcls = dcls->u[0].child)
+      dcl_typ(dcls->u[1].child);
+   dcl_typ(dcls);
+   }
+
+/*
+ * dcl_typ - go through the declarators of a declaration adding the storage
+ *   class, type qualifier, declarator, and initializer information to the
+ *   symbol table entry of each identifier. Add the entry onto the list
+ *   associated with the current "declare {...}".
+ */
+static void dcl_typ(dcl)
+struct node *dcl;
+   {
+   struct node *tqual;
+   struct node *dcltors;
+
+   if (dcl == NULL)
+      return;
+   tqual = dcl->u[0].child;
+   for (dcltors = dcl->u[1].child; dcltors->nd_id == CommaNd;
+      dcltors = dcltors->u[0].child)
+         dcltor_typ(dcltors->u[1].child, tqual);
+   dcltor_typ(dcltors, tqual);
+   }
+
+/*
+ * dcltor_typ- find the identifier in the [initialized] declarator and add
+ *   the storage class, type qualifer, declarator, and initialization
+ *   information to its symbol table entry. Add the entry onto the list
+ *   associated with the current "declare {...}".
+ */
+static void dcltor_typ(dcltor, tqual)
+struct node *dcltor;
+struct node *tqual;
+   {
+   struct sym_entry *sym;
+   struct node *part_dcltor;
+   struct node *init = NULL;
+   struct token *t;
+
+   if (dcltor->nd_id == BinryNd && dcltor->tok->tok_id == '=') {
+      init = dcltor->u[1].child;
+      dcltor = dcltor->u[0].child;
+      }
+   part_dcltor = dcltor;
+   for (;;) {
+      switch (part_dcltor->nd_id) {
+         case BinryNd:
+            /* ')' or '[' */
+            part_dcltor = part_dcltor->u[0].child;
+            break;
+         case ConCatNd:
+            /* pointer direct-declarator */
+            part_dcltor = part_dcltor->u[1].child;
+            break;
+         case PrefxNd:
+            /* ( ... ) */
+            part_dcltor =  part_dcltor->u[0].child;
+            break;
+         case PrimryNd:
+            t = part_dcltor->tok;
+            if (t->tok_id == Identifier || t->tok_id == TypeDefName) {
+               /*
+                * The identifier has been found, update its symbol table
+                *  entry.
+                */
+               sym = sym_lkup(t->image);
+               sym->u.declare_var.tqual = tqual;
+               sym->u.declare_var.dcltor = dcltor;
+               sym->u.declare_var.init = init;
+               ++sym->ref_cnt;
+               sym->u.declare_var.next = decl_lst;
+               decl_lst = sym;
+               }
+            return;
+         default:
+            return;
+         }
+      }
+   }
+
+/*
+ * tnd_char - indicate in the current declaration context that a tended
+ *  character (pointer?) declaration has been found.
+ */
+void tnd_char()
+   {
+   dcl_stk->kind_dcl = TndStr;
+   dcl_stk->blk_name = NULL;
+   }
+
+/*
+ * tnd_strct - indicate in the current declaration context that a tended
+ *  struct declaration has been found and indicate the struct type.
+ */
+void tnd_strct(t)
+struct token *t;
+   {
+   char *strct_nm;
+
+   strct_nm = t->image;
+   free_t(t);
+
+   if (strct_nm == descrip) {
+      dcl_stk->kind_dcl = TndDesc;
+      dcl_stk->blk_name = NULL;
+      return;
+      }
+   dcl_stk->kind_dcl = TndBlk;
+   dcl_stk->blk_name = strct_nm;
+   }
+
+/*
+ * tnd_strct - indicate in the current declaration context that a tended
+ *  union (pointer?) declaration has been found.
+ */
+void tnd_union(t)
+struct token *t;
+   {
+   /*
+    * Only union block pointers may be tended.
+    */
+   if (t->image != block)
+      yyerror("unsupported tended type");
+   free_t(t);
+   dcl_stk->kind_dcl = TndBlk;
+   dcl_stk->blk_name = NULL;
+   }
diff --git a/src/runtime/Makefile b/src/runtime/Makefile
new file mode 100644
index 0000000..ffa63e8
--- /dev/null
+++ b/src/runtime/Makefile
@@ -0,0 +1,514 @@
+#  Makefile for the Icon run-time system.
+
+include ../../Makedefs
+
+
+HDRS = ../h/define.h ../h/config.h ../h/typedefs.h ../h/monitor.h\
+	  ../h/cstructs.h ../h/cpuconf.h ../h/grttin.h\
+	  ../h/rmacros.h ../h/rexterns.h ../h/rstructs.h \
+	  ../h/rproto.h ../h/mproto.h ../h/sys.h
+
+GRAPHICSHDRS = ../h/graphics.h ../h/xwin.h ../h/mswin.h
+
+COBJS =	../common/long.o ../common/time.o \
+	../common/rswitch.o ../common/xwindow.o \
+	../common/alloc.o ../common/filepart.o ../common/munix.o
+
+
+default: iconx
+all:	 iconx comp_all
+
+$(COBJS):
+	cd ../common; $(MAKE)
+
+
+####################################################################
+#
+# Make entries for iconx
+#
+
+XOBJS =	xcnv.o xdata.o xdef.o xerrmsg.o xextcall.o xfconv.o xfload.o xfmath.o\
+	xfmisc.o xfmonitr.o xfscan.o xfstr.o xfstranl.o xfstruct.o xfsys.o\
+	xfwindow.o ximain.o ximisc.o xinit.o xinterp.o xinvoke.o\
+	xkeyword.o xlmisc.o xoarith.o xoasgn.o xocat.o xocomp.o\
+	xomisc.o xoref.o xoset.o xovalue.o xralc.o xrcoexpr.o xrcomp.o\
+	xrdebug.o xrlrgint.o xrmemmgt.o xrmisc.o xrstruct.o xrsys.o\
+	xrwinrsc.o xrwinsys.o xrwindow.o xrcolor.o xrimage.o
+
+OBJS =	$(XOBJS) $(COBJS)
+
+iconx: $(OBJS)
+	cd ../common; $(MAKE)
+	$(CC) $(RLINK) -o iconx  $(OBJS) $(XL) $(RLIBS) $(TL)
+	cp iconx ../../bin
+	strip $(SFLAGS) ../../bin/iconx$(EXE)
+
+xcnv.o: cnv.r $(HDRS)
+	../../bin/rtt -x cnv.r
+	$(CC) -c $(CFLAGS) xcnv.c
+	rm xcnv.c
+
+xdata.o: data.r $(HDRS) ../h/kdefs.h ../h/fdefs.h ../h/odefs.h
+	../../bin/rtt -x data.r
+	$(CC) -c $(CFLAGS) xdata.c
+	rm xdata.c
+
+xdef.o: def.r $(HDRS)
+	../../bin/rtt -x def.r
+	$(CC) -c $(CFLAGS) xdef.c
+	rm xdef.c
+
+xerrmsg.o: errmsg.r $(HDRS)
+	../../bin/rtt -x errmsg.r
+	$(CC) -c $(CFLAGS) xerrmsg.c
+	rm xerrmsg.c
+
+xextcall.o: extcall.r $(HDRS)
+	../../bin/rtt -x extcall.r
+	$(CC) -c $(CFLAGS) xextcall.c
+	rm xextcall.c
+
+xfconv.o: fconv.r $(HDRS)
+	../../bin/rtt -x fconv.r
+	$(CC) -c $(CFLAGS) xfconv.c
+	rm xfconv.c
+
+xfload.o: fload.r $(HDRS)
+	../../bin/rtt -x fload.r
+	$(CC) -c $(CFLAGS) xfload.c
+	rm xfload.c
+
+xfmath.o: fmath.r $(HDRS)
+	../../bin/rtt -x fmath.r
+	$(CC) -c $(CFLAGS) xfmath.c
+	rm xfmath.c
+
+xfmisc.o: fmisc.r $(HDRS)
+	../../bin/rtt -x fmisc.r
+	$(CC) -c $(CFLAGS) xfmisc.c
+	rm xfmisc.c
+
+xfmonitr.o: fmonitr.r $(HDRS)
+	../../bin/rtt -x fmonitr.r
+	$(CC) -c $(CFLAGS) xfmonitr.c
+	rm xfmonitr.c
+
+xfscan.o: fscan.r $(HDRS)
+	../../bin/rtt -x fscan.r
+	$(CC) -c $(CFLAGS) xfscan.c
+	rm xfscan.c
+
+xfstr.o: fstr.r $(HDRS)
+	../../bin/rtt -x fstr.r
+	$(CC) -c $(CFLAGS) xfstr.c
+	rm xfstr.c
+
+xfstranl.o: fstranl.r $(HDRS)
+	../../bin/rtt -x fstranl.r
+	$(CC) -c $(CFLAGS) xfstranl.c
+	rm xfstranl.c
+
+xfstruct.o: fstruct.r $(HDRS)
+	../../bin/rtt -x fstruct.r
+	$(CC) -c $(CFLAGS) xfstruct.c
+	rm xfstruct.c
+
+xfsys.o: fsys.r $(HDRS)
+	../../bin/rtt -x fsys.r
+	$(CC) -c $(CFLAGS) xfsys.c
+	rm xfsys.c
+
+xfwindow.o: fwindow.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt -x fwindow.r
+	$(CC) -c $(CFLAGS) xfwindow.c
+	rm xfwindow.c
+
+ximain.o: imain.r $(HDRS) ../h/version.h
+	../../bin/rtt -x imain.r
+	$(CC) -c $(CFLAGS) ximain.c
+	rm ximain.c
+
+ximisc.o: imisc.r $(HDRS)
+	../../bin/rtt -x imisc.r
+	$(CC) -c $(CFLAGS) ximisc.c
+	rm ximisc.c
+
+xinit.o: init.r $(HDRS) ../h/odefs.h ../h/version.h
+	../../bin/rtt -x init.r
+	$(CC) -c $(CFLAGS) xinit.c
+	rm xinit.c
+
+xinterp.o: interp.r $(HDRS)
+	../../bin/rtt -x interp.r
+	$(CC) -c $(CFLAGS) xinterp.c
+	rm xinterp.c
+
+xinvoke.o: invoke.r $(HDRS)
+	../../bin/rtt -x invoke.r
+	$(CC) -c $(CFLAGS) xinvoke.c
+	rm xinvoke.c
+
+xkeyword.o: keyword.r $(HDRS) ../h/features.h ../h/version.h
+	../../bin/rtt -x keyword.r
+	$(CC) -c $(CFLAGS) xkeyword.c
+	rm xkeyword.c
+
+xlmisc.o: lmisc.r $(HDRS)
+	../../bin/rtt -x lmisc.r
+	$(CC) -c $(CFLAGS) xlmisc.c
+	rm xlmisc.c
+
+xoarith.o: oarith.r $(HDRS)
+	../../bin/rtt -x oarith.r
+	$(CC) -c $(CFLAGS) xoarith.c
+	rm xoarith.c
+
+xoasgn.o: oasgn.r $(HDRS)
+	../../bin/rtt -x oasgn.r
+	$(CC) -c $(CFLAGS) xoasgn.c
+	rm xoasgn.c
+
+xocat.o: ocat.r $(HDRS)
+	../../bin/rtt -x ocat.r
+	$(CC) -c $(CFLAGS) xocat.c
+	rm xocat.c
+
+xocomp.o: ocomp.r $(HDRS)
+	../../bin/rtt -x ocomp.r
+	$(CC) -c $(CFLAGS) xocomp.c
+	rm xocomp.c
+
+xomisc.o: omisc.r $(HDRS)
+	../../bin/rtt -x omisc.r
+	$(CC) -c $(CFLAGS) xomisc.c
+	rm xomisc.c
+
+xoref.o: oref.r $(HDRS)
+	../../bin/rtt -x oref.r
+	$(CC) -c $(CFLAGS) xoref.c
+	rm xoref.c
+
+xoset.o: oset.r $(HDRS)
+	../../bin/rtt -x oset.r
+	$(CC) -c $(CFLAGS) xoset.c
+	rm xoset.c
+
+xovalue.o: ovalue.r $(HDRS)
+	../../bin/rtt -x ovalue.r
+	$(CC) -c $(CFLAGS) xovalue.c
+	rm xovalue.c
+
+xralc.o: ralc.r $(HDRS)
+	../../bin/rtt -x ralc.r
+	$(CC) -c $(CFLAGS) xralc.c
+	rm xralc.c
+
+xrcoexpr.o: rcoexpr.r $(HDRS)
+	../../bin/rtt -x rcoexpr.r
+	$(CC) -c $(CFLAGS) xrcoexpr.c
+	rm xrcoexpr.c
+
+xrcomp.o: rcomp.r $(HDRS)
+	../../bin/rtt -x rcomp.r
+	$(CC) -c $(CFLAGS) xrcomp.c
+	rm xrcomp.c
+
+xrdebug.o: rdebug.r $(HDRS)
+	../../bin/rtt -x rdebug.r
+	$(CC) -c $(CFLAGS) xrdebug.c
+	rm xrdebug.c
+
+xrlrgint.o: rlrgint.r $(HDRS)
+	../../bin/rtt -x rlrgint.r
+	$(CC) -c $(CFLAGS) xrlrgint.c
+	rm xrlrgint.c
+
+xrmemmgt.o: rmemmgt.r $(HDRS)
+	../../bin/rtt -x rmemmgt.r
+	$(CC) -c $(CFLAGS) xrmemmgt.c
+	rm xrmemmgt.c
+
+xrmisc.o: rmisc.r $(HDRS)
+	../../bin/rtt -x rmisc.r
+	$(CC) -c $(CFLAGS) xrmisc.c
+	rm xrmisc.c
+
+xrstruct.o: rstruct.r $(HDRS)
+	../../bin/rtt -x rstruct.r
+	$(CC) -c $(CFLAGS) xrstruct.c
+	rm xrstruct.c
+
+xrsys.o: rsys.r $(HDRS)
+	../../bin/rtt -x rsys.r
+	$(CC) -c $(CFLAGS) xrsys.c
+	rm xrsys.c
+
+xrwinrsc.o: rwinrsc.r $(HDRS) $(GRAPHICSHDRS) rxrsc.ri
+	../../bin/rtt -x rwinrsc.r
+	$(CC) -c $(CFLAGS) xrwinrsc.c
+	rm xrwinrsc.c
+
+xrwinsys.o: rwinsys.r $(HDRS) $(GRAPHICSHDRS) rxwin.ri
+	../../bin/rtt -x rwinsys.r
+	$(CC) -c $(CFLAGS) xrwinsys.c
+	rm xrwinsys.c
+
+xrwindow.o: rwindow.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt -x rwindow.r
+	$(CC) -c $(CFLAGS) xrwindow.c
+	rm xrwindow.c
+
+xrcolor.o: rcolor.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt -x rcolor.r
+	$(CC) -c $(CFLAGS) xrcolor.c
+	rm xrcolor.c
+
+xrimage.o: rimage.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt -x rimage.r
+	$(CC) -c $(CFLAGS) xrimage.c
+	rm xrimage.c
+
+
+####################################################################
+#
+# Make entries for the compiler library
+#
+
+comp_all: $(COBJS) db_lib
+
+db_lib: rt.db rt.a
+
+#
+# if rt.db is missing or any header files have been updated, recreate
+# rt.db from scratch along with the .o files.
+#
+rt.db: $(HDRS)
+	rm -f rt.db rt.a
+	../../bin/rtt cnv.r data.r def.r errmsg.r fconv.r fload.r fmath.r\
+	  fmisc.r fmonitr.r fscan.r fstr.r fstranl.r fstruct.r\
+	  fsys.r fwindow.r init.r invoke.r keyword.r\
+	  lmisc.r oarith.r oasgn.r ocat.r ocomp.r omisc.r\
+	  oref.r oset.r ovalue.r ralc.r rcoexpr.r rcomp.r\
+	  rdebug.r rlrgint.r rmemmgt.r rmisc.r rstruct.r\
+	  rsys.r rwinrsc.r rwinsys.r rwindow.r rcolor.r rimage.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rt.a: ../common/rswitch.o ../common/long.o ../common/time.o\
+      cnv.o data.o def.o errmsg.o fconv.o fload.o fmath.o fmisc.o fmonitr.o \
+      fscan.o fstr.o fstranl.o fstruct.o fsys.o fwindow.o init.o invoke.o\
+      keyword.o lmisc.o oarith.o oasgn.o ocat.o ocomp.o omisc.o oref.o oset.o\
+      ovalue.o ralc.o rcoexpr.o rcomp.o rdebug.o rlrgint.o rmemmgt.o\
+      rmisc.o rstruct.o rsys.o rwinrsc.o rwinsys.o\
+      rwindow.o rcolor.o rimage.o ../common/xwindow.o ../common/alloc.o
+	rm -f rt.a
+	ar qc rt.a `sed 's/$$/.o/' rttcur.lst` ../common/rswitch.o\
+	    ../common/long.o ../common/time.o\
+	    ../common/xwindow.o ../common/alloc.o
+	ranlib rt.a 2>/dev/null || :
+	cp -p rt.a rt.db ../common/dlrgint.o ../../bin
+
+cnv.o: cnv.r $(HDRS)
+	../../bin/rtt cnv.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+data.o: data.r $(HDRS)
+	../../bin/rtt data.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+def.o: def.r $(HDRS)
+	../../bin/rtt def.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+errmsg.o: errmsg.r $(HDRS)
+	../../bin/rtt errmsg.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fconv.o: fconv.r $(HDRS)
+	../../bin/rtt fconv.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fload.o: fload.r $(HDRS)
+	../../bin/rtt fload.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fmath.o: fmath.r $(HDRS)
+	../../bin/rtt fmath.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fmisc.o: fmisc.r $(HDRS)
+	../../bin/rtt fmisc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fmonitr.o: fmonitr.r $(HDRS)
+	../../bin/rtt fmonitr.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fscan.o: fscan.r $(HDRS)
+	../../bin/rtt fscan.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fstr.o: fstr.r $(HDRS)
+	../../bin/rtt fstr.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fstranl.o: fstranl.r $(HDRS)
+	../../bin/rtt fstranl.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fstruct.o: fstruct.r $(HDRS)
+	../../bin/rtt fstruct.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fsys.o: fsys.r $(HDRS)
+	../../bin/rtt fsys.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+fwindow.o: fwindow.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt fwindow.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+init.o: init.r $(HDRS)
+	../../bin/rtt init.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+invoke.o: invoke.r $(HDRS)
+	../../bin/rtt invoke.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+keyword.o: keyword.r $(HDRS)
+	../../bin/rtt keyword.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+lmisc.o: lmisc.r $(HDRS)
+	../../bin/rtt lmisc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+oarith.o: oarith.r $(HDRS)
+	../../bin/rtt oarith.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+oasgn.o: oasgn.r $(HDRS)
+	../../bin/rtt oasgn.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+ocat.o: ocat.r $(HDRS)
+	../../bin/rtt ocat.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+ocomp.o: ocomp.r $(HDRS)
+	../../bin/rtt ocomp.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+omisc.o: omisc.r $(HDRS)
+	../../bin/rtt omisc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+oref.o: oref.r $(HDRS)
+	../../bin/rtt oref.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+oset.o: oset.r $(HDRS)
+	../../bin/rtt oset.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+ovalue.o: ovalue.r $(HDRS)
+	../../bin/rtt ovalue.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+ralc.o: ralc.r $(HDRS)
+	../../bin/rtt ralc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rcoexpr.o: rcoexpr.r $(HDRS)
+	../../bin/rtt rcoexpr.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rcomp.o: rcomp.r $(HDRS)
+	../../bin/rtt rcomp.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rdebug.o: rdebug.r $(HDRS)
+	../../bin/rtt rdebug.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rlrgint.o: rlrgint.r $(HDRS)
+	../../bin/rtt rlrgint.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rmemmgt.o: rmemmgt.r $(HDRS)
+	../../bin/rtt rmemmgt.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rmisc.o: rmisc.r $(HDRS)
+	../../bin/rtt rmisc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rstruct.o: rstruct.r $(HDRS)
+	../../bin/rtt rstruct.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rsys.o: rsys.r $(HDRS)
+	../../bin/rtt rsys.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rwinrsc.o: rwinrsc.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt rwinrsc.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rwinsys.o: rwinsys.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt rwinsys.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rwindow.o: rwindow.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt rwindow.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rcolor.o: rcolor.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt rcolor.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
+
+rimage.o: rimage.r $(HDRS) $(GRAPHICSHDRS)
+	../../bin/rtt rimage.r
+	$(CC) -c $(CFLAGS) `sed 's/$$/.c/' rttcur.lst`
+	rm `sed 's/$$/.c/' rttcur.lst`
diff --git a/src/runtime/cnv.r b/src/runtime/cnv.r
new file mode 100644
index 0000000..23e1767
--- /dev/null
+++ b/src/runtime/cnv.r
@@ -0,0 +1,1157 @@
+/*
+ * cnv.r -- Conversion routines:
+ *
+ * cnv_c_dbl, cnv_c_int, cnv_c_str, cnv_cset, cnv_ec_int,
+ * cnv_eint, cnv_int, cnv_real, cnv_str, cnv_tcset, cnv_tstr, deref,
+ * getdbl, strprc, bi_strprc
+ *
+ * Service routines: itos, ston, radix, cvpos
+ *
+ * Philosophy: certain redundancy is present which could be avoided,
+ * and nested conversion calls are avoided due to the importance of
+ * minimizing these routines' costs.
+ *
+ * Assumed: the C compiler must handle assignments of C integers to
+ * C double variables and vice-versa.  Hopefully production C compilers
+ * have managed to eliminate bugs related to these assignments.
+ *
+ * Note: calls beginning with EV are empty macros unless EventMon
+ * is defined.
+ */
+
+#define tonum(c)	(isdigit(c) ? (c)-'0' : 10+(((c)|(040))-'a'))
+
+/*
+ * Prototypes for static functions.
+ */
+static void cstos (unsigned int *cs, dptr dp, char *s);
+static void itos (C_integer num, dptr dp, char *s);
+static int ston (dptr sp, union numeric *result);
+static int tmp_str (char *sbuf, dptr s, dptr d);
+
+/*
+ * cnv_c_dbl - cnv:C_double(*s, *d), convert a value directly into a C double
+ */
+int cnv_c_dbl(s, d)
+dptr s;
+double *d;
+   {
+   tended struct descrip result, cnvstr;
+   char sbuf[MaxCvtLen];
+   union numeric numrc;
+
+   type_case *s of {
+      real: {
+         GetReal(s, *d);
+         return 1;
+         }
+      integer: {
+
+#ifdef LargeInts
+         if (Type(*s) == T_Lrgint)
+            *d = bigtoreal(s);
+         else
+#endif					/* LargeInts */
+
+            *d = IntVal(*s);
+
+         return 1;
+         }
+      string: {
+         /* fall through */
+         }
+      cset: {
+        tmp_str(sbuf, s, &cnvstr);
+        s = &cnvstr;
+        }
+      default: {
+        return 0;
+        }
+      }
+
+   /*
+    * s is now an string.
+    */
+   switch( ston(s, &numrc) ) {
+      case T_Integer:
+         *d = numrc.integer;
+         return 1;
+
+#ifdef LargeInts
+      case T_Lrgint:
+         result.dword = D_Lrgint;
+	 BlkLoc(result) = (union block *)numrc.big;
+         *d = bigtoreal(&result);
+         return 1;
+#endif					/* LargeInts */
+
+      case T_Real:
+         *d = numrc.real;
+         return 1;
+      default:
+         return 0;
+      }
+  }
+
+/*
+ * cnv_c_int - cnv:C_integer(*s, *d), convert a value directly into a C_integer
+ */
+int cnv_c_int(s, d)
+dptr s;
+C_integer *d;
+   {
+   tended struct descrip cnvstr, result;
+   union numeric numrc;
+   char sbuf[MaxCvtLen];
+
+   type_case *s of {
+      integer: {
+
+#ifdef LargeInts
+         if (Type(*s) == T_Lrgint) {
+            return 0;
+            }
+#endif					/* LargeInts */
+
+         *d = IntVal(*s);
+         return 1;
+         }
+      real: {
+         double dbl;
+         GetReal(s,dbl);
+         if (dbl > MaxLong || dbl < MinLong) {
+            return 0;
+            }
+         *d = dbl;
+         return 1;
+         }
+      string: {
+         /* fall through */
+         }
+      cset: {
+        tmp_str(sbuf, s, &cnvstr);
+        s = &cnvstr;
+        }
+      default: {
+         return 0;
+         }
+      }
+
+   /*
+    * s is now a string.
+    */
+   switch( ston(s, &numrc) ) {
+      case T_Integer: {
+         *d = numrc.integer;
+         return 1;
+	 }
+      case T_Real: {
+         double dbl = numrc.real;
+         if (dbl > MaxLong || dbl < MinLong) {
+            return 0;
+            }
+         *d = dbl;
+         return 1;
+         }
+      default:
+         return 0;
+      }
+   }
+
+/*
+ * cnv_c_str - cnv:C_string(*s, *d), convert a value into a C (and Icon) string
+ */
+int cnv_c_str(s, d)
+dptr s;
+dptr d;
+   {
+   /*
+    * Get the string to the end of the string region and append a '\0'.
+    */
+
+   if (!is:string(*s)) {
+      if (!cnv_str(s, d)) {
+         return 0;
+         }
+      }
+   else {
+      *d = *s;
+      }
+
+   /*
+    * See if the end of d is already at the end of the string region
+    * and there is room for one more byte.
+    */
+   if ((StrLoc(*d) + StrLen(*d) == strfree) && (strfree != strend)) {
+      Protect(alcstr("\0", 1), fatalerr(0,NULL));
+      ++StrLen(*d);
+      }
+   else {
+      register word slen = StrLen(*d);
+      register char *sp, *dp;
+      Protect(dp = alcstr(NULL,slen+1), fatalerr(0,NULL));
+      StrLen(*d) = StrLen(*d)+1;
+      sp = StrLoc(*d);
+      StrLoc(*d) = dp;
+      while (slen-- > 0)
+         *dp++ = *sp++;
+      *dp = '\0';
+      }
+
+   return 1;
+   }
+
+/*
+ * cnv_cset - cnv:cset(*s, *d), convert to a cset
+ */
+int cnv_cset(s, d)
+dptr s, d;
+   {
+   tended struct descrip str;
+   char sbuf[MaxCvtLen];
+   register C_integer l;
+   register char *s1;        /* does not need to be tended */
+
+   EVValD(s, E_Aconv);
+   EVValD(&csetdesc, E_Tconv);
+
+   if (is:cset(*s)) {
+      *d = *s;
+      EVValD(s, E_Nconv);
+      return 1;
+      }
+   /*
+    * convert to a string and then add its contents to the cset
+    */
+   if (tmp_str(sbuf, s, &str)) {
+      Protect(BlkLoc(*d) = (union block *)alccset(), fatalerr(0,NULL));
+      d->dword = D_Cset;
+      s1 = StrLoc(str);
+      l = StrLen(str);
+      while(l--) {
+         Setb(*s1, *d);
+	 s1++;
+         }
+      EVValD(d, E_Sconv);
+      return 1;
+      }
+   else {
+      EVValD(s, E_Fconv);
+      return 0;
+      }
+  }
+
+/*
+ * cnv_ec_int - cnv:(exact)C_integer(*s, *d), convert to an exact C integer
+ */
+int cnv_ec_int(s, d)
+dptr s;
+C_integer *d;
+   {
+   tended struct descrip cnvstr;
+   union numeric numrc;
+   char sbuf[MaxCvtLen];
+
+   type_case *s of {
+      integer: {
+
+#ifdef LargeInts
+         if (Type(*s) == T_Lrgint) {
+            return 0;
+            }
+#endif					/* LargeInts */
+         *d = IntVal(*s);
+         return 1;
+         }
+      string: {
+         /* fall through */
+         }
+      cset: {
+        tmp_str(sbuf, s, &cnvstr);
+        s = &cnvstr;
+        }
+      default: {
+         return 0;
+         }
+      }
+
+   /*
+    * s is now a string.
+    */
+   if (ston(s, &numrc) == T_Integer) {
+      *d = numrc.integer;
+      return 1;
+      }
+   else {
+      return 0;
+      }
+   }
+
+/*
+ * cnv_eint - cnv:(exact)integer(*s, *d), convert to an exact integer
+ */
+int cnv_eint(s, d)
+dptr s, d;
+   {
+   tended struct descrip cnvstr;
+   char sbuf[MaxCvtLen];
+   union numeric numrc;
+
+   type_case *s of {
+      integer: {
+         *d = *s;
+         return 1;
+         }
+      string: {
+         /* fall through */
+         }
+      cset: {
+        tmp_str(sbuf, s, &cnvstr);
+        s = &cnvstr;
+        }
+      default: {
+        return 0;
+        }
+      }
+
+   /*
+    * s is now a string.
+    */
+   switch (ston(s, &numrc)) {
+      case T_Integer:
+         MakeInt(numrc.integer, d);
+	 return 1;
+
+#ifdef LargeInts
+      case T_Lrgint:
+         d->dword = D_Lrgint;
+	 BlkLoc(*d) = (union block *)numrc.big;
+         return 1;
+#endif					/* LargeInts */
+
+      default:
+         return 0;
+      }
+   }
+
+/*
+ * cnv_int - cnv:integer(*s, *d), convert to integer
+ */
+int cnv_int(s, d)
+dptr s, d;
+   {
+   tended struct descrip cnvstr;
+   char sbuf[MaxCvtLen];
+   union numeric numrc;
+
+   EVValD(s, E_Aconv);
+   EVValD(&zerodesc, E_Tconv);
+
+   type_case *s of {
+      integer: {
+         *d = *s;
+         EVValD(s, E_Nconv);
+         return 1;
+         }
+      real: {
+         double dbl;
+         GetReal(s,dbl);
+         if (dbl > MaxLong || dbl < MinLong) {
+
+#ifdef LargeInts
+            if (realtobig(s, d) == Succeeded) {
+               EVValD(d, E_Sconv);
+               return 1;
+               }
+            else {
+               EVValD(s, E_Fconv);
+               return 0;
+               }
+#else					/* LargeInts */
+            EVValD(s, E_Fconv);
+            return 0;
+#endif					/* LargeInts */
+	    }
+         MakeInt((word)dbl,d);
+         EVValD(d, E_Sconv);
+         return 1;
+         }
+      string: {
+         /* fall through */
+         }
+      cset: {
+        tmp_str(sbuf, s, &cnvstr);
+        s = &cnvstr;
+        }
+      default: {
+         EVValD(s, E_Fconv);
+         return 0;
+         }
+      }
+
+   /*
+    * s is now a string.
+    */
+   switch( ston(s, &numrc) ) {
+
+#ifdef LargeInts
+      case T_Lrgint:
+         d->dword = D_Lrgint;
+	 BlkLoc(*d) = (union block *)numrc.big;
+         EVValD(d, E_Sconv);
+	 return 1;
+#endif					/* LargeInts */
+
+      case T_Integer:
+         MakeInt(numrc.integer,d);
+         EVValD(d, E_Sconv);
+         return 1;
+      case T_Real: {
+         double dbl = numrc.real;
+         if (dbl > MaxLong || dbl < MinLong) {
+
+#ifdef LargeInts
+            if (realtobig(s, d) == Succeeded) {
+               EVValD(d, E_Sconv);
+               return 1;
+               }
+            else {
+               EVValD(s, E_Fconv);
+               return 0;
+               }
+#else					/* LargeInts */
+            EVValD(s, E_Fconv);
+            return 0;
+#endif					/* LargeInts */
+	    }
+         MakeInt((word)dbl,d);
+         EVValD(d, E_Sconv);
+         return 1;
+         }
+      default:
+         EVValD(s, E_Fconv);
+         return 0;
+      }
+   }
+
+/*
+ * cnv_real - cnv:real(*s, *d), convert to real
+ */
+int cnv_real(s, d)
+dptr s, d;
+   {
+   double dbl;
+
+   EVValD(s, E_Aconv);
+   EVValD(&rzerodesc, E_Tconv);
+
+   if (cnv_c_dbl(s, &dbl)) {
+      Protect(BlkLoc(*d) = (union block *)alcreal(dbl), fatalerr(0,NULL));
+      d->dword = D_Real;
+      EVValD(d, E_Sconv);
+      return 1;
+      }
+   else
+      EVValD(s, E_Fconv);
+      return 0;
+   }
+
+/*
+ * cnv_str - cnv:string(*s, *d), convert to a string
+ */
+int cnv_str(s, d)
+dptr s, d;
+   {
+   char sbuf[MaxCvtLen];
+
+   EVValD(s, E_Aconv);
+   EVValD(&emptystr, E_Tconv);
+
+   type_case *s of {
+      string: {
+         *d = *s;
+         EVValD(s, E_Nconv);
+         return 1;
+         }
+      integer: {
+
+#ifdef LargeInts
+         if (Type(*s) == T_Lrgint) {
+            word slen;
+            word dlen;
+
+            slen = (BlkLoc(*s)->bignumblk.lsd - BlkLoc(*s)->bignumblk.msd +1);
+            dlen = slen * NB * 0.3010299956639812;	/* 1 / log2(10) */
+	    bigtos(s,d);
+	    }
+         else
+#endif					/* LargeInts */
+
+         itos(IntVal(*s), d, sbuf);
+	 }
+      real: {
+         double res;
+         GetReal(s, res);
+         rtos(res, d, sbuf);
+         }
+      cset:
+         cstos(BlkLoc(*s)->cset.bits, d, sbuf);
+      default: {
+         EVValD(s, E_Fconv);
+         return 0;
+         }
+      }
+   Protect(StrLoc(*d) = alcstr(StrLoc(*d), StrLen(*d)), fatalerr(0,NULL));
+   EVValD(d, E_Sconv);
+   return 1;
+   }
+
+/*
+ * cnv_tcset - cnv:tmp_cset(*s, *d), convert to a temporary cset
+ */
+int cnv_tcset(cbuf, s, d)
+struct b_cset *cbuf;
+dptr s, d;
+   {
+   struct descrip tmpstr;
+   char sbuf[MaxCvtLen];
+   register char *s1;
+   C_integer l;
+
+   EVValD(s, E_Aconv);
+   EVValD(&csetdesc, E_Tconv);
+
+   if (is:cset(*s)) {
+      *d = *s;
+      EVValD(s, E_Nconv);
+      return 1;
+      }
+   if (tmp_str(sbuf, s, &tmpstr)) {
+      for (l = 0; l < CsetSize; l++)
+          cbuf->bits[l] = 0;
+      d->dword = D_Cset;
+      BlkLoc(*d) = (union block *)cbuf;
+      s1 = StrLoc(tmpstr);
+      l = StrLen(tmpstr);
+      while(l--) {
+         Setb(*s1, *d);
+	 s1++;
+         }
+      EVValD(d, E_Sconv);
+      return 1;
+      }
+   else {
+      EVValD(s, E_Fconv);
+      return 0;
+      }
+   }
+
+/*
+ * cnv_tstr - cnv:tmp_string(*s, *d), convert to a temporary string
+ */
+int cnv_tstr(sbuf, s, d)
+char *sbuf;
+dptr s;
+dptr d;
+   {
+   EVValD(s, E_Aconv);
+   EVValD(&emptystr, E_Tconv);
+
+   if (is:string(*s)) {
+      *d = *s;
+      EVValD(s, E_Nconv);
+      return 1;
+      }
+   else if (tmp_str(sbuf, s, d)) {
+      EVValD(d, E_Sconv);
+      return 1;
+      }
+   else {
+      EVValD(s, E_Fconv);
+      return 0;
+      }
+   }
+
+/*
+ * deref - dereference a descriptor.
+ */
+void deref(s, d)
+dptr s, d;
+   {
+   /*
+    * no allocation is done, so nothing need be tended.
+    */
+   register union block *bp;
+   struct descrip v;
+   register union block **ep;
+   int res;
+
+   if (!is:variable(*s)) {
+      *d = *s;
+      }
+   else type_case *s of {
+      tvsubs: {
+         /*
+          * A substring trapped variable is being dereferenced.
+          *  Point bp to the trapped variable block and v to
+          *  the string.
+          */
+         bp = BlkLoc(*s);
+         deref(&bp->tvsubs.ssvar, &v);
+         if (!is:string(v))
+            fatalerr(103, &v);
+         if (bp->tvsubs.sspos + bp->tvsubs.sslen - 1 > StrLen(v))
+            fatalerr(205, NULL);
+         /*
+          * Make a descriptor for the substring by getting the
+          *  length and pointing into the string.
+          */
+         StrLen(*d) = bp->tvsubs.sslen;
+         StrLoc(*d) = StrLoc(v) + bp->tvsubs.sspos - 1;
+        }
+
+      tvtbl: {
+         /*
+          * Look up the element in the table.
+          */
+         bp = BlkLoc(*s);
+         ep = memb(bp->tvtbl.clink,&bp->tvtbl.tref,bp->tvtbl.hashnum,&res);
+         if (res == 1)
+            *d = (*ep)->telem.tval;			/* found; use value */
+         else
+            *d = bp->tvtbl.clink->table.defvalue;	/* nope; use default */
+         }
+
+      kywdint:
+      kywdpos:
+      kywdsubj:
+      kywdevent:
+      kywdwin:
+      kywdstr:
+         *d = *VarLoc(*s);
+
+      default:
+         /*
+          * An ordinary variable is being dereferenced.
+          */
+         *d = *(dptr)((word *)VarLoc(*s) + Offset(*s));
+      }
+   }
+
+/*
+ * getdbl - return as a double the value inside a real block.
+ */
+double getdbl(dp)
+dptr dp;
+   {
+   double d;
+   GetReal(dp, d);
+   return d;
+   }
+
+/*
+ * tmp_str - Convert to temporary string.
+ */
+static int tmp_str(sbuf, s, d)
+char *sbuf;
+dptr s;
+dptr d;
+   {
+   type_case *s of {
+      string:
+         *d = *s;
+      integer: {
+
+#ifdef LargeInts
+         if (Type(*s) == T_Lrgint) {
+            word slen;
+            word dlen;
+
+            slen = (BlkLoc(*s)->bignumblk.lsd - BlkLoc(*s)->bignumblk.msd +1);
+            dlen = slen * NB * 0.3010299956639812;	/* 1 / log2(10) */
+	    bigtos(s,d);
+	    }
+         else
+#endif					/* LargeInts */
+
+         itos(IntVal(*s), d, sbuf);
+	 }
+      real: {
+         double res;
+         GetReal(s, res);
+         rtos(res, d, sbuf);
+         }
+      cset:
+         cstos(BlkLoc(*s)->cset.bits, d, sbuf);
+      default:
+         return 0;
+      }
+   return 1;
+   }
+
+/*
+ * dp_pnmcmp - do a string comparison of a descriptor to the procedure
+ *   name in a pstrnm struct; used in call to qsearch().
+ */
+int dp_pnmcmp(pne,dp)
+struct pstrnm *pne;
+struct descrip *dp;
+{
+   struct descrip d;
+   StrLen(d) = strlen(pne->pstrep);
+   StrLoc(d) = pne->pstrep;
+   return lexcmp(&d,dp);
+}
+
+/*
+ * bi_strprc - convert a string to a (built-in) function or operator.
+ */
+struct b_proc *bi_strprc(s, arity)
+dptr s;
+C_integer arity;
+   {
+   C_integer i;
+   struct pstrnm *pp;
+
+   if (!StrLen(*s))
+      return NULL;
+
+   /*
+    * See if the string represents an operator. In this case the arity
+    *  of the operator must match the one given.
+    */
+   if (!isalpha(*StrLoc(*s))) {
+      for (i = 0; i < op_tbl_sz; ++i)
+	 if (eq(s, &op_tbl[i].pname) && (arity == op_tbl[i].nparam ||
+					 op_tbl[i].nparam == -1))
+	    return &op_tbl[i];
+      return NULL;
+      }
+
+   /*
+    * See if the string represents a built-in function.
+    */
+#if COMPILER
+   for (i = 0; i < n_globals; ++i)
+      if (eq(s, &gnames[i]))
+	 return builtins[i];  /* may be null */
+#else					/* COMPILER */
+   pp = (struct pstrnm *)qsearch((char *)s,(char *)pntab,pnsize,
+				 sizeof(struct pstrnm),dp_pnmcmp);
+   if (pp!=NULL)
+      return (struct b_proc *)pp->pblock;
+#endif					/* !COMPILER */
+
+   return NULL;
+   }
+
+/*
+ * strprc - convert a string to a procedure.
+ */
+struct b_proc *strprc(s, arity)
+dptr s;
+C_integer arity;
+   {
+   C_integer i;
+
+   /*
+    * See if the string is the name of a global variable.
+    */
+   for (i = 0; i < n_globals; ++i)
+      if (eq(s, &gnames[i])) {
+         if (is:proc(globals[i]))
+            return (struct b_proc *)BlkLoc(globals[i]);
+         else
+            return NULL;
+         }
+
+   return bi_strprc(s,arity);
+   }
+
+/*
+ * Service routines
+ */
+
+/*
+ * itos - convert the integer num into a string using s as a buffer and
+ *  making q a descriptor for the resulting string.
+ */
+
+static void itos(num, dp, s)
+C_integer num;
+dptr dp;
+char *s;
+   {
+   register char *p;
+   long ival;
+   static char *maxneg = MaxNegInt;
+
+   p = s + MaxCvtLen - 1;
+   ival = num;
+
+   *p = '\0';
+   if (num >= 0L)
+      do {
+	 *--p = ival % 10L + '0';
+	 ival /= 10L;
+	 } while (ival != 0L);
+   else {
+      if (ival == -ival) {      /* max negative value */
+	 p -= strlen (maxneg);
+	 sprintf (p, "%s", maxneg);
+         }
+      else {
+	ival = -ival;
+	do {
+	   *--p = '0' + (ival % 10L);
+	   ival /= 10L;
+	   } while (ival != 0L);
+	*--p = '-';
+	}
+      }
+
+   StrLen(*dp) = s + MaxCvtLen - 1 - p;
+   StrLoc(*dp) = p;
+   }
+
+
+/*
+ * ston - convert a string to a numeric quantity if possible.
+ * Returns a typecode or CvtFail.  Its answer is in the dptr,
+ * unless its a double, in which case its in the union numeric
+ * (we do this to avoid allocating a block for a real
+ * that will later be used directly as a C_double).
+ */
+static int ston(sp, result)
+dptr sp;
+union numeric *result;
+   {
+   register char *s = StrLoc(*sp), *end_s;
+   register int c;
+   int realflag = 0;	/* indicates a real number */
+   char msign = '+';    /* sign of mantissa */
+   char esign = '+';    /* sign of exponent */
+   double mantissa = 0; /* scaled mantissa with no fractional part */
+   long lresult = 0;	/* integer result */
+   int scale = 0;	/* number of decimal places to shift mantissa */
+   int digits = 0;	/* total number of digits seen */
+   int sdigits = 0;	/* number of significant digits seen */
+   int exponent = 0;	/* exponent part of real number */
+   double fiveto;	/* holds 5^scale */
+   double power;	/* holds successive squares of 5 to compute fiveto */
+   int err_no;
+   char *ssave;         /* holds original ptr for bigradix */
+
+   if (StrLen(*sp) == 0)
+      return CvtFail;
+   end_s = s + StrLen(*sp);
+   c = *s++;
+
+   /*
+    * Skip leading white space.
+    */
+   while (isspace(c))
+      if (s < end_s)
+         c = *s++;
+      else
+         return CvtFail;
+
+   /*
+    * Check for sign.
+    */
+   if (c == '+' || c == '-') {
+      msign = c;
+      c = (s < end_s) ? *s++ : ' ';
+      }
+
+   ssave = s - 1;   /* set pointer to beginning of digits in case it's needed */
+
+   /*
+    * Get integer part of mantissa.
+    */
+   while (isdigit(c)) {
+      digits++;
+      if (mantissa < Big) {
+	 mantissa = mantissa * 10 + (c - '0');
+         lresult = lresult * 10 + (c - '0');
+	 if (mantissa > 0.0)
+	    sdigits++;
+	 }
+      else
+	 scale++;
+      c = (s < end_s) ? *s++ : ' ';
+      }
+
+   /*
+    * Check for based integer.
+    */
+   if (c == 'r' || c == 'R') {
+      int rv;
+#ifdef LargeInts
+      rv = bigradix((int)msign, (int)mantissa, s, end_s, result);
+      if (rv == Error)
+         fatalerr(0, NULL);
+#else					/* LargeInts */
+      rv = radix((int)msign, (int)mantissa, s, end_s, result);
+#endif					/* LargeInts */
+      return rv;
+      }
+
+   /*
+    * Get fractional part of mantissa.
+    */
+   if (c == '.') {
+      realflag++;
+      c = (s < end_s) ? *s++ : ' ';
+      while (isdigit(c)) {
+	 digits++;
+	 if (mantissa < Big) {
+	    mantissa = mantissa * 10 + (c - '0');
+	    lresult = lresult * 10 + (c - '0');
+	    scale--;
+	    if (mantissa > 0.0)
+	       sdigits++;
+	    }
+         c = (s < end_s) ? *s++ : ' ';
+	 }
+      }
+
+   /*
+    * Check that at least one digit has been seen so far.
+    */
+   if (digits == 0)
+      return CvtFail;
+
+   /*
+    * Get exponent part.
+    */
+   if (c == 'e' || c == 'E') {
+      realflag++;
+      c = (s < end_s) ? *s++ : ' ';
+      if (c == '+' || c == '-') {
+	 esign = c;
+         c = (s < end_s) ? *s++ : ' ';
+	 }
+      if (!isdigit(c))
+	 return CvtFail;
+      while (isdigit(c)) {
+	 exponent = exponent * 10 + (c - '0');
+         c = (s < end_s) ? *s++ : ' ';
+	 }
+      scale += (esign == '+') ? exponent : -exponent;
+      }
+
+   /*
+    * Skip trailing white space and make sure there is nothing else left
+    *  in the string. Note, if we have already reached end-of-string,
+    *  c has been set to a space.
+    */
+   while (isspace(c) && s < end_s)
+      c = *s++;
+   if (!isspace(c))
+      return CvtFail;
+
+   /*
+    * Test for integer.
+    */
+   if (!realflag && !scale && mantissa >= MinLong && mantissa <= MaxLong) {
+      result->integer = (msign == '+' ? lresult : -lresult);
+      return T_Integer;
+      }
+
+#ifdef LargeInts
+   /*
+    * Test for bignum.
+    */
+#if COMPILER
+   if (largeints)
+#endif					/* COMPILER */
+      if (!realflag) {
+         int rv;
+         rv = bigradix((int)msign, 10, ssave, end_s, result);
+         if (rv == Error)
+            fatalerr(0, NULL);
+         return rv;
+         }
+#endif					/* LargeInts */
+
+   if (!realflag)
+      return CvtFail;		/* don't promote to real if integer format */
+
+   /*
+    * Rough tests for overflow and underflow.
+    */
+   if (sdigits + scale > LogHuge)
+      return CvtFail;
+
+   if (sdigits + scale < -LogHuge) {
+      result->real = 0.0;
+      return T_Real;
+      }
+
+   /*
+    * Put the number together by multiplying the mantissa by 5^scale and
+    *  then using ldexp() to multiply by 2^scale.
+    */
+
+   exponent = (scale > 0)? scale : -scale;
+   fiveto = 1.0;
+   power = 5.0;
+   for (;;) {
+      if (exponent & 01)
+	 fiveto *= power;
+      exponent >>= 1;
+      if (exponent == 0)
+	 break;
+      power *= power;
+      }
+   if (scale > 0)
+      mantissa *= fiveto;
+   else
+      mantissa /= fiveto;
+
+   err_no = 0;
+   mantissa = ldexp(mantissa, scale);
+   if (err_no > 0 && mantissa > 0)
+      /*
+       * ldexp caused overflow.
+       */
+      return CvtFail;
+
+   if (msign == '-')
+      mantissa = -mantissa;
+   result->real = mantissa;
+   return T_Real;
+   }
+
+#if COMPILER || !(defined LargeInts)
+/*
+ * radix - convert string s in radix r into an integer in *result.  sign
+ *  will be either '+' or '-'.
+ */
+int radix(sign, r, s, end_s, result)
+int sign;
+register int r;
+register char *s;
+register char *end_s;
+union numeric *result;
+   {
+   register int c;
+   long num;
+
+   if (r < 2 || r > 36)
+      return CvtFail;
+   c = (s < end_s) ? *s++ : ' ';
+   num = 0L;
+   while (isalnum(c)) {
+      c = tonum(c);
+      if (c >= r)
+	 return CvtFail;
+      num = num * r + c;
+      c = (s < end_s) ? *s++ : ' ';
+      }
+
+   /*
+    * Skip trailing white space and make sure there is nothing else left
+    *  in the string. Note, if we have already reached end-of-string,
+    *  c has been set to a space.
+    */
+   while (isspace(c) && s < end_s)
+      c = *s++;
+   if (!isspace(c))
+      return CvtFail;
+
+   result->integer = (sign == '+' ? num : -num);
+
+   return T_Integer;
+   }
+#endif					/* COMPILER || !(defined LargeInts) */
+
+
+/*
+ * cvpos - convert position to strictly positive position
+ *  given length.
+ */
+
+word cvpos(pos, len)
+long pos;
+register long len;
+   {
+   register word p;
+
+   /*
+    * Make sure the position is in the range of an int. (?)
+    */
+   if ((long)(p = pos) != pos)
+      return CvtFail;
+   /*
+    * Make sure the position is within range.
+    */
+   if (p < -len || p > len + 1)
+      return CvtFail;
+   /*
+    * If the position is greater than zero, just return it.  Otherwise,
+    *  convert the zero/negative position.
+    */
+   if (pos > 0)
+      return p;
+   return (len + p + 1);
+   }
+
+double dblZero = 0.0;
+
+/*
+ * rtos - convert the real number n into a string using s as a buffer and
+ *  making a descriptor for the resulting string.
+ */
+void rtos(n, dp, s)
+double n;
+dptr dp;
+char *s;
+   {
+   s++;					/* leave room for leading zero */
+   sprintf(s, "%.*g", Precision, n + dblZero);   /* format, avoiding -0 */
+
+   /*
+    * Now clean up possible messes.
+    */
+   while (*s == ' ')			/* delete leading blanks */
+      s++;
+   if (*s == '.') {			/* prefix 0 to initial period */
+      s--;
+      *s = '0';
+      }
+   else if (!strchr(s, '.') && !strchr(s,'e') && !strchr(s,'E'))
+         strcat(s, ".0");		/* if no decimal point or exp. */
+   if (s[strlen(s) - 1] == '.')		/* if decimal point is at end ... */
+      strcat(s, "0");
+   StrLen(*dp) = strlen(s);
+   StrLoc(*dp) = s;
+   }
+
+/*
+ * cstos - convert the cset bit array pointed at by cs into a string using
+ *  s as a buffer and making a descriptor for the resulting string.
+ */
+
+static void cstos(cs, dp, s)
+unsigned int *cs;
+dptr dp;
+char *s;
+   {
+   register unsigned int w;
+   register int j, i;
+   register char *p;
+
+   p = s;
+   for (i = 0; i < CsetSize; i++) {
+      if (cs[i])
+	 for (j=i*IntBits, w=cs[i]; w; j++, w >>= 1)
+	    if (w & 01)
+	       *p++ = (char)j;
+      }
+   *p = '\0';
+
+   StrLen(*dp) = p - s;
+   StrLoc(*dp) = s;
+   }
diff --git a/src/runtime/data.r b/src/runtime/data.r
new file mode 100644
index 0000000..1a276bd
--- /dev/null
+++ b/src/runtime/data.r
@@ -0,0 +1,401 @@
+/*
+ * data.r -- Various interpreter data tables.
+ */
+
+#if !COMPILER
+
+struct b_proc Bnoproc;
+
+#ifdef EventMon
+struct b_iproc mt_llist = {
+   6, (sizeof(struct b_proc) - sizeof(struct descrip)), Ollist,
+   0, -1,  0, 0, {sizeof( "[...]")-1, "[...]"}};
+#endif					/* EventMon */
+
+
+/*
+ * External declarations for function blocks.
+ */
+
+#define FncDef(p,n) extern struct b_proc Cat(B,p);
+#define FncDefV(p) extern struct b_proc Cat(B,p);
+#passthru #undef exit
+#undef exit
+#include "../h/fdefs.h"
+#undef FncDef
+#undef FncDefV
+
+#define OpDef(p,n,s,u) extern struct b_proc Cat(B,p);
+#include "../h/odefs.h"
+#undef OpDef
+
+extern struct b_proc Bbscan;
+extern struct b_proc Bescan;
+extern struct b_proc Bfield;
+extern struct b_proc Blimit;
+extern struct b_proc Bllist;
+
+
+
+
+struct b_proc *opblks[] = {
+	NULL,
+#define OpDef(p,n,s,u) Cat(&B,p),
+#include "../h/odefs.h"
+#undef OpDef
+   &Bbscan,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   &Bescan,
+   NULL,
+   &Bfield,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   NULL,
+   &Blimit,
+   &Bllist,
+   NULL,
+   NULL,
+   NULL
+   };
+
+/*
+ * Array of names and corresponding functions.
+ *  Operators are kept in a similar table, op_tbl.
+ */
+
+struct pstrnm pntab[] = {
+
+#define FncDef(p,n) Lit(p), Cat(&B,p),
+#define FncDefV(p) Lit(p), Cat(&B,p),
+#include "../h/fdefs.h"
+#undef FncDef
+#undef FncDefV
+
+	0,		 0
+	};
+
+int pnsize = (sizeof(pntab) / sizeof(struct pstrnm)) - 1;
+
+#endif					/* COMPILER */
+
+/*
+ * Structures for built-in values.  Parts of some of these structures are
+ *  initialized later. Since some C compilers cannot handle any partial
+ *  initializations, all parts are initialized later if any have to be.
+ */
+
+/*
+ * blankcs; a cset consisting solely of ' '.
+ */
+struct b_cset  blankcs = {
+   T_Cset,
+   1,
+   cset_display(0, 0, 01, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
+   };
+
+/*
+ * lparcs; a cset consisting solely of '('.
+ */
+struct b_cset  lparcs = {
+   T_Cset,
+   1,
+   cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
+   };
+
+/*
+ * rparcs; a cset consisting solely of ')'.
+ */
+struct b_cset  rparcs = {
+   T_Cset,
+   1,
+   cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
+   };
+
+/*
+ * fullcs - all 256 bits on.
+ */
+struct b_cset  fullcs = {
+   T_Cset,
+   256,
+   cset_display(~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0,
+		~0, ~0, ~0, ~0, ~0, ~0, ~0, ~0)
+   };
+
+#if !COMPILER
+
+/*
+ * Built-in csets
+ */
+
+/*
+ * &digits; bits corresponding to 0-9 are on.
+ */
+struct b_cset  k_digits = {
+   T_Cset,
+   10,
+
+   cset_display(0,  0,	0,  0x3ff, 0,  0, 0,  0,
+		0,  0,	0,  0,	 0,  0,	 0,  0)
+   };
+
+/*
+ * Cset for &lcase; bits corresponding to lowercase letters are on.
+ */
+struct b_cset  k_lcase = {
+   T_Cset,
+   26,
+
+   cset_display(0,  0,	0,  0,	0,  0,	~01,  03777,
+		0,  0,	0,  0,	0,  0,	0,  0)
+   };
+
+/*
+ * &ucase; bits corresponding to uppercase characters are on.
+ */
+struct b_cset  k_ucase = {
+   T_Cset,
+   26,
+
+   cset_display(0,  0,	0,  0,	~01,  03777, 0, 0,
+		0,  0,	0,  0,	0,  0,	0,  0)
+   };
+
+/*
+ * &letters; bits corresponding to letters are on.
+ */
+struct b_cset  k_letters = {
+   T_Cset,
+   52,
+
+   cset_display(0,  0,	0,  0,	~01,  03777, ~01, 03777,
+		0,  0,	0,  0,	0,  0,	0,  0)
+   };
+#endif					/* COMPILER */
+
+/*
+ * Built-in files.
+ */
+
+#ifndef MultiThread
+struct b_file  k_errout = {T_File, NULL, Fs_Write};	/* &errout */
+struct b_file  k_input = {T_File, NULL, Fs_Read};	/* &input */
+struct b_file  k_output = {T_File, NULL, Fs_Write};	/* &output */
+#endif					/* MultiThread */
+
+#ifdef EventMon
+/*
+ *  Real block needed for event monitoring.
+ */
+struct b_real realzero = {T_Real, 0.0};
+#endif					/* EventMon */
+
+/*
+ * Keyword variables.
+ */
+#ifndef MultiThread
+struct descrip kywd_err = {D_Integer};  /* &error */
+struct descrip kywd_pos = {D_Integer};	/* &pos */
+struct descrip kywd_prog;		/* &progname */
+struct descrip k_subject;		/* &subject */
+struct descrip kywd_ran = {D_Integer};	/* &random */
+struct descrip kywd_trc = {D_Integer};	/* &trace */
+struct descrip k_eventcode = {D_Null};	/* &eventcode */
+struct descrip k_eventsource = {D_Null};/* &eventsource */
+struct descrip k_eventvalue = {D_Null};	/* &eventvalue */
+
+#endif					/* MultiThread */
+
+#ifdef FncTrace
+struct descrip kywd_ftrc = {D_Integer};	/* &ftrace */
+#endif					/* FncTrace */
+
+struct descrip kywd_dmp = {D_Integer};	/* &dump */
+
+struct descrip nullptr =
+   {F_Ptr | F_Nqual};	                /* descriptor with null block pointer */
+struct descrip trashcan;		/* descriptor that is never read */
+
+/*
+ * Various constant descriptors.
+ */
+
+struct descrip blank;			/* one-character blank string */
+struct descrip emptystr;		/* zero-length empty string */
+struct descrip lcase;			/* string of lowercase letters */
+struct descrip letr;			/* "r" */
+struct descrip nulldesc = {D_Null};	/* null value */
+struct descrip onedesc = {D_Integer};	/* integer 1 */
+struct descrip ucase;			/* string of uppercase letters */
+struct descrip zerodesc = {D_Integer};	/* integer 0 */
+
+#ifdef EventMon
+/*
+ * Descriptors used by event monitoring.
+ */
+struct descrip csetdesc = {D_Cset};
+struct descrip eventdesc;
+struct descrip rzerodesc = {D_Real};
+#endif					/* EventMon */
+
+/*
+ * An array of all characters for use in making one-character strings.
+ */
+
+unsigned char allchars[256] = {
+     0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
+    16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
+    32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
+    48, 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, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
+    96, 97, 98, 99,100,101,102,103,104,105,106,107,108,109,110,111,
+   112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,
+   128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,
+   144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,
+   160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
+   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
+   192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,
+   208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
+   224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,
+   240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,
+};
+
+/*
+ * Run-time error numbers and text.
+ */
+struct errtab errtab[] = {
+
+   101, "integer expected or out of range",
+   102, "numeric expected",
+   103, "string expected",
+   104, "cset expected",
+   105, "file expected",
+   106, "procedure or integer expected",
+   107, "record expected",
+   108, "list expected",
+   109, "string or file expected",
+   110, "string or list expected",
+   111, "variable expected",
+   112, "invalid type to size operation",
+   113, "invalid type to random operation",
+   114, "invalid type to subscript operation",
+   115, "structure expected",
+   116, "invalid type to element generator",
+   117, "missing main procedure",
+   118, "co-expression expected",
+   119, "set expected",
+   120, "two csets or two sets expected",
+   121, "function not supported",
+   122, "set or table expected",
+   123, "invalid type",
+   124, "table expected",
+   125, "list, record, or set expected",
+   126, "list or record expected",
+
+#ifdef Graphics
+   140, "window expected",
+   141, "program terminated by window manager",
+   142, "attempt to read/write on closed window",
+   143, "malformed event queue",
+   144, "window system error",
+   145, "bad window attribute",
+   146, "incorrect number of arguments to drawing function",
+   147, "window attribute cannot be read or written as requested",
+#endif					/* Graphics */
+
+#ifdef FAttrib
+   160, "bad file attribute",
+#endif					/* FAttrib */
+
+   201, "division by zero",
+   202, "remaindering by zero",
+   203, "integer overflow",
+   204, "real overflow, underflow, or division by zero",
+   205, "invalid value",
+   206, "negative first argument to real exponentiation",
+   207, "invalid field name",
+   208, "second and third arguments to map of unequal length",
+   209, "invalid second argument to open",
+   210, "non-ascending arguments to detab/entab",
+   211, "by value equal to zero",
+   212, "attempt to read file not open for reading",
+   213, "attempt to write file not open for writing",
+   214, "input/output error",
+   215, "attempt to refresh &main",
+   216, "external function not found",
+
+   301, "evaluation stack overflow",
+   302, "memory violation",
+   303, "inadequate space for evaluation stack",
+   304, "inadequate space in qualifier list",
+   305, "inadequate space for static allocation",
+   306, "inadequate space in string region",
+   307, "inadequate space in block region",
+   308, "system stack overflow in co-expression",
+
+#ifndef Coexpr
+   401, "co-expressions not implemented",
+#endif					/* Coexpr */
+   402, "program not compiled with debugging option",
+
+   500, "program malfunction",		/* for use by runerr() */
+   600, "vidget usage error",		/* yeah! */
+
+   0,	""
+   };
+
+#if !COMPILER
+#define OpDef(p,n,s,u) int Cat(O,p) (dptr cargp);
+#include "../h/odefs.h"
+#undef OpDef
+
+/*
+ * When an opcode n has a subroutine call associated with it, the
+ *  nth word here is the routine to call.
+ */
+
+int (*optab[])() = {
+	err,
+#define OpDef(p,n,s,u) Cat(O,p),
+#include "../h/odefs.h"
+#undef OpDef
+   Obscan,
+   err,
+   err,
+   err,
+   err,
+   err,
+   Ocreate,
+   err,
+   err,
+   err,
+   err,
+   Oescan,
+   err,
+   Ofield
+   };
+
+/*
+ *  Keyword function look-up table.
+ */
+#define KDef(p,n) int Cat(K,p) (dptr cargp);
+#include "../h/kdefs.h"
+#undef KDef
+
+int (*keytab[])() = {
+   err,
+#define KDef(p,n) Cat(K,p),
+#include "../h/kdefs.h"
+   };
+#endif					/* !COMPILER */
diff --git a/src/runtime/def.r b/src/runtime/def.r
new file mode 100644
index 0000000..012aab4
--- /dev/null
+++ b/src/runtime/def.r
@@ -0,0 +1,168 @@
+/*
+ * def.r -- defaulting conversion routines.
+ */
+
+/*
+ * DefConvert - macro for general form of defaulting conversion.
+ */
+#begdef DefConvert(default, dftype, destype, converter, body)
+int default(s,df,d)
+dptr s;
+dftype df;
+destype d;
+   {
+   if (is:null(*s)) {
+      body
+      return 1;
+      }
+   else
+      return converter(s,d); /* I really mean cnv:type */
+   }
+#enddef
+
+/*
+ * def_c_dbl - def:C_double(*s, df, *d), convert to C double with a
+ *  default value. Default is of type C double; if used, just copy to
+ *  destination.
+ */
+
+#begdef C_DblAsgn
+   *d = df;
+#enddef
+
+DefConvert(def_c_dbl, double, double *, cnv_c_dbl, C_DblAsgn)
+
+/*
+ * def_c_int - def:C_integer(*s, df, *d), convert to C_integer with a
+ *  default value. Default type C_integer; if used, just copy to
+ *  destination.
+ */
+#begdef C_IntAsgn
+   *d = df;
+#enddef
+
+DefConvert(def_c_int, C_integer, C_integer *, cnv_c_int, C_IntAsgn)
+
+/*
+ * def_c_str - def:C_string(*s, df, *d), convert to (tended) C string with
+ *  a default value. Default is of type "char *"; if used, point destination
+ *  descriptor to it.
+ */
+
+#begdef C_StrAsgn
+   StrLen(*d) = strlen(df);
+   StrLoc(*d) = (char *)df;
+#enddef
+
+DefConvert(def_c_str, char *, dptr, cnv_c_str, C_StrAsgn)
+
+/*
+ * def_cset - def:cset(*s, *df, *d), convert to cset with a default value.
+ *  Default is of type "struct b_cset *"; if used, point destination descriptor
+ *  to it.
+ */
+
+#begdef CsetAsgn
+   d->dword = D_Cset;
+   BlkLoc(*d) = (union block *)df;
+#enddef
+
+DefConvert(def_cset, struct b_cset *, dptr, cnv_cset, CsetAsgn)
+
+/*
+ * def_ec_int - def:(exact)C_integer(*s, df, *d), convert to C Integer
+ *  with a default value, but disallow conversions from reals. Default
+ *  is of type C_Integer; if used, just copy to destination.
+ */
+
+#begdef EC_IntAsgn
+   *d = df;
+#enddef
+
+DefConvert(def_ec_int, C_integer, C_integer *, cnv_ec_int, EC_IntAsgn)
+
+/*
+ * def_eint - def:(exact)integer(*s, df, *d), convert to C_integer
+ *  with a default value, but disallow conversions from reals. Default
+ *  is of type C_Integer; if used, assign it to the destination descriptor.
+ */
+
+#begdef EintAsgn
+   d->dword = D_Integer;
+   IntVal(*d) = df;
+#enddef
+
+DefConvert(def_eint, C_integer, dptr, cnv_eint, EintAsgn)
+
+/*
+ * def_int - def:integer(*s, df, *d), convert to integer with a default
+ *  value. Default is of type C_integer; if used, assign it to the
+ *  destination descriptor.
+ */
+
+#begdef IntAsgn
+   d->dword = D_Integer;
+   IntVal(*d) = df;
+#enddef
+
+DefConvert(def_int, C_integer, dptr, cnv_int, IntAsgn)
+
+/*
+ * def_real - def:real(*s, df, *d), convert to real with a default value.
+ *  Default is of type double; if used, allocate real block and point
+ *  destination descriptor to it.
+ */
+
+#begdef RealAsgn
+   Protect(BlkLoc(*d) = (union block *)alcreal(df), fatalerr(0,NULL));
+   d->dword = D_Real;
+#enddef
+
+DefConvert(def_real, double, dptr, cnv_real, RealAsgn)
+
+/*
+ * def_str - def:string(*s, *df, *d), convert to string with a default
+ *  value. Default is of type "struct descrip *"; if used, copy the
+ *  decriptor value to the destination.
+ */
+
+#begdef StrAsgn
+   *d = *df;
+#enddef
+
+DefConvert(def_str, dptr, dptr, cnv_str, StrAsgn)
+
+/*
+ * def_tcset - def:tmp_cset(*s, *df, *d), conversion to temporary cset with
+ *  a default value. Default is of type "struct b_cset *"; if used,
+ *  point destination descriptor to it. Note that this routine needs
+ *  a cset buffer (cset block) to perform an actual conversion.
+ */
+int def_tcset(cbuf, s, df, d)
+struct b_cset *cbuf, *df;
+dptr s, d;
+{
+   if (is:null(*s)) {
+      d->dword = D_Cset;
+      BlkLoc(*d) = (union block *)df;
+      return 1;
+      }
+   return cnv_tcset(cbuf, s, d);
+   }
+
+/*
+ * def_tstr - def:tmp_string(*s, *df, *d), conversion to temporary string
+ *  with a default value. Default is of type "struct descrip *"; if used,
+ *  copy it to destination descriptor. Note that this routine needs
+ *  a string buffer to perform an actual conversion.
+ */
+int def_tstr(sbuf, s, df, d)
+char *sbuf;
+dptr s, df, d;
+   {
+   if (is:null(*s)) {
+      *d = *df;
+      return 1;
+      }
+   return cnv_tstr(sbuf, s, d);
+   }
diff --git a/src/runtime/errmsg.r b/src/runtime/errmsg.r
new file mode 100644
index 0000000..7095781
--- /dev/null
+++ b/src/runtime/errmsg.r
@@ -0,0 +1,119 @@
+/*
+ * errmsg.r -- err_msg, irunerr, drunerr
+ */
+
+extern struct errtab errtab[];		/* error numbers and messages */
+
+/*
+ * err_msg - print run-time error message, performing trace back if required.
+ *  This function underlies the rtt runerr() construct.
+ */
+void err_msg(n, v)
+int n;
+dptr v;
+{
+   register struct errtab *p;
+
+   if (n == 0) {
+      k_errornumber = t_errornumber;
+      k_errorvalue = t_errorvalue;
+      have_errval = t_have_val;
+      }
+   else {
+      k_errornumber = n;
+      if (v == NULL) {
+         k_errorvalue = nulldesc;
+         have_errval = 0;
+         }
+      else {
+         k_errorvalue = *v;
+         have_errval = 1;
+         }
+      }
+
+   k_errortext = "";
+   for (p = errtab; p->err_no > 0; p++)
+      if (p->err_no == k_errornumber) {
+         k_errortext = p->errmsg;
+         break;
+         }
+
+   EVVal((word)k_errornumber,E_Error);
+
+   if (pfp != NULL) {
+      if (IntVal(kywd_err) == 0 || !err_conv) {
+         fprintf(stderr, "\nRun-time error %d\n", k_errornumber);
+#if COMPILER
+         if (line_info)
+            fprintf(stderr, "File %s; Line %d\n", file_name, line_num);
+#else					/* COMPILER */
+         fprintf(stderr, "File %s; Line %ld\n", findfile(ipc.opnd),
+            (long)findline(ipc.opnd));
+#endif					/* COMPILER */
+         }
+      else {
+         IntVal(kywd_err)--;
+         return;
+         }
+      }
+   else
+      fprintf(stderr, "\nRun-time error %d in startup code\n", n);
+   fprintf(stderr, "%s\n", k_errortext);
+
+   if (have_errval) {
+      fprintf(stderr, "offending value: ");
+      outimage(stderr, &k_errorvalue, 0);
+      putc('\n', stderr);
+      }
+
+   if (!debug_info)
+      c_exit(EXIT_FAILURE);
+
+   if (pfp == NULL) {		/* skip if start-up problem */
+      if (dodump)
+         abort();
+      c_exit(EXIT_FAILURE);
+      }
+
+   fprintf(stderr, "Traceback:\n");
+   tracebk(pfp, glbl_argp);
+   fflush(stderr);
+   if (dodump)
+      abort();
+   c_exit(EXIT_FAILURE);
+}
+
+/*
+ * irunerr - print an error message when the offending value is a C_integer
+ *  rather than a descriptor.
+ */
+void irunerr(n, v)
+int n;
+C_integer v;
+   {
+   t_errornumber = n;
+   IntVal(t_errorvalue) = v;
+   t_errorvalue.dword = D_Integer;
+   t_have_val = 1;
+   err_msg(0,NULL);
+   }
+
+/*
+ * drunerr - print an error message when the offending value is a C double
+ *  rather than a descriptor.
+ */
+void drunerr(n, v)
+int n;
+double v;
+   {
+   union block *bp;
+
+   bp = (union block *)alcreal(v);
+   if (bp != NULL) {
+      t_errornumber = n;
+      BlkLoc(t_errorvalue) = bp;
+      t_errorvalue.dword = D_Real;
+      t_have_val = 1;
+      }
+   err_msg(0,NULL);
+   }
diff --git a/src/runtime/extcall.r b/src/runtime/extcall.r
new file mode 100644
index 0000000..5652416
--- /dev/null
+++ b/src/runtime/extcall.r
@@ -0,0 +1,21 @@
+/*
+ * extcall.r
+ */
+
+#if !COMPILER
+#ifdef ExternalFunctions
+
+/*
+ * extcall - stub procedure for external call interface.
+ */
+dptr extcall(dargv, argc, ip)
+dptr dargv;
+int argc;
+int *ip;
+   {
+   *ip = 216;			/* no external function to find */
+   return (dptr)NULL;
+   }
+
+#endif					/* ExternalFunctions */
+#endif					/* !COMPILER */
diff --git a/src/runtime/fconv.r b/src/runtime/fconv.r
new file mode 100644
index 0000000..7c3a3ff
--- /dev/null
+++ b/src/runtime/fconv.r
@@ -0,0 +1,260 @@
+/*
+ * fconv.r -- abs, cset, integer, numeric, proc, real, string.
+ */
+
+"abs(N) - produces the absolute value of N."
+
+function{1} abs(n)
+   /*
+    * If n is convertible to a (large or small) integer or real,
+    * this code returns -n if n is negative
+    */
+   if cnv:(exact)C_integer(n) then {
+      abstract {
+         return integer
+         }
+      inline {
+	 C_integer i;
+	 extern int over_flow;
+
+	 if (n >= 0)
+	    i = n;
+	 else {
+	    i = neg(n);
+	    if (over_flow) {
+#ifdef LargeInts
+	       struct descrip tmp;
+	       MakeInt(n,&tmp);
+	       if (bigneg(&tmp, &result) == Error)  /* alcbignum failed */
+	          runerr(0);
+               return result;
+#else					/* LargeInts */
+	       irunerr(203,n);
+               errorfail;
+#endif					/* LargeInts */
+	       }
+	    }
+         return C_integer i;
+         }
+      }
+
+
+#ifdef LargeInts
+   else if cnv:(exact)integer(n) then {
+      abstract {
+         return integer
+         }
+      inline {
+	 if (BlkLoc(n)->bignumblk.sign == 0)
+	    result = n;
+	 else {
+	    if (bigneg(&n, &result) == Error)  /* alcbignum failed */
+	       runerr(0);
+	    }
+         return result;
+         }
+      }
+#endif					/* LargeInts */
+
+   else if cnv:C_double(n) then {
+      abstract {
+         return real
+         }
+      inline {
+         return C_double Abs(n);
+         }
+      }
+   else
+      runerr(102,n)
+end
+
+
+/*
+ * The convertible types cset, integer, real, and string are identical
+ *  enough to be expansions of a single macro, parameterized by type.
+ */
+#begdef ReturnYourselfAs(t)
+#t "(x) - produces a value of type " #t " resulting from the conversion of x, "
+   "but fails if the conversion is not possible."
+function{0,1} t(x)
+
+   if cnv:t(x) then {
+      abstract {
+         return t
+         }
+      inline {
+         return x;
+         }
+      }
+   else {
+      abstract {
+         return empty_type
+         }
+      inline {
+         fail;
+         }
+      }
+end
+
+#enddef
+
+ReturnYourselfAs(cset)     /* cset(x) - convert to cset or fail */
+ReturnYourselfAs(integer)  /* integer(x) - convert to integer or fail */
+ReturnYourselfAs(real)     /* real(x) - convert to real or fail */
+ReturnYourselfAs(string)   /* string(x) - convert to string or fail */
+
+
+
+"numeric(x) - produces an integer or real number resulting from the "
+"type conversion of x, but fails if the conversion is not possible."
+
+function{0,1} numeric(n)
+
+   if cnv:(exact)integer(n) then {
+      abstract {
+         return integer
+         }
+      inline {
+         return n;
+         }
+      }
+   else if cnv:real(n) then {
+      abstract {
+         return real
+         }
+      inline {
+         return n;
+         }
+      }
+   else {
+      abstract {
+         return empty_type
+         }
+      inline {
+         fail;
+         }
+      }
+end
+
+
+"proc(x,i) - convert x to a procedure if possible; use i to resolve "
+"ambiguous string names."
+
+#ifdef MultiThread
+function{0,1} proc(x,i,c)
+#else					/* MultiThread */
+function{0,1} proc(x,i)
+#endif					/* MultiThread */
+
+#ifdef MultiThread
+   if is:coexpr(x) then {
+      abstract {
+         return proc
+         }
+      inline {
+	 struct b_coexpr *ce = NULL;
+	 struct b_proc *bp = NULL;
+	 struct pf_marker *fp;
+	 dptr dp=NULL;
+	 if (BlkLoc(x) != BlkLoc(k_current)) {
+	    ce = (struct b_coexpr *)BlkLoc(x);
+	    dp = ce->es_argp;
+	    if (dp == NULL) fail;
+	    bp = (struct b_proc *)BlkLoc(*(dp));
+	    }
+	 else
+	    bp = (struct b_proc *)BlkLoc(*(glbl_argp));
+	 return proc(bp);
+	 }
+      }
+#endif					/* MultiThread */
+
+   if is:proc(x) then {
+      abstract {
+         return proc
+         }
+      inline {
+
+#ifdef MultiThread
+	 if (!is:null(c)) {
+	    struct progstate *p;
+	    if (!is:coexpr(c)) runerr(118,c);
+	    /*
+	     * Test to see whether a given procedure belongs to a given
+	     * program.  Currently this is a sleazy pointer arithmetic check.
+	     */
+	    p = BlkLoc(c)->coexpr.program;
+	    if (! InRange(p, BlkLoc(x)->proc.entryp.icode,
+			  (char *)p + p->hsize))
+	       fail;
+	    }
+#endif					/* MultiThread */
+         return x;
+         }
+      }
+
+   else if cnv:tmp_string(x) then {
+      /*
+       * i must be 0, 1, 2, or 3; it defaults to 1.
+       */
+      if !def:C_integer(i, 1) then
+         runerr(101, i)
+      inline {
+         if (i < 0 || i > 3) {
+            irunerr(205, i);
+            errorfail;
+            }
+         }
+
+      abstract {
+         return proc
+         }
+      inline {
+         struct b_proc *prc;
+
+#ifdef MultiThread
+	 struct progstate *prog, *savedprog;
+
+	 savedprog = curpstate;
+	 if (is:null(c)) {
+	    prog = curpstate;
+	    }
+	 else if (is:coexpr(c)) {
+	    prog = BlkLoc(c)->coexpr.program;
+	    }
+	 else {
+	    runerr(118,c);
+	    }
+
+	 ENTERPSTATE(prog);
+#endif					/* MultiThread */
+
+         /*
+          * Attempt to convert Arg0 to a procedure descriptor using i to
+          *  discriminate between procedures with the same names.  If i
+          *  is zero, only check builtins and ignore user procedures.
+          *  Fail if the conversion isn't successful.
+          */
+	 if (i == 0)
+            prc = bi_strprc(&x, 0);
+	 else
+         prc = strprc(&x, i);
+
+#ifdef MultiThread
+	 ENTERPSTATE(savedprog);
+#endif					/* MultiThread */
+         if (prc == NULL)
+            fail;
+         else
+            return proc(prc);
+         }
+      }
+   else {
+      abstract {
+         return empty_type
+         }
+      inline {
+         fail;
+         }
+      }
+end
diff --git a/src/runtime/fload.r b/src/runtime/fload.r
new file mode 100644
index 0000000..dfb9fcc
--- /dev/null
+++ b/src/runtime/fload.r
@@ -0,0 +1,221 @@
+/*
+ * File: fload.r
+ *  Contents: loadfunc.
+ *
+ *  This file contains loadfunc(), the dynamic loading function for
+ *  Unix systems having the <dlfcn.h> interface.
+ *
+ *  from Icon:
+ *     p := loadfunc(filename, funcname)
+ *     p(arg1, arg2, ...)
+ *
+ *  in C:
+ *     int func(int argc, dptr argv)
+ *        return -1 for failure, 0 for success, >0 for error
+ *        argc is number of true args not including argv[0]
+ *        argv[0] is for return value; others are true args
+ */
+
+#ifdef LoadFunc
+
+#ifndef RTLD_LAZY	/* normally from <dlfcn.h> */
+   #define RTLD_LAZY 1
+#endif					/* RTLD_LAZY */
+
+#ifdef FreeBSD
+   /*
+    * If DL_GETERRNO exists, this is an FreeBSD 1.1.5 or 2.0
+    * which lacks dlerror(); supply a substitute.
+    */
+   #passthru #ifdef DL_GETERRNO
+      char *dlerror(void)
+      {
+         int no;
+
+         if (0 == dlctl(NULL, DL_GETERRNO, &no))
+            return(strerror(no));
+         else
+            return(NULL);
+      }
+   #passthru #endif
+#endif					/* __FreeBSD__ */
+
+int glue();
+int makefunc	(dptr d, char *name, int (*func)());
+
+"loadfunc(filename,funcname) - load C function dynamically."
+
+function{0,1} loadfunc(filename,funcname)
+
+   if !cnv:C_string(filename) then
+      runerr(103, filename)
+   if !cnv:C_string(funcname) then
+      runerr(103, funcname)
+
+   abstract {
+      return proc
+      }
+   body
+      {
+      int (*func)();
+      static char *curfile;
+      static void *handle;
+      char *funcname2;
+
+      /*
+       * Get a library handle, reusing it over successive calls.
+       */
+      if (!handle || !curfile || strcmp(filename, curfile) != 0) {
+         if (curfile)
+            free((pointer)curfile);	/* free the old file name */
+         curfile = salloc(filename);	/* save the new name */
+         handle = dlopen(filename, RTLD_LAZY);	/* get the handle */
+         }
+      /*
+       * Load the function.  Diagnose both library and function errors here.
+       */
+      if (handle) {
+         func = (int (*)())dlsym(handle, funcname);
+         if (!func) {
+            /*
+             * If no function, try again by prepending an underscore.
+             * (for OpenBSD and similar systems.)
+             */
+            funcname2 = malloc(strlen(funcname) + 2);
+            if (funcname2) {
+               *funcname2 = '_';
+               strcpy(funcname2 + 1, funcname);
+               func = (int (*)())dlsym(handle, funcname2);
+               free(funcname2);
+               }
+            }
+         }
+      if (!handle || !func) {
+         fprintf(stderr, "\nloadfunc(\"%s\",\"%s\"): %s\n",
+            filename, funcname, dlerror());
+         runerr(216);
+         }
+      /*
+       * Build and return a proc descriptor.
+       */
+      if (!makefunc(&result, funcname, func))
+         runerr(305);
+      return result;
+      }
+end
+
+/*
+ * makefunc(d, name, func) -- make function descriptor in d.
+ *
+ *  Returns 0 if memory could not be allocated.
+ */
+int makefunc(d, name, func)
+dptr d;
+char *name;
+int (*func)();
+   {
+   struct b_proc *blk;
+
+   blk = (struct b_proc *)malloc(sizeof(struct b_proc));
+   if (!blk)
+      return 0;
+   blk->title = T_Proc;
+   blk->blksize = sizeof(struct b_proc);
+
+#if COMPILER
+   blk->ccode = glue;		/* set code addr to glue routine */
+#else					/* COMPILER */
+   blk->entryp.ccode = glue;	/* set code addr to glue routine */
+#endif					/* COMPILER */
+
+   blk->nparam = -1;		/* varargs flag */
+   blk->ndynam = -1;		/* treat as built-in function */
+   blk->nstatic = 0;
+   blk->fstatic = 0;
+   blk->pname.dword = strlen(name);
+   blk->pname.vword.sptr = salloc(name);
+   blk->lnames[0].dword = 0;
+   blk->lnames[0].vword.sptr = (char *)func;
+				/* save func addr in lnames[0] vword */
+   d->dword = D_Proc;		/* build proc descriptor */
+   d->vword.bptr = (union block *)blk;
+   return 1;
+   }
+
+/*
+ * This glue routine is called when a loaded function is invoked.
+ * It digs the actual C code address out of the proc block, and calls that.
+ */
+
+#if COMPILER
+
+int glue(argc, dargv, rslt, succ_cont)
+int argc;
+dptr dargv;
+dptr rslt;
+continuation succ_cont;
+   {
+   int i, status, (*func)();
+   struct b_proc *blk;
+   struct descrip r;
+   tended struct descrip p;
+
+   dargv--;				/* reset pointer to proc entry */
+   for (i = 0; i <= argc; i++)
+      deref(&dargv[i], &dargv[i]);	/* dereference args including proc */
+
+   blk = (struct b_proc *)dargv[0].vword.bptr;	/* proc block address */
+   func = (int (*)())blk->lnames[0].vword.sptr;	/* entry point address */
+
+   p = dargv[0];			/* save proc for traceback */
+   dargv[0] = nulldesc;			/* set default return value */
+   status = (*func)(argc, dargv);	/* call func */
+
+   if (status == 0) {
+      *rslt = dargv[0];
+      Return;				/* success */
+      }
+
+   if (status < 0)
+      Fail;				/* failure */
+
+   r = dargv[0];			/* save result value */
+   dargv[0] = p;			/* restore proc for traceback */
+   if (is:null(r))
+      RunErr(status, NULL);		/* error, no value */
+   RunErr(status, &r);			/* error, with value */
+   }
+
+#else					/* COMPILER */
+
+int glue(argc, dargv)
+int argc;
+dptr dargv;
+   {
+   int status, (*func)();
+   struct b_proc *blk;
+   struct descrip r;
+   tended struct descrip p;
+
+   blk = (struct b_proc *)dargv[0].vword.bptr;	/* proc block address */
+   func = (int (*)())blk->lnames[0].vword.sptr;	/* entry point address */
+
+   p = dargv[0];			/* save proc for traceback */
+   dargv[0] = nulldesc;			/* set default return value */
+   status = (*func)(argc, dargv);	/* call func */
+
+   if (status == 0)
+      Return;				/* success */
+   if (status < 0)
+      Fail;				/* failure */
+
+   r = dargv[0];			/* save result value */
+   dargv[0] = p;			/* restore proc for traceback */
+   if (is:null(r))
+      RunErr(status, NULL);		/* error, no value */
+   RunErr(status, &r);			/* error, with value */
+   }
+
+#endif					/* COMPILER */
+
+#endif					/* LoadFunc */
diff --git a/src/runtime/fmath.r b/src/runtime/fmath.r
new file mode 100644
index 0000000..2098044
--- /dev/null
+++ b/src/runtime/fmath.r
@@ -0,0 +1,114 @@
+/*
+ * fmath.r -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
+ */
+
+/*
+ * Most of the math ops are simple calls to underlying C functions,
+ * sometimes with additional error checking to avoid and/or detect
+ * various C runtime errors.
+ */
+#begdef MathOp(funcname,ccode,comment,pre,post)
+#funcname "(r)" comment
+function{1} funcname(x)
+
+   if !cnv:C_double(x) then
+      runerr(102, x)
+
+   abstract {
+      return real
+      }
+   inline {
+      double y;
+      pre		/* Pre math-operation range checking */
+      errno = 0;
+      y = ccode(x);
+      post		/* Post math-operation C library error detection */
+      return C_double y;
+      }
+end
+#enddef
+
+
+#define aroundone if (x < -1.0 || x > 1.0) {drunerr(205, x); errorfail;}
+#define positive  if (x < 0)               {drunerr(205, x); errorfail;}
+
+#define erange    if (errno == ERANGE)     runerr(204);
+#define edom      if (errno == EDOM)       runerr(205);
+
+MathOp(sin, sin,  ", x in radians.", ;, ;)
+MathOp(cos, cos,  ", x in radians.", ;, ;)
+MathOp(tan, tan,  ", x in radians.", ; , erange)
+MathOp(acos,acos, ", x in radians.", aroundone, edom)
+MathOp(asin,asin, ", x in radians.", aroundone, edom)
+MathOp(exp, exp,  " - e^x.", ; , erange)
+MathOp(sqrt,sqrt, " - square root of x.", positive, edom)
+#define DTOR(x) ((x) * Pi / 180)
+#define RTOD(x) ((x) * 180 / Pi)
+MathOp(dtor,DTOR, " - convert x from degrees to radians.", ; , ;)
+MathOp(rtod,RTOD, " - convert x from radians to degrees.", ; , ;)
+
+
+
+"atan(r1,r2) -- r1, r2  in radians; if r2 is present, produces atan2(r1,r2)."
+
+function{1} atan(x,y)
+
+   if !cnv:C_double(x) then
+      runerr(102, x)
+
+   abstract {
+      return real
+      }
+   if is:null(y) then
+      inline {
+         return C_double atan(x);
+         }
+   if !cnv:C_double(y) then
+      runerr(102, y)
+   inline {
+      return C_double atan2(x,y);
+      }
+end
+
+
+"log(r1,r2) - logarithm of r1 to base r2."
+
+function{1} log(x,b)
+
+   if !cnv:C_double(x) then
+      runerr(102, x)
+
+   abstract {
+      return real
+      }
+   inline {
+      if (x <= 0.0) {
+         drunerr(205, x);
+         errorfail;
+         }
+      }
+   if is:null(b) then
+      inline {
+         return C_double log(x);
+         }
+   else {
+      if !cnv:C_double(b) then
+         runerr(102, b)
+      body {
+         static double lastbase = 0.0;
+         static double divisor;
+
+         if (b <= 1.0) {
+            drunerr(205, b);
+            errorfail;
+            }
+         if (b != lastbase) {
+            divisor = log(b);
+            lastbase = b;
+            }
+	 x = log(x) / divisor;
+         return C_double x;
+         }
+      }
+end
+
diff --git a/src/runtime/fmisc.r b/src/runtime/fmisc.r
new file mode 100644
index 0000000..6691241
--- /dev/null
+++ b/src/runtime/fmisc.r
@@ -0,0 +1,2204 @@
+/*
+ * File: fmisc.r
+ * Contents:
+ *  args, char, collect, copy, display, function, iand, icom, image, ior,
+ *  ishift, ixor, [keyword], [load], ord, name, runerr, seq, sort, sortf,
+ *  type, variable
+ */
+#if !COMPILER
+#include "../h/opdefs.h"
+#endif					/* !COMPILER */
+
+"args(p) - produce number of arguments for procedure p."
+
+function{1} args(x)
+
+   if !is:proc(x) then
+      runerr(106, x)
+
+   abstract {
+      return integer
+      }
+   inline {
+      return C_integer ((struct b_proc *)BlkLoc(x))->nparam;
+      }
+end
+
+#if !COMPILER
+#ifdef ExternalFunctions
+
+/*
+ * callout - call a C library routine (or any C routine that doesn't call Icon)
+ *   with an argument count and a list of descriptors.  This routine
+ *   doesn't build a procedure frame to prepare for calling Icon back.
+ */
+function{1} callout(x[nargs])
+   body {
+      dptr retval;
+      int signal;
+
+      /*
+       * Little cheat here.  Although this is a var-arg procedure, we need
+       *  at least one argument to get started: pretend there is a null on
+       *  the stack.  NOTE:  Actually, at present, varargs functions always
+       *  have at least one argument, so this doesn't plug the hole.
+       */
+      if (nargs < 1)
+         runerr(103, nulldesc);
+
+      /*
+       * Call the 'C routine caller' with a pointer to an array of descriptors.
+       *  Note that these are being left on the stack. We are passing
+       *  the name of the routine as part of the convention of calling
+       *  routines with an argc/argv technique.
+       */
+      signal = -1;			/* presume successful completiong */
+      retval = extcall(x, nargs, &signal);
+      if (signal >= 0) {
+         if (retval == NULL)
+            runerr(signal);
+         else
+            runerr(signal, *retval);
+         }
+      if (retval != NULL) {
+         return *retval;
+         }
+      else
+         fail;
+      }
+end
+
+#endif					/* ExternalFunctions */
+#endif					/* !COMPILER */
+
+
+"char(i) - produce a string consisting of character i."
+
+function{1} char(i)
+
+   if !cnv:C_integer(i) then
+      runerr(101,i)
+   abstract {
+      return string
+      }
+   body {
+      if (i < 0 || i > 255) {
+         irunerr(205, i);
+         errorfail;
+         }
+      return string(1, (char *)&allchars[i & 0xFF]);
+      }
+end
+
+
+"collect(i1,i2) - call garbage collector to ensure i2 bytes in region i1."
+" no longer works."
+
+function{1} collect(region, bytes)
+
+   if !def:C_integer(region, (C_integer)0) then
+      runerr(101, region)
+   if !def:C_integer(bytes, (C_integer)0) then
+      runerr(101, bytes)
+
+   abstract {
+      return null
+      }
+   body {
+      if (bytes < 0) {
+         irunerr(205, bytes);
+         errorfail;
+         }
+      switch (region) {
+	 case 0:
+	    collect(0);
+	    break;
+	 case Static:
+	    collect(Static);			 /* i2 ignored if i1==Static */
+	    break;
+	 case Strings:
+	    if (DiffPtrs(strend,strfree) >= bytes)
+	       collect(Strings);		/* force unneded collection */
+	    else if (!reserve(Strings, bytes))	/* collect & reserve bytes */
+               fail;
+	    break;
+	 case Blocks:
+	    if (DiffPtrs(blkend,blkfree) >= bytes)
+	       collect(Blocks);			/* force unneded collection */
+	    else if (!reserve(Blocks, bytes))	/* collect & reserve bytes */
+               fail;
+	    break;
+	 default:
+            irunerr(205, region);
+            errorfail;
+         }
+      return nulldesc;
+      }
+end
+
+
+"copy(x) - make a copy of object x."
+
+function{1} copy(x)
+   abstract {
+      return type(x)
+      }
+   type_case x of {
+      null:
+      string:
+      cset:
+      integer:
+      real:
+      file:
+      proc:
+      coexpr:
+         inline {
+            /*
+             * Copy the null value, integers, long integers, reals, files,
+             *	csets, procedures, and such by copying the descriptor.
+             *	Note that for integers, this results in the assignment
+             *	of a value, for the other types, a pointer is directed to
+             *	a data block.
+             */
+            return x;
+            }
+
+      list:
+         inline {
+            /*
+             * Pass the buck to cplist to copy a list.
+             */
+            if (cplist(&x, &result, (word)1, BlkLoc(x)->list.size + 1) ==Error)
+	       runerr(0);
+            return result;
+            }
+      table: {
+         body {
+#ifdef TableFix
+	    if (cptable(&x, &result, BlkLoc(x)->table.size) == Error)
+	       runerr(0);
+	    return result;
+#else					/* TableFix */
+            register int i;
+            register word slotnum;
+            tended union block *src;
+            tended union block *dst;
+	    tended struct b_slots *seg;
+	    tended struct b_telem *ep, *prev;
+	    struct b_telem *te;
+            /*
+             * Copy a Table.  First, allocate and copy header and slot blocks.
+             */
+            src = BlkLoc(x);
+            dst = hmake(T_Table, src->table.mask + 1, src->table.size);
+            if (dst == NULL)
+               runerr(0);
+            dst->table.size = src->table.size;
+            dst->table.mask = src->table.mask;
+            dst->table.defvalue = src->table.defvalue;
+            for (i = 0; i < HSegs && src->table.hdir[i] != NULL; i++)
+               memcpy((char *)dst->table.hdir[i], (char *)src->table.hdir[i],
+                  src->table.hdir[i]->blksize);
+            /*
+             * Work down the chain of element blocks in each bucket
+             *	and create identical chains in new table.
+             */
+            for (i = 0; i < HSegs && (seg = dst->table.hdir[i]) != NULL; i++)
+               for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
+		  prev = NULL;
+                  for (ep = (struct b_telem *)seg->hslots[slotnum];
+			ep != NULL; ep = (struct b_telem *)ep->clink) {
+		     Protect(te = alctelem(), runerr(0));
+		     *te = *ep;				/* copy table entry */
+		     if (prev == NULL)
+			seg->hslots[slotnum] = (union block *)te;
+		     else
+			prev->clink = (union block *)te;
+		     te->clink = ep->clink;
+		     prev = te;
+                     }
+                  }
+
+            if (TooSparse(dst))
+               hshrink(dst);
+	    Desc_EVValD(dst, E_Tcreate, D_Table);
+	    return table(dst);
+#endif					/* TableFix */
+            }
+         }
+
+      set: {
+         body {
+            /*
+             * Pass the buck to cpset to copy a set.
+             */
+            if (cpset(&x, &result, BlkLoc(x)->set.size) == Error)
+               runerr(0);
+	    return result;
+            }
+         }
+
+      record: {
+         body {
+            /*
+             * Note, these pointers don't need to be tended, because they are
+             *  not used until after allocation is complete.
+             */
+            struct b_record *new_rec;
+            tended struct b_record *old_rec;
+            dptr d1, d2;
+            int i;
+
+            /*
+             * Allocate space for the new record and copy the old
+             *	one into it.
+             */
+            old_rec = (struct b_record *)BlkLoc(x);
+            i = old_rec->recdesc->proc.nfields;
+
+            /* #%#% param changed ? */
+            Protect(new_rec = alcrecd(i,old_rec->recdesc), runerr(0));
+            d1 = new_rec->fields;
+            d2 = old_rec->fields;
+            while (i--)
+               *d1++ = *d2++;
+	    Desc_EVValD(new_rec, E_Rcreate, D_Record);
+            return record(new_rec);
+            }
+         }
+
+      default: body {
+            runerr(123,x);
+         }
+         }
+end
+
+
+"display(i,f) - display local variables of i most recent"
+" procedure activations, plus global variables."
+" Output to file f (default &errout)."
+
+#ifdef MultiThread
+function{1} display(i,f,c)
+   declare {
+      struct b_coexpr *ce = NULL;
+      struct progstate *prog, *savedprog;
+      }
+#else					/* MultiThread */
+function{1} display(i,f)
+#endif					/* MultiThread */
+
+   if !def:C_integer(i,(C_integer)k_level) then
+      runerr(101, i)
+
+   if is:null(f) then
+       inline {
+	  f.dword = D_File;
+	  BlkLoc(f) = (union block *)&k_errout;
+          }
+   else if !is:file(f) then
+      runerr(105, f)
+
+#ifdef MultiThread
+   if !is:null(c) then inline {
+      if (!is:coexpr(c)) runerr(118,c);
+      else if (BlkLoc(c) != BlkLoc(k_current))
+         ce = (struct b_coexpr *)BlkLoc(c);
+      savedprog = curpstate;
+      }
+#endif					/* MultiThread */
+
+   abstract {
+      return null
+      }
+
+   body {
+      FILE *std_f;
+      int r;
+
+      if (!debug_info)
+         runerr(402);
+
+      /*
+       * Produce error if file cannot be written.
+       */
+      std_f = BlkLoc(f)->file.fd;
+      if ((BlkLoc(f)->file.status & Fs_Write) == 0)
+         runerr(213, f);
+
+      /*
+       * Produce error if i is negative; constrain i to be <= &level.
+       */
+      if (i < 0) {
+         irunerr(205, i);
+         errorfail;
+         }
+      else if (i > k_level)
+         i = k_level;
+
+      fprintf(std_f,"co-expression_%ld(%ld)\n\n",
+         (long)BlkLoc(k_current)->coexpr.id,
+	 (long)BlkLoc(k_current)->coexpr.size);
+      fflush(std_f);
+#ifdef MultiThread
+      if (ce) {
+	 if ((ce->es_pfp == NULL) || (ce->es_argp == NULL)) fail;
+	 ENTERPSTATE(ce->program);
+         r = xdisp(ce->es_pfp, ce->es_argp, (int)i, std_f);
+	 ENTERPSTATE(savedprog);
+       }
+      else
+#endif					/* MultiThread */
+         r = xdisp(pfp, glbl_argp, (int)i, std_f);
+      if (r == Failed)
+         runerr(305);
+      return nulldesc;
+      }
+end
+
+
+"errorclear() - clear error condition."
+
+function{1} errorclear()
+   abstract {
+      return null
+      }
+   body {
+      k_errornumber = 0;
+      k_errortext = "";
+      k_errorvalue = nulldesc;
+      have_errval = 0;
+      return nulldesc;
+      }
+end
+
+#if !COMPILER
+
+"function() - generate the names of the functions."
+
+function{*} function()
+   abstract {
+      return string
+      }
+   body {
+      register int i;
+
+      for (i = 0; i<pnsize; i++) {
+	 suspend string(strlen(pntab[i].pstrep), pntab[i].pstrep);
+         }
+      fail;
+      }
+end
+#endif					/* !COMPILER */
+
+
+/*
+ * the bitwise operators are identical enough to be expansions
+ *  of a macro.
+ */
+
+#begdef  bitop(func_name, c_op, operation)
+#func_name "(i,j) - produce bitwise " operation " of i and j."
+function{1} func_name(i,j)
+   /*
+    * i and j must be integers
+    */
+   if !cnv:integer(i) then
+      runerr(101,i)
+   if !cnv:integer(j) then
+      runerr(101,j)
+
+   abstract {
+      return integer
+      }
+   inline {
+#ifdef LargeInts
+      if ((Type(i)==T_Lrgint) || (Type(j)==T_Lrgint)) {
+         big_ ## c_op(i,j);
+         }
+      else
+#endif					/* LargeInts */
+      return C_integer IntVal(i) c_op IntVal(j);
+      }
+end
+#enddef
+
+#define bitand &
+#define bitor  |
+#define bitxor ^
+#begdef big_bitand(x,y)
+{
+   if (bigand(&x, &y, &result) == Error)  /* alcbignum failed */
+      runerr(0);
+   return result;
+}
+#enddef
+#begdef big_bitor(x,y)
+{
+   if (bigor(&x, &y, &result) == Error)  /* alcbignum failed */
+      runerr(0);
+   return result;
+}
+#enddef
+#begdef big_bitxor(x,y)
+{
+   if (bigxor(&x, &y, &result) == Error)  /* alcbignum failed */
+      runerr(0);
+   return result;
+}
+#enddef
+
+bitop(iand, bitand, "AND")          /* iand(i,j) bitwise "and" of i and j */
+bitop(ior,  bitor, "inclusive OR")  /* ior(i,j) bitwise "or" of i and j */
+bitop(ixor, bitxor, "exclusive OR") /* ixor(i,j) bitwise "xor" of i and j */
+
+
+"icom(i) - produce bitwise complement (one's complement) of i."
+
+function{1} icom(i)
+   /*
+    * i must be an integer
+    */
+   if !cnv:integer(i) then
+      runerr(101, i)
+
+   abstract {
+      return integer
+      }
+   inline {
+#ifdef LargeInts
+      if (Type(i) == T_Lrgint) {
+         struct descrip td;
+
+         td.dword = D_Integer;
+         IntVal(td) = -1;
+         if (bigsub(&td, &i, &result) == Error)  /* alcbignum failed */
+            runerr(0);
+         return result;
+         }
+      else
+#endif					/* LargeInts */
+      return C_integer ~IntVal(i);
+      }
+end
+
+
+"image(x) - return string image of object x."
+/*
+ *  All the interesting work happens in getimage()
+ */
+function{1} image(x)
+   abstract {
+      return string
+      }
+   inline {
+      if (getimage(&x,&result) == Error)
+          runerr(0);
+      return result;
+      }
+end
+
+
+"ishift(i,j) - produce i shifted j bit positions (left if j<0, right if j>0)."
+
+function{1} ishift(i,j)
+
+   if !cnv:integer(i) then
+      runerr(101, i)
+   if !cnv:integer(j) then
+      runerr(101, j)
+
+   abstract {
+      return integer
+      }
+   body {
+      uword ci;			 /* shift in 0s, even if negative */
+      C_integer cj;
+#ifdef LargeInts
+      if (Type(j) == T_Lrgint)
+         runerr(101,j);
+      cj = IntVal(j);
+      if (Type(i) == T_Lrgint || cj >= WordBits
+      || ((ci=(uword)IntVal(i))!=0 && cj>0 && (ci >= (1<<(WordBits-cj-1))))) {
+         if (bigshift(&i, &j, &result) == Error)  /* alcbignum failed */
+            runerr(0);
+         return result;
+         }
+#else					/* LargeInts */
+      ci = (uword)IntVal(i);
+      cj = IntVal(j);
+#endif					/* LargeInts */
+      /*
+       * Check for a shift of WordSize or greater; handle specially because
+       *  this is beyond C's defined behavior.  Otherwise shift as requested.
+       */
+      if (cj >= WordBits)
+         return C_integer 0;
+      if (cj <= -WordBits)
+         return C_integer ((IntVal(i) >= 0) ? 0 : -1);
+      if (cj >= 0)
+         return C_integer ci << cj;
+      if (IntVal(i) >= 0)
+         return C_integer ci >> -cj;
+      /*else*/
+         return C_integer ~(~ci >> -cj);	/* sign extending shift */
+      }
+end
+
+
+"ord(s) - produce integer ordinal (value) of single character."
+
+function{1} ord(s)
+   if !cnv:tmp_string(s) then
+      runerr(103, s)
+   abstract {
+      return integer
+      }
+   body {
+      if (StrLen(s) != 1)
+         runerr(205, s);
+      return C_integer (*StrLoc(s) & 0xFF);
+      }
+end
+
+
+"name(v) - return the name of a variable."
+
+#ifdef MultiThread
+function{1} name(underef v, c)
+   declare {
+      struct progstate *prog, *savedprog;
+      }
+#else					/* MultiThread */
+function{1} name(underef v)
+#endif					/* MultiThread */
+   /*
+    * v must be a variable
+    */
+   if !is:variable(v) then
+      runerr(111, v);
+
+   abstract {
+      return string
+      }
+
+   body {
+      C_integer i;
+      if (!debug_info)
+         runerr(402);
+
+#ifdef MultiThread
+      savedprog = curpstate;
+      if (is:null(c)) {
+         prog = curpstate;
+         }
+      else if (is:coexpr(c)) {
+         prog = BlkLoc(c)->coexpr.program;
+         }
+      else {
+         runerr(118,c);
+         }
+
+      ENTERPSTATE(prog);
+#endif					/* MultiThread */
+      i = get_name(&v, &result);		/* return val ? #%#% */
+
+#ifdef MultiThread
+      ENTERPSTATE(savedprog);
+#endif					/* MultiThread */
+
+      if (i == Error)
+         runerr(0);
+      return result;
+      }
+end
+
+
+"runerr(i,x) - produce runtime error i with value x."
+
+function{} runerr(i,x[n])
+
+   if !cnv:C_integer(i) then
+      runerr(101,i)
+   body {
+      if (i <= 0) {
+         irunerr(205,i);
+         errorfail;
+         }
+      if (n == 0)
+         runerr((int)i);
+      else
+         runerr((int)i, x[0]);
+      }
+end
+
+"seq(i, j) - generate i, i+j, i+2*j, ... ."
+
+function{1,*} seq(from, by)
+
+   if !def:C_integer(from, 1) then
+      runerr(101, from)
+   if !def:C_integer(by, 1) then
+      runerr(101, by)
+   abstract {
+      return integer
+      }
+   body {
+      word seq_lb = 0, seq_ub = 0;
+
+      /*
+       * Produce error if by is 0, i.e., an infinite sequence of from's.
+       */
+      if (by > 0) {
+         seq_lb = MinLong + by;
+         seq_ub = MaxLong;
+         }
+      else if (by < 0) {
+         seq_lb = MinLong;
+         seq_ub = MaxLong + by;
+         }
+      else if (by == 0) {
+         irunerr(211, by);
+         errorfail;
+         }
+
+      /*
+       * Suspend sequence, stopping when largest or smallest integer
+       *  is reached.
+       */
+      do {
+         suspend C_integer from;
+         from += by;
+         }
+      while (from >= seq_lb && from <= seq_ub);
+
+#if !COMPILER
+      {
+      /*
+       * Suspending wipes out some things needed by the trace back code to
+       *  render the offending expression. Restore them.
+       */
+      lastop = Op_Invoke;
+      xnargs = 2;
+      xargp = r_args;
+      r_args[0].dword = D_Proc;
+      r_args[0].vword.bptr = (union block *)&Bseq;
+      }
+#endif					/* COMPILER */
+
+      runerr(203);
+      }
+end
+
+"serial(x) - return serial number of structure."
+
+function {0,1} serial(x)
+   abstract {
+      return integer
+      }
+
+   type_case x of {
+      list:   inline {
+         return C_integer BlkLoc(x)->list.id;
+         }
+      set:   inline {
+         return C_integer BlkLoc(x)->set.id;
+         }
+      table:   inline {
+         return C_integer BlkLoc(x)->table.id;
+         }
+      record:   inline {
+         return C_integer BlkLoc(x)->record.id;
+         }
+      coexpr:   inline {
+         return C_integer BlkLoc(x)->coexpr.id;
+         }
+#ifdef Graphics
+      file:   inline {
+	 if (BlkLoc(x)->file.status & Fs_Window) {
+	    wsp ws = ((wbp)(BlkLoc(x)->file.fd))->window;
+	    return C_integer ws->serial;
+	    }
+	 else {
+	    fail;
+	    }
+         }
+#endif					/* Graphics */
+      default:
+         inline { fail; }
+      }
+end
+
+"sort(x,i) - sort structure x by method i (for tables)"
+
+function{1} sort(t, i)
+   type_case t of {
+      list: {
+         abstract {
+            return type(t)
+            }
+         body {
+            register word size;
+
+            /*
+             * Sort the list by copying it into a new list and then using
+             *  qsort to sort the descriptors.  (That was easy!)
+             */
+            size = BlkLoc(t)->list.size;
+            if (cplist(&t, &result, (word)1, size + 1) == Error)
+	       runerr(0);
+            qsort((char *)BlkLoc(result)->list.listhead->lelem.lslots,
+               (int)size, sizeof(struct descrip), (int (*)()) anycmp);
+
+            Desc_EVValD(BlkLoc(result), E_Lcreate, D_List);
+            return result;
+            }
+         }
+
+      record: {
+         abstract {
+            return new list(store[type(t).all_fields])
+            }
+         body {
+            register dptr d1;
+            register word size;
+            tended struct b_list *lp;
+            union block *ep, *bp;
+            register int i;
+            /*
+             * Create a list the size of the record, copy each element into
+             * the list, and then sort the list using qsort as in list
+             * sorting and return the sorted list.
+             */
+            size = BlkLoc(t)->record.recdesc->proc.nfields;
+
+            Protect(lp = alclist(size), runerr(0));
+            Protect(ep = (union block *)alclstb(size,(word)0,size), runerr(0));
+            lp->listhead = lp->listtail = ep;
+#ifdef ListFix
+            ep->lelem.listprev = ep->lelem.listnext = (union block *) lp;
+#endif					/* ListFix */
+            bp = BlkLoc(t);  /* need not be tended if not set until now */
+
+            if (size > 0) {  /* only need to sort non-empty records */
+               d1 = lp->listhead->lelem.lslots;
+               for (i = 0; i < size; i++)
+                  *d1++ = bp->record.fields[i];
+               qsort((char *)lp->listhead->lelem.lslots,(int)size,
+                     sizeof(struct descrip), (int (*)())anycmp);
+               }
+
+            Desc_EVValD(lp, E_Lcreate, D_List);
+            return list(lp);
+            }
+         }
+
+      set: {
+         abstract {
+            return new list(store[type(t).set_elem])
+            }
+         body {
+            register dptr d1;
+            register word size;
+            register int j, k;
+            tended struct b_list *lp;
+            union block *ep, *bp;
+            register struct b_slots *seg;
+            /*
+             * Create a list the size of the set, copy each element into
+             * the list, and then sort the list using qsort as in list
+             * sorting and return the sorted list.
+             */
+            size = BlkLoc(t)->set.size;
+
+            Protect(lp = alclist(size), runerr(0));
+            Protect(ep = (union block *)alclstb(size,(word)0,size), runerr(0));
+            lp->listhead = lp->listtail = ep;
+#ifdef ListFix
+            ep->lelem.listprev = ep->lelem.listnext = (union block *)lp;
+#endif					/* ListFix */
+            bp = BlkLoc(t);  /* need not be tended if not set until now */
+
+            if (size > 0) {  /* only need to sort non-empty sets */
+               d1 = lp->listhead->lelem.lslots;
+               for (j = 0; j < HSegs && (seg = bp->table.hdir[j]) != NULL; j++)
+                  for (k = segsize[j] - 1; k >= 0; k--)
+                     for (ep = seg->hslots[k]; ep != NULL; ep= ep->telem.clink)
+                        *d1++ = ep->selem.setmem;
+               qsort((char *)lp->listhead->lelem.lslots,(int)size,
+                     sizeof(struct descrip), (int (*)())anycmp);
+               }
+
+            Desc_EVValD(lp, E_Lcreate, D_List);
+            return list(lp);
+            }
+         }
+
+      table: {
+         abstract {
+            return new list(new list(store[type(t).tbl_key ++
+               type(t).tbl_val]) ++ store[type(t).tbl_key ++ type(t).tbl_val])
+            }
+         if !def:C_integer(i, 1) then
+            runerr(101, i)
+         body {
+            register dptr d1;
+            register word size;
+            register int j, k, n;
+	    tended struct b_table *bp;
+            tended struct b_list *lp, *tp;
+            tended union block *ep, *ev;
+	    tended struct b_slots *seg;
+
+            switch ((int)i) {
+
+            /*
+             * Cases 1 and 2 are as in early versions of Icon
+             */
+               case 1:
+               case 2:
+		      {
+               /*
+                * The list resulting from the sort will have as many elements
+                *  as the table has, so get that value and also make a valid
+                *  list block size out of it.
+                */
+               size = BlkLoc(t)->table.size;
+
+	       /*
+		* Make sure, now, that there's enough room for all the
+		*  allocations we're going to need.
+		*/
+	       if (!reserve(Blocks, (word)(sizeof(struct b_list)
+		  + sizeof(struct b_lelem) + (size - 1) * sizeof(struct descrip)
+		  + size * sizeof(struct b_list)
+		  + size * (sizeof(struct b_lelem) + sizeof(struct descrip)))))
+		  runerr(0);
+               /*
+                * Point bp at the table header block of the table to be sorted
+                *  and point lp at a newly allocated list
+                *  that will hold the the result of sorting the table.
+                */
+               bp = (struct b_table *)BlkLoc(t);
+               Protect(lp = alclist(size), runerr(0));
+               Protect(ep=(union block *)alclstb(size,(word)0,size),runerr(0));
+               lp->listtail = lp->listhead = ep;
+#ifdef ListFix
+               ep->lelem.listprev = ep->lelem.listnext = (union block *) lp;
+#endif					/* ListFix */
+               /*
+                * If the table is empty, there is no need to sort anything.
+                */
+               if (size <= 0)
+                  break;
+               /*
+                * Traverse the element chain for each table bucket.  For each
+                *  element, allocate a two-element list and put the table
+                *  entry value in the first element and the assigned value in
+                *  the second element.  The two-element list is assigned to
+                *  the descriptor that d1 points at.  When this is done, the
+                *  list of two-element lists is complete, but unsorted.
+                */
+
+               n = 0;				/* list index */
+               for (j = 0; j < HSegs && (seg = bp->hdir[j]) != NULL; j++)
+                  for (k = segsize[j] - 1; k >= 0; k--)
+                     for (ep= seg->hslots[k];
+#ifdef TableFix
+			  BlkType(ep) == T_Telem;
+#else					/* TableFix */
+			  ep != NULL;
+#endif					/* TableFix */
+			  ep = ep->telem.clink){
+                        Protect(tp = alclist((word)2), runerr(0));
+                        Protect(ev = (union block *)alclstb((word)2,
+                           (word)0, (word)2), runerr(0));
+                        tp->listhead = tp->listtail = ev;
+#ifdef ListFix
+                        ev->lelem.listprev = ev->lelem.listnext =
+			   (union block *)tp;
+#endif					/* ListFix */
+                        tp->listhead->lelem.lslots[0] = ep->telem.tref;
+                        tp->listhead->lelem.lslots[1] = ep->telem.tval;
+                        d1 = &lp->listhead->lelem.lslots[n++];
+                        d1->dword = D_List;
+                        BlkLoc(*d1) = (union block *)tp;
+                        }
+               /*
+                * Sort the resulting two-element list using the sorting
+                *  function determined by i.
+                */
+               if (i == 1)
+                  qsort((char *)lp->listhead->lelem.lslots, (int)size,
+                        sizeof(struct descrip), (int (*)())trefcmp);
+               else
+                  qsort((char *)lp->listhead->lelem.lslots, (int)size,
+                        sizeof(struct descrip), (int (*)())tvalcmp);
+               break;		/* from cases 1 and 2 */
+               }
+            /*
+             * Cases 3 and 4 were introduced in Version 5.10.
+             */
+               case 3 :
+               case 4 :
+                       {
+            /*
+             * The list resulting from the sort will have twice as many
+             *  elements as the table has, so get that value and also make
+             *  a valid list block size out of it.
+             */
+            size = BlkLoc(t)->table.size * 2;
+
+            /*
+             * Point bp at the table header block of the table to be sorted
+             *  and point lp at a newly allocated list
+             *  that will hold the the result of sorting the table.
+             */
+            bp = (struct b_table *)BlkLoc(t);
+            Protect(lp = alclist(size), runerr(0));
+            Protect(ep = (union block *)alclstb(size,(word)0,size), runerr(0));
+            lp->listhead = lp->listtail = ep;
+#ifdef ListFix
+            ep->lelem.listprev = ep->lelem.listnext = (union block *)lp;
+#endif					/* ListFix */
+            /*
+             * If the table is empty there's no need to sort anything.
+             */
+            if (size <= 0)
+               break;
+
+            /*
+             * Point d1 at the start of the list elements in the new list
+             *  element block in preparation for use as an index into the list.
+             */
+            d1 = lp->listhead->lelem.lslots;
+            /*
+             * Traverse the element chain for each table bucket.  For each
+             *  table element copy the the entry descriptor and the value
+             *  descriptor into adjacent descriptors in the lslots array
+             *  in the list element block.
+             *  When this is done we now need to sort this list.
+             */
+
+            for (j = 0; j < HSegs && (seg = bp->hdir[j]) != NULL; j++)
+               for (k = segsize[j] - 1; k >= 0; k--)
+                  for (ep = seg->hslots[k];
+#ifdef TableFix
+		       BlkType(ep) == T_Telem;
+#else					/* TableFix */
+		       ep != NULL;
+#endif					/* TableFix */
+		       ep = ep->telem.clink) {
+                     *d1++ = ep->telem.tref;
+                     *d1++ = ep->telem.tval;
+                     }
+            /*
+             * Sort the resulting two-element list using the
+             *  sorting function determined by i.
+             */
+            if (i == 3)
+               qsort((char *)lp->listhead->lelem.lslots, (int)size / 2,
+                     (2 * sizeof(struct descrip)), (int (*)())trcmp3);
+            else
+               qsort((char *)lp->listhead->lelem.lslots, (int)size / 2,
+                     (2 * sizeof(struct descrip)), (int (*)())tvcmp4);
+            break; /* from case 3 or 4 */
+               }
+
+            default: {
+               irunerr(205, i);
+               errorfail;
+               }
+
+            } /* end of switch statement */
+
+            /*
+             * Make result point at the sorted list.
+             */
+
+            Desc_EVValD(lp, E_Lcreate, D_List);
+            return list(lp);
+            }
+         }
+
+      default:
+         runerr(115, t);		/* structure expected */
+      }
+end
+
+/*
+ * trefcmp(d1,d2) - compare two-element lists on first field.
+ */
+
+int trefcmp(d1,d2)
+dptr d1, d2;
+   {
+
+#ifdef DeBug
+   if (d1->dword != D_List || d2->dword != D_List)
+      syserr("trefcmp: internal consistency check fails.");
+#endif					/* DeBug */
+
+   return (anycmp(&(BlkLoc(*d1)->list.listhead->lelem.lslots[0]),
+                  &(BlkLoc(*d2)->list.listhead->lelem.lslots[0])));
+   }
+
+/*
+ * tvalcmp(d1,d2) - compare two-element lists on second field.
+ */
+
+int tvalcmp(d1,d2)
+dptr d1, d2;
+   {
+
+#ifdef DeBug
+   if (d1->dword != D_List || d2->dword != D_List)
+      syserr("tvalcmp: internal consistency check fails.");
+#endif					/* DeBug */
+
+   return (anycmp(&(BlkLoc(*d1)->list.listhead->lelem.lslots[1]),
+      &(BlkLoc(*d2)->list.listhead->lelem.lslots[1])));
+   }
+
+/*
+ * The following two routines are used to compare descriptor pairs in the
+ *  experimental table sort.
+ *
+ * trcmp3(dp1,dp2)
+ */
+
+int trcmp3(dp1,dp2)
+struct dpair *dp1,*dp2;
+{
+   return (anycmp(&((*dp1).dr),&((*dp2).dr)));
+}
+/*
+ * tvcmp4(dp1,dp2)
+ */
+
+int tvcmp4(dp1,dp2)
+struct dpair *dp1,*dp2;
+
+   {
+   return (anycmp(&((*dp1).dv),&((*dp2).dv)));
+   }
+
+
+"sortf(x,i) - sort list or set x on field i of each member"
+
+function{1} sortf(t, i)
+   type_case t of {
+      list: {
+         abstract {
+            return type(t)
+            }
+         if !def:C_integer(i, 1) then
+            runerr (101, i)
+         body {
+            register word size;
+            extern word sort_field;
+
+            if (i == 0) {
+               irunerr(205, i);
+               errorfail;
+               }
+            /*
+             * Sort the list by copying it into a new list and then using
+             *  qsort to sort the descriptors.  (That was easy!)
+             */
+            size = BlkLoc(t)->list.size;
+            if (cplist(&t, &result, (word)1, size + 1) == Error)
+               runerr(0);
+            sort_field = i;
+            qsort((char *)BlkLoc(result)->list.listhead->lelem.lslots,
+               (int)size, sizeof(struct descrip), (int (*)()) nthcmp);
+
+            Desc_EVValD(BlkLoc(result), E_Lcreate, D_List);
+            return result;
+            }
+         }
+
+      record: {
+         abstract {
+            return new list(any_value)
+            }
+         if !def:C_integer(i, 1) then
+            runerr(101, i)
+         body {
+            register dptr d1;
+            register word size;
+            tended struct b_list *lp;
+            union block *ep, *bp;
+            register int j;
+            extern word sort_field;
+
+            if (i == 0) {
+               irunerr(205, i);
+               errorfail;
+               }
+            /*
+             * Create a list the size of the record, copy each element into
+             * the list, and then sort the list using qsort as in list
+             * sorting and return the sorted list.
+             */
+            size = BlkLoc(t)->record.recdesc->proc.nfields;
+
+            Protect(lp = alclist(size), runerr(0));
+            Protect(ep = (union block *)alclstb(size,(word)0,size), runerr(0));
+            lp->listhead = lp->listtail = ep;
+#ifdef ListFix
+            ep->lelem.listprev = ep->lelem.listnext = (union block *) lp;
+#endif					/* ListFix */
+            bp = BlkLoc(t);  /* need not be tended if not set until now */
+
+            if (size > 0) {  /* only need to sort non-empty records */
+               d1 = lp->listhead->lelem.lslots;
+               for (j = 0; j < size; j++)
+                  *d1++ = bp->record.fields[j];
+               sort_field = i;
+               qsort((char *)lp->listhead->lelem.lslots,(int)size,
+                  sizeof(struct descrip), (int (*)())nthcmp);
+               }
+
+            Desc_EVValD(lp, E_Lcreate, D_List);
+            return list(lp);
+            }
+         }
+
+      set: {
+         abstract {
+            return new list(store[type(t).set_elem])
+            }
+         if !def:C_integer(i, 1) then
+            runerr (101, i)
+         body {
+            register dptr d1;
+            register word size;
+            register int j, k;
+            tended struct b_list *lp;
+            union block *ep, *bp;
+            register struct b_slots *seg;
+            extern word sort_field;
+
+            if (i == 0) {
+               irunerr(205, i);
+               errorfail;
+               }
+            /*
+             * Create a list the size of the set, copy each element into
+             * the list, and then sort the list using qsort as in list
+             * sorting and return the sorted list.
+             */
+            size = BlkLoc(t)->set.size;
+
+            Protect(lp = alclist(size), runerr(0));
+            Protect(ep = (union block *)alclstb(size,(word)0,size), runerr(0));
+            lp->listhead = lp->listtail = ep;
+#ifdef ListFix
+            ep->lelem.listprev = ep->lelem.listnext = (union block *)lp;
+#endif					/* ListFix */
+            bp = BlkLoc(t);  /* need not be tended if not set until now */
+
+            if (size > 0) {  /* only need to sort non-empty sets */
+               d1 = lp->listhead->lelem.lslots;
+               for (j = 0; j < HSegs && (seg = bp->table.hdir[j]) != NULL; j++)
+                  for (k = segsize[j] - 1; k >= 0; k--)
+                     for (ep = seg->hslots[k]; ep != NULL; ep= ep->telem.clink)
+                        *d1++ = ep->selem.setmem;
+               sort_field = i;
+               qsort((char *)lp->listhead->lelem.lslots,(int)size,
+                     sizeof(struct descrip), (int (*)())nthcmp);
+               }
+
+            Desc_EVValD(lp, E_Lcreate, D_List);
+            return list(lp);
+            }
+         }
+
+      default:
+         runerr(125, t);	/* list, record, or set expected */
+      }
+end
+
+/*
+ * nthcmp(d1,d2) - compare two descriptors on their nth fields.
+ */
+word sort_field;		/* field number, set by sort function */
+static dptr nth (dptr d);
+
+int nthcmp(d1,d2)
+dptr d1, d2;
+   {
+   int t1, t2, rv;
+   dptr e1, e2;
+
+   t1 = Type(*d1);
+   t2 = Type(*d2);
+   if (t1 == t2 && (t1 == T_Record || t1 == T_List)) {
+      e1 = nth(d1);		/* get nth field, or NULL if none such */
+      e2 = nth(d2);
+      if (e1 == NULL) {
+         if (e2 != NULL)
+            return -1;		/* no-nth-field is < any nth field */
+         }
+      else if (e2 == NULL)
+	 return 1;		/* any nth field is > no-nth-field */
+      else {
+	 /*
+	  *  Both had an nth field.  If they're unequal, that decides.
+	  */
+         rv = anycmp(nth(d1), nth(d2));
+         if (rv != 0)
+            return rv;
+         }
+      }
+   /*
+    * Comparison of nth fields was either impossible or indecisive.
+    *  Settle it by comparing the descriptors directly.
+    */
+   return anycmp(d1, d2);
+   }
+
+/*
+ * nth(d) - return the nth field of d, if any.  (sort_field is "n".)
+ */
+static dptr nth(d)
+dptr d;
+   {
+   union block *bp;
+   struct b_list *lp;
+   word i, j;
+   dptr rv;
+
+   rv = NULL;
+   if (d->dword == D_Record) {
+      /*
+       * Find the nth field of a record.
+       */
+      bp = BlkLoc(*d);
+      i = cvpos((long)sort_field, (long)(bp->record.recdesc->proc.nfields));
+      if (i != CvtFail && i <= bp->record.recdesc->proc.nfields)
+         rv = &bp->record.fields[i-1];
+      }
+   else if (d->dword == D_List) {
+      /*
+       * Find the nth element of a list.
+       */
+      lp = (struct b_list *)BlkLoc(*d);
+      i = cvpos ((long)sort_field, (long)lp->size);
+      if (i != CvtFail && i <= lp->size) {
+         /*
+          * Locate the correct list-element block.
+          */
+         bp = lp->listhead;
+         j = 1;
+         while (i >= j + bp->lelem.nused) {
+            j += bp->lelem.nused;
+            bp = bp->lelem.listnext;
+            }
+         /*
+          * Locate the desired element.
+          */
+         i += bp->lelem.first - j;
+         if (i >= bp->lelem.nslots)
+            i -= bp->lelem.nslots;
+         rv = &bp->lelem.lslots[i];
+         }
+      }
+   return rv;
+   }
+
+
+"type(x) - return type of x as a string."
+
+function{1} type(x)
+   abstract {
+      return string
+      }
+   type_case x of {
+      string:   inline { return C_string "string";    }
+      null:     inline { return C_string "null";      }
+      integer:  inline { return C_string "integer";   }
+      real:     inline { return C_string "real";      }
+      cset:     inline { return C_string "cset";      }
+      file:
+	 inline {
+#ifdef Graphics
+	    if (BlkLoc(x)->file.status & Fs_Window)
+	       return C_string "window";
+#endif					/* Graphics */
+	    return C_string "file";
+	    }
+      proc:     inline { return C_string "procedure"; }
+      list:     inline { return C_string "list";      }
+      table:    inline { return C_string "table";     }
+      set:      inline { return C_string "set";       }
+      record:   inline { return BlkLoc(x)->record.recdesc->proc.recname; }
+      coexpr:   inline { return C_string "co-expression"; }
+      default:
+         inline {
+#if !COMPILER
+            if (!Qual(x) && (Type(x)==T_External)) {
+               return C_string "external";
+               }
+            else
+#endif					/* !COMPILER */
+               runerr(123,x);
+	    }
+      }
+end
+
+
+"variable(s) - find the variable with name s and return a"
+" variable descriptor which points to its value."
+
+#ifdef MultiThread
+function{0,1} variable(s,c,i)
+#else					/* MultiThread */
+function{0,1} variable(s)
+#endif					/* MultiThread */
+
+   if !cnv:C_string(s) then
+      runerr(103, s)
+
+#ifdef MultiThread
+   if !def:C_integer(i,0) then
+      runerr(101,i)
+#endif					/* MultiThread */
+
+   abstract {
+      return variable
+      }
+
+   body {
+      register int rv;
+
+#ifdef MultiThread
+      struct progstate *prog, *savedprog;
+      struct pf_marker *tmp_pfp = pfp;
+      dptr tmp_argp = glbl_argp;
+
+      savedprog = curpstate;
+      if (!is:null(c)) {
+	 if (is:coexpr(c)) {
+	    prog = BlkLoc(c)->coexpr.program;
+	    pfp = BlkLoc(c)->coexpr.es_pfp;
+	    glbl_argp = BlkLoc(c)->coexpr.es_argp;
+	    ENTERPSTATE(prog);
+	    }
+	 else {
+	    runerr(118, c);
+	    }
+	 }
+
+      /*
+       * Produce error if i is negative
+       */
+      if (i < 0) {
+         irunerr(205, i);
+         errorfail;
+         }
+
+      while (i--) {
+	 if (pfp == NULL) fail;
+	 glbl_argp = pfp->pf_argp;
+	 pfp = pfp->pf_pfp;
+         }
+#endif					/* MultiThread */
+
+      rv = getvar(s, &result);
+
+#ifdef MultiThread
+      if (is:coexpr(c)) {
+	 ENTERPSTATE(savedprog);
+	 pfp = tmp_pfp;
+	 glbl_argp = tmp_argp;
+
+	 if ((rv == LocalName) || (rv == StaticName)) {
+	    Deref(result);
+	    }
+	 }
+#endif					/* MultiThread */
+
+      if (rv != Failed)
+         return result;
+      else
+         fail;
+      }
+end
+
+#ifdef MultiThread
+
+"cofail(CE) - transmit a co-expression failure to CE"
+
+function{0,1} cofail(CE)
+   abstract {
+      return any_value
+      }
+   if is:null(CE) then
+      body {
+	 struct b_coexpr *ce = topact((struct b_coexpr *)BlkLoc(k_current));
+	 if (ce != NULL) {
+	    CE.dword = D_Coexpr;
+	    BlkLoc(CE) = (union block *)ce;
+	    }
+	 else runerr(118,CE);
+	 }
+   else if !is:coexpr(CE) then
+      runerr(118,CE)
+   body {
+      struct b_coexpr *ncp = (struct b_coexpr *)BlkLoc(CE);
+      if (co_chng(ncp, NULL, &result, A_Cofail, 1) == A_Cofail) fail;
+      return result;
+      }
+end
+
+
+"fieldnames(r) - generate the fieldnames of record r"
+
+function{*} fieldnames(r)
+   abstract {
+      return string
+      }
+   if !is:record(r) then runerr(107,r)
+   body {
+      int i;
+      for(i=0;i<BlkLoc(r)->record.recdesc->proc.nfields;i++) {
+	 suspend BlkLoc(r)->record.recdesc->proc.lnames[i];
+         }
+      fail;
+      }
+end
+
+
+"localnames(ce,i) - produce the names of local variables"
+" in the procedure activation i levels up in ce"
+function{*} localnames(ce,i)
+   declare {
+      tended struct descrip d;
+      }
+   abstract {
+      return string
+      }
+   if is:null(ce) then inline {
+      d = k_current;
+      BlkLoc(k_current)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else if is:proc(ce) then inline {
+      int j;
+      struct b_proc *cproc = (struct b_proc *)BlkLoc(ce);
+      for(j = 0; j < cproc->ndynam; j++) {
+	 result = cproc->lnames[j + cproc->nparam];
+	 suspend result;
+         }
+      fail;
+      }
+   else if is:coexpr(ce) then inline {
+      d = ce;
+      BlkLoc(k_current)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else runerr(118, ce)
+   if !def:C_integer(i,0) then
+      runerr(101,i)
+   body {
+#if !COMPILER
+      int j;
+      dptr arg;
+      struct b_proc *cproc;
+      struct pf_marker *thePfp = BlkLoc(d)->coexpr.es_pfp;
+
+      if (thePfp == NULL) fail;
+
+      /*
+       * Produce error if i is negative
+       */
+      if (i < 0) {
+         irunerr(205, i);
+         errorfail;
+         }
+
+      while (i--) {
+	 thePfp = thePfp->pf_pfp;
+	 if (thePfp == NULL) fail;
+         }
+
+      arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1];
+      cproc = (struct b_proc *)BlkLoc(arg[0]);
+      for(j = 0; j < cproc->ndynam; j++) {
+	 result = cproc->lnames[j + cproc->nparam];
+	 suspend result;
+         }
+#endif					/* !COMPILER */
+      fail;
+      }
+end
+
+
+
+"staticnames(ce,i) - produce the names of static variables"
+" in the current procedure activation in ce"
+
+function{*} staticnames(ce,i)
+   declare {
+      tended struct descrip d;
+      }
+   abstract {
+      return string
+      }
+   if is:null(ce) then inline {
+      d = k_current;
+      BlkLoc(k_current)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else if is:proc(ce) then inline {
+      int j;
+      struct b_proc *cproc = (struct b_proc *)BlkLoc(ce);
+      for(j = 0; j < cproc->nstatic; j++) {
+	 result = cproc->lnames[j + cproc->nparam + cproc->ndynam];
+	 suspend result;
+         }
+      fail;
+      }
+   else if is:coexpr(ce) then inline {
+      d = ce;
+      BlkLoc(k_current)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else runerr(118,ce)
+   if !def:C_integer(i,0) then
+      runerr(101,i)
+   body {
+#if !COMPILER
+      int j;
+      dptr arg;
+      struct b_proc *cproc;
+      struct pf_marker *thePfp = BlkLoc(d)->coexpr.es_pfp;
+      if (thePfp == NULL) fail;
+
+      /*
+       * Produce error if i is negative
+       */
+      if (i < 0) {
+         irunerr(205, i);
+         errorfail;
+         }
+
+      while (i--) {
+	 thePfp = thePfp->pf_pfp;
+	 if (thePfp == NULL) fail;
+         }
+
+      arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1];
+      cproc = (struct b_proc *)BlkLoc(arg[0]);
+      for(j=0; j < cproc->nstatic; j++) {
+	 result = cproc->lnames[j + cproc->nparam + cproc->ndynam];
+	 suspend result;
+         }
+#endif					/* !COMPILER */
+      fail;
+      }
+end
+
+"paramnames(ce,i) - produce the names of the parameters"
+" in the current procedure activation in ce"
+
+function{1,*} paramnames(ce,i)
+   declare {
+      tended struct descrip d;
+      }
+   abstract {
+      return string
+      }
+   if is:null(ce) then inline {
+      d = k_main;
+      BlkLoc(k_main)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else if is:proc(ce) then inline {
+      int j;
+      struct b_proc *cproc = (struct b_proc *)BlkLoc(ce);
+      for(j = 0; j < cproc->nparam; j++) {
+	 result = cproc->lnames[j];
+	 suspend result;
+         }
+      fail;
+      }
+   else if is:coexpr(ce) then inline {
+      d = ce;
+      BlkLoc(k_main)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      }
+   else runerr(118,ce)
+   if !def:C_integer(i,0) then
+      runerr(101,i)
+   body {
+#if !COMPILER
+      int j;
+      dptr arg;
+      struct b_proc *cproc;
+      struct pf_marker *thePfp = BlkLoc(d)->coexpr.es_pfp;
+
+      if (thePfp == NULL) fail;
+
+      /*
+       * Produce error if i is negative
+       */
+      if (i < 0) {
+         irunerr(205, i);
+         errorfail;
+         }
+
+      while (i--) {
+	 thePfp = thePfp->pf_pfp;
+	 if (thePfp == NULL) fail;
+         }
+
+      arg = &((dptr)thePfp)[-(thePfp->pf_nargs) - 1];
+      cproc = (struct b_proc *)BlkLoc(arg[0]);
+      for(j = 0; j < cproc->nparam; j++) {
+	 result = cproc->lnames[j];
+	 suspend result;
+         }
+#endif					/* !COMPILER */
+      fail;
+      }
+end
+
+
+"load(s,arglist,input,output,error,blocksize,stringsize,stacksize) - load"
+" an icode file corresponding to string s as a co-expression."
+
+function{1} load(s,arglist,infile,outfile,errfile,
+		 blocksize, stringsize, stacksize)
+   declare {
+      tended char *loadstring;
+      C_integer _bs_, _ss_, _stk_;
+      }
+   if !cnv:C_string(s,loadstring) then
+      runerr(103,s)
+   if !def:C_integer(blocksize,abrsize,_bs_) then
+      runerr(101,blocksize)
+   if !def:C_integer(stringsize,ssize,_ss_) then
+      runerr(101,stringsize)
+   if !def:C_integer(stacksize,mstksize,_stk_) then
+      runerr(101,stacksize)
+   abstract {
+      return coexpr
+      }
+   body {
+      word *stack;
+      struct progstate *pstate;
+      char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
+      register struct b_coexpr *sblkp;
+      register struct b_refresh *rblkp;
+      struct ef_marker *newefp;
+      register dptr dp, ndp, dsp;
+      register word *newsp, *savedsp;
+      int na, nl, i, j, num_fileargs = 0;
+      struct b_file *theInput = NULL, *theOutput = NULL, *theError = NULL;
+      struct b_proc *cproc;
+      extern char *prog_name;
+
+      /*
+       * Fragments of pseudo-icode to get loaded programs started,
+       * and to handle termination.
+       */
+      static word pstart[7];
+      static word *lterm;
+
+      inst tipc;
+
+      tipc.opnd = pstart;
+      *tipc.op++ = Op_Noop; /* aligns Invokes operand */  /* ?cj? */
+      *tipc.op++ = Op_Invoke;
+      *tipc.opnd++ = 1;
+      *tipc.op++ = Op_Coret;
+      *tipc.op++ = Op_Efail;
+
+      lterm = (word *)(tipc.op);
+
+      *tipc.op++ = Op_Cofail;
+      *tipc.op++ = Op_Agoto;
+      *tipc.opnd = (word)lterm;
+
+      prog_name = loadstring;			/* set up for &progname */
+
+      /*
+       * arglist must be a list
+       */
+      if (!is:null(arglist) && !is:list(arglist))
+         runerr(108,arglist);
+
+      /*
+       * input, output, and error must be files
+       */
+      if (is:null(infile))
+	 theInput = &(curpstate->K_input);
+      else {
+	 if (!is:file(infile))
+	    runerr(105,infile);
+	 else theInput = &(BlkLoc(infile)->file);
+         }
+      if (is:null(outfile))
+	 theOutput = &(curpstate->K_output);
+      else {
+	 if (!is:file(outfile))
+	    runerr(105,outfile);
+	 else theOutput = &(BlkLoc(outfile)->file);
+         }
+      if (is:null(errfile))
+	 theError = &(curpstate->K_errout);
+      else {
+	 if (!is:file(errfile))
+	    runerr(105,errfile);
+	 else theError = &(BlkLoc(errfile)->file);
+         }
+
+      stack =
+	(word *)(sblkp = loadicode(loadstring,theInput,theOutput,theError,
+				   _bs_,_ss_,_stk_));
+      if(!stack) {
+	 fail;
+         }
+      pstate = sblkp->program;
+      pstate->parent = curpstate;
+      pstate->parentdesc = k_main;
+
+      savedsp = sp;
+      sp = stack + Wsizeof(struct b_coexpr)
+        + Wsizeof(struct progstate) + pstate->hsize/WordSize;
+      if (pstate->hsize % WordSize) sp++;
+
+#ifdef UpStack
+      sblkp->cstate[0] =
+         ((word)((char *)sblkp + (mstksize - (sizeof(*sblkp)+sizeof(struct progstate)+pstate->hsize))/2)
+            &~((word)WordSize*StackAlign-1));
+#else					/* UpStack */
+      sblkp->cstate[0] =
+	((word)((char *)sblkp + mstksize - WordSize + sizeof(struct progstate) + pstate->hsize)
+           &~((word)WordSize*StackAlign-1));
+#endif					/* UpStack */
+
+      sblkp->es_argp = NULL;
+      sblkp->es_gfp = NULL;
+      pstate->Mainhead->freshblk = nulldesc;/* &main has no refresh block. */
+					/*  This really is a bug. */
+
+      /*
+       * Set up expression frame marker to contain execution of the
+       *  main procedure.  If failure occurs in this context, control
+       *  is transferred to lterm, the address of an ...
+       */
+      newefp = (struct ef_marker *)(sp+1);
+#if IntBits != WordBits
+      newefp->ef_failure.op = (int *)lterm;
+#else					/* IntBits != WordBits */
+      newefp->ef_failure.op = lterm;
+#endif					/* IntBits != WordBits */
+
+      newefp->ef_gfp = 0;
+      newefp->ef_efp = 0;
+      newefp->ef_ilevel = ilevel/*1*/;
+      sp += Wsizeof(*newefp) - 1;
+      sblkp->es_efp = newefp;
+
+      /*
+       * The first global variable holds the value of "main".  If it
+       *  is not of type procedure, this is noted as run-time error 117.
+       *  Otherwise, this value is pushed on the stack.
+       */
+      if (pstate->Globals[0].dword != D_Proc)
+         fatalerr(117, NULL);
+
+      PushDesc(pstate->Globals[0]);
+
+      /*
+       * Create a list from arguments using Ollist and push a descriptor
+       * onto new stack.  Then create procedure frame on new stack.  Push
+       * two new null descriptors, and set sblkp->es_sp when all finished.
+       */
+      if (!is:null(arglist)) {
+         PushDesc(arglist);
+	 pstate->Glbl_argp = (dptr)(sp - 1);
+         }
+      else {
+         PushNull;
+	 pstate->Glbl_argp = (dptr)(sp - 1);
+         {
+         dptr tmpargp = (dptr) (sp - 1);
+         Ollist(0, tmpargp);
+         sp = (word *)tmpargp + 1;
+         }
+         }
+      sblkp->es_sp = (word *)sp;
+      sblkp->es_ipc.opnd = pstart;
+
+      result.dword = D_Coexpr;
+      BlkLoc(result) = (union block *)sblkp;
+      sp = savedsp;
+      return result;
+      }
+end
+
+
+"parent(ce) - given a ce, return &main for that ce's parent"
+
+function{1} parent(ce)
+   if is:null(ce) then inline { ce = k_current; }
+   else if !is:coexpr(ce) then runerr(118,ce)
+   abstract {
+      return coexpr
+      }
+   body {
+      if (BlkLoc(ce)->coexpr.program->parent == NULL) fail;
+
+      result.dword = D_Coexpr;
+      BlkLoc(result) =
+	(union block *)(BlkLoc(ce)->coexpr.program->parent->Mainhead);
+      return result;
+      }
+end
+
+#ifdef EventMon
+
+"eventmask(ce,cs) - given a ce, get or set that program's event mask"
+
+function{1} eventmask(ce,cs)
+   if !is:coexpr(ce) then runerr(118,ce)
+
+   if is:null(cs) then {
+      abstract {
+         return cset++null
+         }
+      body {
+         result = BlkLoc(ce)->coexpr.program->eventmask;
+         return result;
+         }
+      }
+   else if !cnv:cset(cs) then runerr(104,cs)
+   else {
+      abstract {
+         return cset
+         }
+      body {
+         ((struct b_coexpr *)BlkLoc(ce))->program->eventmask = cs;
+         return cs;
+         }
+      }
+end
+#endif					/* EventMon */
+
+
+"globalnames(ce) - produce the names of identifiers global to ce"
+
+function{*} globalnames(ce)
+   declare {
+      struct progstate *ps;
+      }
+   abstract {
+      return string
+      }
+   if is:null(ce) then inline { ps = curpstate; }
+   else if is:coexpr(ce) then
+      inline { ps = BlkLoc(ce)->coexpr.program; }
+   else runerr(118,ce)
+   body {
+      struct descrip *dp;
+      for (dp = ps->Gnames; dp != ps->Egnames; dp++) {
+         suspend *dp;
+         }
+      fail;
+      }
+end
+
+"keyword(kname,ce) - produce a keyword in ce's thread"
+function{*} keyword(keyname,ce)
+   declare {
+      tended struct descrip d;
+      tended char *kyname;
+      }
+   abstract {
+      return any_value
+      }
+   if !cnv:C_string(keyname,kyname) then runerr(103,keyname)
+   if is:null(ce) then inline {
+      d = k_current;
+      BlkLoc(k_current)->coexpr.es_pfp = pfp; /* sync w/ current value */
+      BlkLoc(k_current)->coexpr.es_ipc.opnd = ipc.opnd;
+      }
+   else if is:coexpr(ce) then
+      inline { d = ce; }
+   else runerr(118, ce)
+   body {
+      struct progstate *p = BlkLoc(d)->coexpr.program;
+      char *kname = kyname;
+      if (kname[0] == '&') kname++;
+      if (strcmp(kname,"allocated") == 0) {
+	 suspend C_integer stattotal + p->stringtotal + p->blocktotal;
+	 suspend C_integer stattotal;
+	 suspend C_integer p->stringtotal;
+	 return  C_integer p->blocktotal;
+	 }
+      else if (strcmp(kname,"collections") == 0) {
+	 suspend C_integer p->colltot;
+	 suspend C_integer p->collstat;
+	 suspend C_integer p->collstr;
+	 return  C_integer p->collblk;
+	 }
+      else if (strcmp(kname,"column") == 0) {
+	 struct progstate *savedp = curpstate;
+	 int i;
+	 ENTERPSTATE(p);
+	 i = findcol(BlkLoc(d)->coexpr.es_ipc.opnd);
+	 ENTERPSTATE(savedp);
+	 return C_integer i;
+	 }
+      else if (strcmp(kname,"current") == 0) {
+	 return p->K_current;
+	 }
+      else if (strcmp(kname,"error") == 0) {
+	 return kywdint(&(p->Kywd_err));
+	 }
+      else if (strcmp(kname,"errornumber") == 0) {
+	 return C_integer p->K_errornumber;
+	 }
+      else if (strcmp(kname,"errortext") == 0) {
+	 return C_string p->K_errortext;
+	 }
+      else if (strcmp(kname,"errorvalue") == 0) {
+	 return p->K_errorvalue;
+	 }
+      else if (strcmp(kname,"errout") == 0) {
+	 return file(&(p->K_errout));
+	 }
+      else if (strcmp(kname,"eventcode") == 0) {
+	 return kywdevent(&(p->eventcode));
+	 }
+      else if (strcmp(kname,"eventsource") == 0) {
+	 return kywdevent(&(p->eventsource));
+	 }
+      else if (strcmp(kname,"eventvalue") == 0) {
+	 return kywdevent(&(p->eventval));
+	 }
+      else if (strcmp(kname,"file") == 0) {
+	 struct progstate *savedp = curpstate;
+	 struct descrip s;
+	 ENTERPSTATE(p);
+	 StrLoc(s) = findfile(BlkLoc(d)->coexpr.es_ipc.opnd);
+	 StrLen(s) = strlen(StrLoc(s));
+	 ENTERPSTATE(savedp);
+	 if (!strcmp(StrLoc(s),"?")) fail;
+	 return s;
+	 }
+      else if (strcmp(kname,"input") == 0) {
+	 return file(&(p->K_input));
+	 }
+      else if (strcmp(kname,"level") == 0) {
+	 /*
+	  * Bug; levels aren't maintained per program yet.
+	  * But shouldn't they be per co-expression, not per program?
+	  */
+	 }
+      else if (strcmp(kname,"line") == 0) {
+	 struct progstate *savedp = curpstate;
+	 int i;
+	 ENTERPSTATE(p);
+	 i = findline(BlkLoc(d)->coexpr.es_ipc.opnd);
+	 ENTERPSTATE(savedp);
+	 return C_integer i;
+	 }
+      else if (strcmp(kname,"main") == 0) {
+	 return p->K_main;
+	 }
+      else if (strcmp(kname,"output") == 0) {
+	 return file(&(p->K_output));
+	 }
+      else if (strcmp(kname,"pos") == 0) {
+	 return kywdpos(&(p->Kywd_pos));
+	 }
+      else if (strcmp(kname,"progname") == 0) {
+	 return kywdstr(&(p->Kywd_prog));
+	 }
+      else if (strcmp(kname,"random") == 0) {
+	 return kywdint(&(p->Kywd_ran));
+	 }
+      else if (strcmp(kname,"regions") == 0) {
+         word allRegions = 0;
+         struct region *rp;
+
+         suspend C_integer 0;
+	 for (rp = p->stringregion; rp; rp = rp->next)
+	    allRegions += DiffPtrs(rp->end,rp->base);
+	 for (rp = p->stringregion->prev; rp; rp = rp->prev)
+	    allRegions += DiffPtrs(rp->end,rp->base);
+	 suspend C_integer allRegions;
+
+	 allRegions = 0;
+	 for (rp = p->blockregion; rp; rp = rp->next)
+	    allRegions += DiffPtrs(rp->end,rp->base);
+	 for (rp = p->blockregion->prev; rp; rp = rp->prev)
+	    allRegions += DiffPtrs(rp->end,rp->base);
+	 return C_integer allRegions;
+	 }
+      else if (strcmp(kname,"source") == 0) {
+	 return coexpr(topact((struct b_coexpr *)BlkLoc(BlkLoc(d)->coexpr.program->K_current)));
+/*
+	 if (BlkLoc(d)->coexpr.es_actstk)
+	    return coexpr(topact((struct b_coexpr *)BlkLoc(d)));
+	 else return BlkLoc(d)->coexpr.program->parent->K_main;
+*/
+	 }
+      else if (strcmp(kname,"storage") == 0) {
+	 word allRegions = 0;
+	 struct region *rp;
+	 suspend C_integer 0;
+	 for (rp = p->stringregion; rp; rp = rp->next)
+	    allRegions += DiffPtrs(rp->free,rp->base);
+	 for (rp = p->stringregion->prev; rp; rp = rp->prev)
+	    allRegions += DiffPtrs(rp->free,rp->base);
+	 suspend C_integer allRegions;
+
+	 allRegions = 0;
+	 for (rp = p->blockregion; rp; rp = rp->next)
+	    allRegions += DiffPtrs(rp->free,rp->base);
+	 for (rp = p->blockregion->prev; rp; rp = rp->prev)
+	    allRegions += DiffPtrs(rp->free,rp->base);
+	 return C_integer allRegions;
+	 }
+      else if (strcmp(kname,"subject") == 0) {
+	 return kywdsubj(&(p->ksub));
+	 }
+      else if (strcmp(kname,"trace") == 0) {
+	 return kywdint(&(p->Kywd_trc));
+	 }
+#ifdef Graphics
+      else if (strcmp(kname,"window") == 0) {
+	 return kywdwin(&(p->Kywd_xwin[XKey_Window]));
+	 }
+      else if (strcmp(kname,"col") == 0) {
+	 return kywdint(&(p->AmperCol));
+	 }
+      else if (strcmp(kname,"row") == 0) {
+	 return kywdint(&(p->AmperRow));
+	 }
+      else if (strcmp(kname,"x") == 0) {
+	 return kywdint(&(p->AmperX));
+	 }
+      else if (strcmp(kname,"y") == 0) {
+	 return kywdint(&(p->AmperY));
+	 }
+      else if (strcmp(kname,"interval") == 0) {
+	 return kywdint(&(p->AmperInterval));
+	 }
+      else if (strcmp(kname,"control") == 0) {
+	 if (p->Xmod_Control)
+	    return nulldesc;
+	 else
+	     fail;
+	 }
+      else if (strcmp(kname,"shift") == 0) {
+	 if (p->Xmod_Shift)
+	    return nulldesc;
+	 else
+	     fail;
+	 }
+      else if (strcmp(kname,"meta") == 0) {
+	 if (p->Xmod_Meta)
+	    return nulldesc;
+	 else
+	     fail;
+	 }
+#endif					/* Graphics */
+      runerr(205, keyname);
+      }
+end
+#ifdef EventMon
+
+"opmask(ce,cs) - get or set ce's program's opcode mask"
+
+function{1} opmask(ce,cs)
+   if !is:coexpr(ce) then runerr(118,ce)
+
+   if is:null(cs) then {
+      abstract {
+         return cset++null
+         }
+      body {
+         result = BlkLoc(ce)->coexpr.program->opcodemask;
+         return result;
+         }
+      }
+   else if !cnv:cset(cs) then runerr(104,cs)
+   else {
+      abstract {
+         return cset
+         }
+      body {
+         ((struct b_coexpr *)BlkLoc(ce))->program->opcodemask = cs;
+         return cs;
+         }
+      }
+end
+#endif					/* EventMon */
+
+
+"structure(x) -- generate all structures allocated in program x"
+function {*} structure(x)
+
+   if !is:coexpr(x) then
+       runerr(118, x)
+
+   abstract {
+      return list ++ set ++ table ++ record
+      }
+
+   body {
+      tended char *bp;
+      char *free;
+      tended struct descrip descr;
+      word type;
+      struct region *theregion, *rp;
+
+#ifdef MultiThread
+      theregion = ((struct b_coexpr *)BlkLoc(x))->program->blockregion;
+#else
+      theregion = curblock;
+#endif
+      for(rp = theregion; rp; rp = rp->next) {
+	 bp = rp->base;
+	 free = rp->free;
+	 while (bp < free) {
+	    type = BlkType(bp);
+	    switch (type) {
+            case T_List:
+            case T_Set:
+            case T_Table:
+            case T_Record: {
+               BlkLoc(descr) = (union block *)bp;
+               descr.dword = type | F_Ptr | D_Typecode;
+               suspend descr;
+               }
+	       }
+	    bp += BlkSize(bp);
+	    }
+	 }
+      for(rp = theregion->prev; rp; rp = rp->prev) {
+	 bp = rp->base;
+	 free = rp->free;
+	 while (bp < free) {
+	    type = BlkType(bp);
+	    switch (type) {
+            case T_List:
+            case T_Set:
+            case T_Table:
+            case T_Record: {
+               BlkLoc(descr) = (union block *)bp;
+               descr.dword = type | F_Ptr | D_Typecode;
+               suspend descr;
+               }
+	       }
+	    bp += BlkSize(bp);
+	    }
+	 }
+      fail;
+      }
+end
+
+
+#endif					/* MultiThread */
diff --git a/src/runtime/fmonitr.r b/src/runtime/fmonitr.r
new file mode 100644
index 0000000..8eeb95e
--- /dev/null
+++ b/src/runtime/fmonitr.r
@@ -0,0 +1,273 @@
+/*
+ *  fmonitr.r -- event, EvGet
+ *
+ *   This file contains event monitoring code, used only if EventMon
+ *   (event monitoring) is defined.  Event monitoring is normally is
+ *   not enabled.
+ */
+
+#ifdef EventMon
+
+/*
+ * Prototypes.
+ */
+
+void mmrefresh		(void);
+
+#define evforget()
+
+
+char typech[MaxType+1];	/* output character for each type */
+
+int noMTevents;			/* don't produce events in EVAsgn */
+
+#ifdef MultiThread
+
+static char scopechars[] = "+:^-";
+
+/*
+ * Special event function for E_Assign; allocates out of monitor's heap.
+ */
+void EVAsgn(dx)
+dptr dx;
+{
+   int i;
+   dptr procname;
+   struct progstate *parent = curpstate->parent;
+   struct region *rp = curpstate->stringregion;
+
+#if COMPILER
+   procname = &(PFDebug(*pfp)->proc->pname);
+#else					/* COMPILER */
+   procname = &((&BlkLoc(*glbl_argp)->proc)->pname);
+#endif					/* COMPILER */
+   /*
+    * call get_name, allocating out of the monitor if necessary.
+    */
+   curpstate->stringregion = parent->stringregion;
+   parent->stringregion = rp;
+   noMTevents++;
+   i = get_name(dx,&(parent->eventval));
+
+   if (i == GlobalName) {
+      if (reserve(Strings, StrLen(parent->eventval) + 1) == NULL)
+	 syserr("event monitoring out-of-memory error");
+      StrLoc(parent->eventval) =
+	 alcstr(StrLoc(parent->eventval), StrLen(parent->eventval));
+      alcstr("+",1);
+      StrLen(parent->eventval)++;
+      }
+   else if (i == StaticName || i == LocalName || i == ParamName) {
+      if (!reserve(Strings, StrLen(parent->eventval) + StrLen(*procname) + 1))
+	 syserr("event monitoring out-of-memory error");
+      StrLoc(parent->eventval) =
+	 alcstr(StrLoc(parent->eventval), StrLen(parent->eventval));
+      alcstr(scopechars+i,1);
+      alcstr(StrLoc(*procname), StrLen(*procname));
+      StrLen(parent->eventval) += StrLen(*procname) + 1;
+      }
+   else if (i == Error) {
+      noMTevents--;
+      return; /* should be more violent than this */
+      }
+
+   parent->stringregion = curpstate->stringregion;
+   curpstate->stringregion = rp;
+   noMTevents--;
+   actparent(E_Assign);
+}
+
+
+/*
+ * event(x, y, C) -- generate an event at the program level.
+ */
+
+"event(x, y, C) - create event with event code x and event value y."
+
+function{0,1} event(x,y,ce)
+   body {
+      struct progstate *dest;
+
+      if (is:null(x)) {
+	 x = curpstate->eventcode;
+	 if (is:null(y)) y = curpstate->eventval;
+	 }
+      if (is:null(ce) && is:coexpr(curpstate->parentdesc))
+	 ce = curpstate->parentdesc;
+      else if (!is:coexpr(ce)) runerr(118,ce);
+      dest = BlkLoc(ce)->coexpr.program;
+      dest->eventcode = x;
+      dest->eventval = y;
+      if (mt_activate(&(dest->eventcode),&result,
+			 (struct b_coexpr *)BlkLoc(ce)) == A_Cofail) {
+         fail;
+         }
+       return result;
+      }
+end
+
+/*
+ * EvGet(c) - user function for reading event streams.
+ */
+
+"EvGet(c,flag) - read through the next event token having a code matched "
+" by cset c."
+
+/*
+ *  EvGet returns the code of the matched token.  These keywords are also set:
+ *    &eventcode     token code
+ *    &eventvalue    token value
+ */
+function{0,1} EvGet(cs,flag)
+   if !def:cset(cs,fullcs) then
+      runerr(104,cs)
+
+   body {
+      register int c;
+      tended struct descrip dummy;
+      struct progstate *p;
+
+      /*
+       * Be sure an eventsource is available
+       */
+      if (!is:coexpr(curpstate->eventsource))
+         runerr(118,curpstate->eventsource);
+
+      /*
+       * If our event source is a child of ours, assign its event mask.
+       */
+      p = BlkLoc(curpstate->eventsource)->coexpr.program;
+      if (p->parent == curpstate)
+	 p->eventmask = cs;
+
+#ifdef Graphics
+      if (Testb((word)E_MXevent, cs) &&
+	  is:file(kywd_xwin[XKey_Window])) {
+	 wbp _w_ = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;
+	 pollctr = pollevent();
+	 if (pollctr == -1)
+	    fatalerr(141, NULL);
+	 if (BlkLoc(_w_->window->listp)->list.size > 0) {
+	    c = wgetevent(_w_, &curpstate->eventval);
+	    if (c == 0) {
+	       StrLen(curpstate->eventcode) = 1;
+	       StrLoc(curpstate->eventcode) =
+		  (char *)&allchars[E_MXevent & 0xFF];
+	       return curpstate->eventcode;
+	       }
+	    else if (c == -1)
+	       runerr(141);
+	    else
+	       runerr(143);
+	    }
+	 }
+#endif					/* Graphics */
+
+      /*
+       * Loop until we read an event allowed.
+       */
+      while (1) {
+         /*
+          * Activate the event source to produce the next event.
+          */
+	 dummy = cs;
+	 if (mt_activate(&dummy, &curpstate->eventcode,
+			 (struct b_coexpr *)BlkLoc(curpstate->eventsource)) ==
+	     A_Cofail) fail;
+	 deref(&curpstate->eventcode, &curpstate->eventcode);
+	 if (!is:string(curpstate->eventcode) ||
+	     StrLen(curpstate->eventcode) != 1) {
+	    /*
+	     * this event is out-of-band data; return or reject it
+	     * depending on whether flag is null.
+	     */
+	    if (!is:null(flag))
+	       return curpstate->eventcode;
+	    else continue;
+	    }
+
+	 switch(*StrLoc(curpstate->eventcode)) {
+	 case E_Cofail: case E_Coret: {
+	    if (BlkLoc(curpstate->eventsource)->coexpr.id == 1) {
+	       fail;
+	       }
+	    }
+	    }
+
+	 return curpstate->eventcode;
+	 }
+      }
+end
+
+#endif					/* MultiThread */
+
+/*
+ *  EVInit() - initialization.
+ */
+
+void EVInit()
+   {
+   int i;
+
+   /*
+    * Initialize the typech array, which is used if either file-based
+    * or MT-based event monitoring is enabled.
+    */
+
+   for (i = 0; i <= MaxType; i++)
+      typech[i] = '?';	/* initialize with error character */
+
+#ifdef LargeInts
+   typech[T_Lrgint]  = E_Lrgint;	/* long integer */
+#endif					/* LargeInts */
+
+   typech[T_Real]    = E_Real;		/* real number */
+   typech[T_Cset]    = E_Cset;		/* cset */
+   typech[T_File]    = E_File;		/* file block */
+   typech[T_Record]  = E_Record;	/* record block */
+   typech[T_Tvsubs]  = E_Tvsubs;	/* substring trapped variable */
+   typech[T_External]= E_External;	/* external block */
+   typech[T_List]    = E_List;		/* list header block */
+   typech[T_Lelem]   = E_Lelem;		/* list element block */
+   typech[T_Table]   = E_Table;		/* table header block */
+   typech[T_Telem]   = E_Telem;		/* table element block */
+   typech[T_Tvtbl]   = E_Tvtbl;		/* table elem trapped variable*/
+   typech[T_Set]     = E_Set;		/* set header block */
+   typech[T_Selem]   = E_Selem;		/* set element block */
+   typech[T_Slots]   = E_Slots;		/* set/table hash slots */
+   typech[T_Coexpr]  = E_Coexpr;	/* co-expression block (static) */
+   typech[T_Refresh] = E_Refresh;	/* co-expression refresh block */
+
+
+   /*
+    * codes used elsewhere but not shown here:
+    *    in the static region: E_Alien = alien (malloc block)
+    *    in the static region: E_Free = free
+    *    in the string region: E_String = string
+    */
+   }
+
+/*
+ * mmrefresh() - redraw screen, initially or after garbage collection.
+ */
+
+void mmrefresh()
+   {
+   char *p;
+   word n;
+
+   /*
+    * If the monitor is asking for E_EndCollect events, then it
+    * can handle these memory allocation "redraw" events.
+    */
+  if (!is:null(curpstate->eventmask) &&
+       Testb((word)E_EndCollect, curpstate->eventmask)) {
+      for (p = blkbase; p < blkfree; p += n) {
+	 n = BlkSize(p);
+	 EVVal(n, typech[(int)BlkType(p)]);	/* block region */
+	 }
+      EVVal(DiffPtrs(strfree, strbase), E_String);	/* string region */
+      }
+   }
+
+#endif					/* EventMon */
diff --git a/src/runtime/fscan.r b/src/runtime/fscan.r
new file mode 100644
index 0000000..8cba731
--- /dev/null
+++ b/src/runtime/fscan.r
@@ -0,0 +1,149 @@
+/*
+ * File: fscan.r
+ *  Contents: move, pos, tab.
+ */
+
+"move(i) - move &pos by i, return substring of &subject spanned."
+" Reverses effects if resumed."
+
+function{0,1+} move(i)
+
+   if !cnv:C_integer(i) then
+      runerr(101,i)
+
+   abstract {
+      return string
+      }
+
+   body {
+      register C_integer j;
+      C_integer oldpos;
+
+      /*
+       * Save old &pos.  Local variable j holds &pos before the move.
+       */
+      oldpos = j = k_pos;
+
+      /*
+       * If attempted move is past either end of the string, fail.
+       */
+      if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
+         fail;
+
+      /*
+       * Set new &pos.
+       */
+      k_pos += i;
+      EVVal(k_pos, E_Spos);
+
+      /*
+       * Make sure i >= 0.
+       */
+      if (i < 0) {
+         j += i;
+         i = -i;
+         }
+
+      /*
+       * Suspend substring of &subject that was moved over.
+       */
+      suspend string(i, StrLoc(k_subject) + j - 1);
+
+      /*
+       * If move is resumed, restore the old position and fail.
+       */
+      if (oldpos > StrLen(k_subject) + 1)
+         runerr(205, kywd_pos);
+      else {
+         k_pos = oldpos;
+         EVVal(k_pos, E_Spos);
+         }
+
+      fail;
+      }
+end
+
+
+"pos(i) - test if &pos is at position i in &subject."
+
+function{0,1} pos(i)
+
+   if !cnv:C_integer(i) then
+      runerr(101, i)
+
+   abstract {
+      return integer
+      }
+   body {
+      /*
+       * Fail if &pos is not equivalent to i, return i otherwise.
+       */
+      if ((i = cvpos(i, StrLen(k_subject))) != k_pos)
+         fail;
+      return C_integer i;
+      }
+end
+
+
+"tab(i) - set &pos to i, return substring of &subject spanned."
+"Reverses effects if resumed."
+
+function{0,1+} tab(i)
+
+   if !cnv:C_integer(i) then
+      runerr(101, i);
+
+   abstract {
+      return string
+      }
+
+   body {
+      C_integer j, t, oldpos;
+
+      /*
+       * Convert i to an absolute position.
+       */
+      i = cvpos(i, StrLen(k_subject));
+      if (i == CvtFail)
+         fail;
+
+      /*
+       * Save old &pos.  Local variable j holds &pos before the tab.
+       */
+      oldpos = j = k_pos;
+
+      /*
+       * Set new &pos.
+       */
+      k_pos = i;
+      EVVal(k_pos, E_Spos);
+
+      /*
+       *  Make i the length of the substring &subject[i:j]
+       */
+      if (j > i) {
+         t = j;
+         j = i;
+         i = t - j;
+         }
+      else
+         i = i - j;
+
+      /*
+       * Suspend the portion of &subject that was tabbed over.
+       */
+      suspend string(i, StrLoc(k_subject) + j - 1);
+
+      /*
+       * If tab is resumed, restore the old position and fail.
+       */
+      if (oldpos > StrLen(k_subject) + 1)
+         runerr(205, kywd_pos);
+      else {
+         k_pos = oldpos;
+         EVVal(k_pos, E_Spos);
+         }
+
+      fail;
+      }
+end
diff --git a/src/runtime/fstr.r b/src/runtime/fstr.r
new file mode 100644
index 0000000..08d9f10
--- /dev/null
+++ b/src/runtime/fstr.r
@@ -0,0 +1,720 @@
+/*
+ * File: fstr.r
+ *  Contents: center, detab, entab, left, map, repl, reverse, right, trim
+ */
+
+
+/*
+ * macro used by center, left, right
+ */
+#begdef FstrSetup
+   /*
+    * s1 must be a string.  n must be a non-negative integer and defaults
+    *  to 1.  s2 must be a string and defaults to a blank.
+    */
+   if !cnv:string(s1) then
+      runerr(103,s1)
+   if !def:C_integer(n,1) then
+      runerr(101, n)
+   if !def:tmp_string(s2,blank) then
+      runerr(103, s2)
+
+   abstract {
+      return string
+      }
+   body {
+      register char *s, *st;
+      word slen;
+      char *sbuf, *s3;
+
+      if (n < 0) {
+         irunerr(205,n);
+         errorfail;
+         }
+      /*
+       * The padding string is null; make it a blank.
+       */
+      if (StrLen(s2) == 0)
+         s2 = blank;
+   /* } must be supplied */
+#enddef
+
+
+"center(s1,i,s2) - pad s1 on left and right with s2 to length i."
+
+function{1} center(s1,n,s2)
+   FstrSetup /* includes body { */
+      {
+      word hcnt;
+
+      /*
+       * If we are extracting the center of a large string (not padding),
+       * just construct a descriptor.
+       */
+      if (n <= StrLen(s1)) {
+         return string(n, StrLoc(s1) + ((StrLen(s1)-n+1)>>1));
+         }
+
+      /*
+       * Get space for the new string.  Start at the right
+       *  of the new string and copy s2 into it from right to left as
+       *  many times as will fit in the right half of the new string.
+       */
+      Protect(sbuf = alcstr(NULL, n), runerr(0));
+
+      slen = StrLen(s2);
+      s3 = StrLoc(s2);
+      hcnt = n / 2;
+      s = sbuf + n;
+      while (s > sbuf + hcnt) {
+         st = s3 + slen;
+         while (st > s3 && s > sbuf + hcnt)
+            *--s = *--st;
+         }
+
+      /*
+       * Start at the left end of the new string and copy s1 into it from
+       *  left to right as many time as will fit in the left half of the
+       *  new string.
+       */
+      s = sbuf;
+      while (s < sbuf + hcnt) {
+         st = s3;
+         while (st < s3 + slen && s < sbuf + hcnt)
+            *s++ = *st++;
+         }
+
+      slen = StrLen(s1);
+      if (n < slen) {
+         /*
+          * s1 is larger than the field to center it in.  The source for the
+          *  copy starts at the appropriate point in s1 and the destination
+          *  starts at the left end of of the new string.
+          */
+         s = sbuf;
+         st = StrLoc(s1) + slen/2 - hcnt + (~n&slen&1);
+         }
+      else {
+         /*
+          * s1 is smaller than the field to center it in.  The source for the
+          *  copy starts at the left end of s1 and the destination starts at
+          *  the appropriate point in the new string.
+          */
+         s = sbuf + hcnt - slen/2 - (~n&slen&1);
+         st = StrLoc(s1);
+         }
+      /*
+       * Perform the copy, moving min(*s1,n) bytes from st to s.
+       */
+      if (slen > n)
+         slen = n;
+      while (slen-- > 0)
+         *s++ = *st++;
+
+      /*
+       * Return the new string.
+       */
+      return string(n, sbuf);
+      } }
+end
+
+
+"detab(s,i,...) - replace tabs with spaces, with stops at columns indicated."
+
+function{1} detab(s,i[n])
+
+   if !cnv:string(s) then
+      runerr(103,s)
+
+   abstract {
+      return string
+      }
+
+   body {
+      tended char *in, *out, *iend;
+      C_integer last, interval, col, target, expand, j;
+      dptr tablst;
+      dptr endlst;
+      int is_expanded = 0;
+      char c;
+
+      /*
+       * Make sure all allocations for result will go in one region
+       */
+      reserve(Strings, StrLen(s) * 8);
+
+      for (j=0; j<n; j++) {
+	 if (!cnv:integer(i[j],i[j]))
+            runerr(101,i[j]);
+	 if ((j>0) && IntVal(i[j])<=IntVal(i[j-1]))
+            runerr(210, i[j]);
+
+         }
+      /*
+       * Start out assuming the result will be the same size as the argument.
+       */
+      Protect(StrLoc(result) = alcstr(NULL, StrLen(s)), runerr(0));
+      StrLen(result) = StrLen(s);
+
+      /*
+       * Copy the string, expanding tabs.
+       */
+      last = 1;
+      if (n == 0)
+         interval = 8;
+      else {
+         if (!cnv:integer(i[0], i[0]))
+            runerr(101, i[0]);
+
+         if (IntVal(i[0]) <= last)
+            runerr(210, i[0]);
+          }
+      tablst = i;
+      endlst = &i[n];
+      col = 1;
+      iend = StrLoc(s) + StrLen(s);
+      for (in = StrLoc(s), out = StrLoc(result); in < iend; )
+         switch (c = *out++ = *in++) {
+            case '\b':
+               col--;
+               tablst = i;  /* reset the list of remaining tab stops */
+               last = 1;
+               break;
+            case '\n':
+            case '\r':
+               col = 1;
+               tablst = i;  /* reset the list of remaining tab stops */
+               last = 1;
+               break;
+            case '\t':
+               is_expanded = 1;
+               out--;
+               target = col;
+               nxttab(&target, &tablst, endlst, &last, &interval);
+               expand = target - col - 1;
+               if (expand > 0) {
+                  Protect(alcstr(NULL, expand), runerr(0));
+                  StrLen(result) += expand;
+                  }
+               while (col < target) {
+                  *out++ = ' ';
+                  col++;
+                  }
+               break;
+            default:
+               if (isprint(c))
+                  col++;
+            }
+
+      /*
+       * Return new string if indeed there were tabs; otherwise return original
+       *  string to conserve memory.
+       */
+      if (is_expanded)
+         return result;
+      else {
+	 long n = DiffPtrs(StrLoc(result),strfree); /* note deallocation */
+	 if (n < 0)
+	    EVVal(-n, E_StrDeAlc);
+	 else
+	    EVVal(n, E_String);
+	 strtotal += DiffPtrs(StrLoc(result),strfree);
+         strfree = StrLoc(result);		/* reset the free pointer */
+         return s;				/* return original string */
+         }
+      }
+end
+
+
+
+"entab(s,i,...) - replace spaces with tabs, with stops at columns indicated."
+
+function{1} entab(s,i[n])
+   if !cnv:string(s) then
+      runerr(103,s)
+
+   abstract {
+      return string
+      }
+
+   body {
+      C_integer last, interval, col, target, nt, nt1, j;
+      dptr tablst;
+      dptr endlst;
+      char *in, *out, *iend;
+      char c;
+      int inserted = 0;
+
+      for (j=0; j<n; j++) {
+	 if (!cnv:integer(i[j],i[j]))
+            runerr(101,i[j]);
+
+	 if ((j>0) && IntVal(i[j])<=IntVal(i[j-1]))
+            runerr(210, i[j]);
+         }
+
+      /*
+       * Get memory for result at end of string space.  We may give some back
+       *  if not all needed, or all of it if no tabs can be inserted.
+       */
+      Protect(StrLoc(result) = alcstr(NULL, StrLen(s)), runerr(0));
+      StrLen(result) = StrLen(s);
+
+      /*
+       * Copy the string, looking for runs of spaces.
+       */
+      last = 1;
+      if (n == 0)
+         interval = 8;
+      else {
+         if (!cnv:integer(i[0], i[0]))
+            runerr(101, i[0]);
+         if (IntVal(i[0]) <= last)
+            runerr(210, i[0]);
+         }
+      tablst = i;
+      endlst = &i[n];
+      col = 1;
+      target = 0;
+      iend = StrLoc(s) + StrLen(s);
+
+      for (in = StrLoc(s), out = StrLoc(result); in < iend; )
+         switch (c = *out++ = *in++) {
+         case '\b':
+            col--;
+            tablst = i;  /* reset the list of remaining tab stops */
+            last = 1;
+            break;
+         case '\n':
+         case '\r':
+            col = 1;
+            tablst = i;  /* reset the list of remaining tab stops */
+            last = 1;
+            break;
+         case '\t':
+            nxttab(&col, &tablst, endlst, &last, &interval);
+            break;
+         case ' ':
+            target = col + 1;
+            while (in < iend && *in == ' ')
+               target++, in++;
+            if (target - col > 1) { /* never tab just 1; already copied space */
+               nt = col;
+               nxttab(&nt, &tablst, endlst, &last, &interval);
+               if (nt == col+1) {
+                  nt1 = nt;
+                  nxttab(&nt1, &tablst, endlst, &last, &interval);
+                  if (nt1 > target) {
+                     col++;	/* keep space to avoid 1-col tab then spaces */
+                     nt = nt1;
+                     }
+                  else
+                     out--;	/* back up to begin tabbing */
+                  }
+               else
+                  out--;	/* back up to begin tabbing */
+               while (nt <= target)  {
+                  inserted = 1;
+                  *out++ = '\t';	/* put tabs to tab positions */
+                  col = nt;
+                  nxttab(&nt, &tablst, endlst, &last, &interval);
+                  }
+               while (col++ < target)
+                  *out++ = ' ';		/* complete gap with spaces */
+               }
+            col = target;
+            break;
+         default:
+            if (isprint(c))
+               col++;
+         }
+
+      /*
+       * Return new string if indeed tabs were inserted; otherwise return
+       *  original string (and reset strfree) to conserve memory.
+       */
+      if (inserted) {
+	 long n;
+         StrLen(result) = DiffPtrs(out,StrLoc(result));
+	 n = DiffPtrs(out,strfree);		/* note the deallocation */
+	 if (n < 0)
+	    EVVal(-n, E_StrDeAlc);
+	 else
+	    EVVal(n, E_String);
+	 strtotal += DiffPtrs(out,strfree);
+         strfree = out;				/* give back unused space */
+         return result;				/* return new string */
+         }
+      else {
+	 long n = DiffPtrs(StrLoc(result),strfree); /* note the deallocation */
+	 if (n < 0)
+	    EVVal(-n, E_StrDeAlc);
+	 else
+	    EVVal(n, E_String);
+	 strtotal += DiffPtrs(StrLoc(result),strfree);
+         strfree = StrLoc(result);		/* reset free pointer */
+         return s;				/* return original string */
+	 }
+      }
+end
+
+/*
+ * nxttab -- helper routine for entab and detab, returns next tab
+ *   beyond col
+ */
+
+void nxttab(col, tablst, endlst, last, interval)
+C_integer *col;
+dptr *tablst;
+dptr endlst;
+C_integer *last;
+C_integer *interval;
+   {
+   /*
+    * Look for the right tab stop.
+    */
+   while (*tablst < endlst && *col >= IntVal((*tablst)[0])) {
+      ++*tablst;
+      if (*tablst == endlst)
+         *interval = IntVal((*tablst)[-1]) - *last;
+      else {
+         *last = IntVal((*tablst)[-1]);
+         }
+      }
+   if (*tablst >= endlst)
+      *col = *col + *interval - (*col - *last) % *interval;
+   else
+      *col = IntVal((*tablst)[0]);
+   }
+
+
+"left(s1,i,s2) - pad s1 on right with s2 to length i."
+
+function{1} left(s1,n,s2)
+   FstrSetup  /* includes body { */
+
+      /*
+       * If we are extracting the left part of a large string (not padding),
+       * just construct a descriptor.
+       */
+      if (n <= StrLen(s1)) {
+	 return string(n, StrLoc(s1));
+         }
+
+      /*
+       * Get n bytes of string space.  Start at the right end of the new
+       *  string and copy s2 into the new string as many times as it fits.
+       *  Note that s2 is copied from right to left.
+       */
+      Protect(sbuf = alcstr(NULL, n), runerr(0));
+
+      slen = StrLen(s2);
+      s3 = StrLoc(s2);
+      s = sbuf + n;
+      while (s > sbuf) {
+         st = s3 + slen;
+         while (st > s3 && s > sbuf)
+            *--s = *--st;
+         }
+
+      /*
+       * Copy up to n bytes of s1 into the new string, starting at the left end
+       */
+      s = sbuf;
+      slen = StrLen(s1);
+      st = StrLoc(s1);
+      if (slen > n)
+         slen = n;
+      while (slen-- > 0)
+         *s++ = *st++;
+
+      /*
+       * Return the new string.
+       */
+      return string(n, sbuf);
+      }
+end
+
+
+"map(s1,s2,s3) - map s1, using s2 and s3."
+
+function{1} map(s1,s2,s3)
+   /*
+    * s1 must be a string; s2 and s3 default to (string conversions of)
+    *  &ucase and &lcase, respectively.
+    */
+   if !cnv:string(s1) then
+      runerr(103,s1)
+#if COMPILER
+   if !def:string(s2, ucase) then
+      runerr(103,s2)
+   if !def:string(s3, lcase) then
+      runerr(103,s3)
+#endif					/* COMPILER */
+
+   abstract {
+      return string
+      }
+   body {
+      register int i;
+      register word slen;
+      register char *str1, *str2, *str3;
+      static char maptab[256];
+
+#if !COMPILER
+      if (is:null(s2))
+         s2 = ucase;
+      if (is:null(s3))
+         s3 = lcase;
+#endif					/* !COMPILER */
+      /*
+       * If s2 and s3 are the same as for the last call of map,
+       *  the current values in maptab can be used. Otherwise, the
+       *  mapping information must be recomputed.
+       */
+      if (!EqlDesc(maps2,s2) || !EqlDesc(maps3,s3)) {
+         maps2 = s2;
+         maps3 = s3;
+
+#if !COMPILER
+         if (!cnv:string(s2,s2))
+            runerr(103,s2);
+         if (!cnv:string(s3,s3))
+            runerr(103,s3);
+#endif					/* !COMPILER */
+         /*
+          * s2 and s3 must be of the same length
+          */
+         if (StrLen(s2) != StrLen(s3))
+            runerr(208);
+
+         /*
+          * The array maptab is used to perform the mapping.  First,
+          *  maptab[i] is initialized with i for i from 0 to 255.
+          *  Then, for each character in s2, the position in maptab
+          *  corresponding to the value of the character is assigned
+          *  the value of the character in s3 that is in the same
+          *  position as the character from s2.
+          */
+         str2 = StrLoc(s2);
+         str3 = StrLoc(s3);
+         for (i = 0; i <= 255; i++)
+            maptab[i] = i;
+         for (slen = 0; slen < StrLen(s2); slen++)
+            maptab[str2[slen]&0377] = str3[slen];
+         }
+
+      if (StrLen(s1) == 0) {
+         return emptystr;
+         }
+
+      /*
+       * The result is a string the size of s1; create the result
+       *  string, but specify no value for it.
+       */
+      StrLen(result) = slen = StrLen(s1);
+      Protect(StrLoc(result) = alcstr(NULL, slen), runerr(0));
+      str1 = StrLoc(s1);
+      str2 = StrLoc(result);
+
+      /*
+       * Run through the string, using values in maptab to do the
+       *  mapping.
+       */
+      while (slen-- > 0)
+         *str2++ = maptab[(*str1++)&0377];
+
+      return result;
+      }
+end
+
+
+"repl(s,i) - concatenate i copies of string s."
+
+function{1} repl(s,n)
+
+   if !cnv:string(s) then
+      runerr(103,s)
+
+   if !cnv:C_integer(n) then
+      runerr(101,n)
+
+   abstract {
+       return string
+       }
+
+   body {
+      register C_integer cnt;
+      register C_integer slen;
+      register C_integer size;
+      register char * resloc, * sloc, *floc;
+
+      if (n < 0) {
+         irunerr(205,n);
+         errorfail;
+         }
+
+      slen = StrLen(s);
+      /*
+       * Return an empty string if n is 0 or if s is the empty string.
+       */
+      if ((n == 0) || (slen==0))
+         return emptystr;
+
+      /*
+       * Make sure the resulting string will not be too long.
+       */
+      size = n * slen;
+      if (size > MaxStrLen) {
+         irunerr(205,n);
+         errorfail;
+         }
+
+      /*
+       * Make result a descriptor for the replicated string.
+       */
+      Protect(resloc = alcstr(NULL, size), runerr(0));
+
+      StrLoc(result) = resloc;
+      StrLen(result) = size;
+
+      /*
+       * Fill the allocated area with copies of s.
+       */
+      sloc = StrLoc(s);
+      if (slen == 1)
+         memset(resloc, *sloc, size);
+      else {
+         while (--n >= 0) {
+            floc = sloc;
+            cnt = slen;
+            while (--cnt >= 0)
+               *resloc++ = *floc++;
+            }
+         }
+
+      return result;
+      }
+end
+
+
+"reverse(s) - reverse string s."
+
+function{1} reverse(s)
+
+   if !cnv:string(s) then
+      runerr(103,s)
+
+   abstract {
+      return string
+      }
+   body {
+      register char c, *floc, *lloc;
+      register word slen;
+
+      /*
+       * Allocate a copy of s.
+       */
+      slen = StrLen(s);
+      Protect(StrLoc(result) = alcstr(StrLoc(s), slen), runerr(0));
+      StrLen(result) = slen;
+
+      /*
+       * Point floc at the start of s and lloc at the end of s.  Work floc
+       *  and sloc along s in opposite directions, swapping the characters
+       *  at floc and lloc.
+       */
+      floc = StrLoc(result);
+      lloc = floc + --slen;
+      while (floc < lloc) {
+         c = *floc;
+         *floc++ = *lloc;
+         *lloc-- = c;
+         }
+      return result;
+      }
+end
+
+
+"right(s1,i,s2) - pad s1 on left with s2 to length i."
+
+function{1} right(s1,n,s2)
+   FstrSetup  /* includes body { */
+      /*
+       * If we are extracting the right part of a large string (not padding),
+       * just construct a descriptor.
+       */
+      if (n <= StrLen(s1)) {
+	 return string(n, StrLoc(s1) + StrLen(s1) - n);
+         }
+
+      /*
+       * Get n bytes of string space.  Start at the left end of the new
+       *  string and copy s2 into the new string as many times as it fits.
+       */
+      Protect(sbuf = alcstr(NULL, n), runerr(0));
+
+      slen = StrLen(s2);
+      s3 = StrLoc(s2);
+      s = sbuf;
+      while (s < sbuf + n) {
+         st = s3;
+         while (st < s3 + slen && s < sbuf + n)
+            *s++ = *st++;
+         }
+
+      /*
+       * Copy s1 into the new string, starting at the right end and copying
+       * s2 from right to left.  If *s1 > n, only copy n bytes.
+       */
+      s = sbuf + n;
+      slen = StrLen(s1);
+      st = StrLoc(s1) + slen;
+      if (slen > n)
+         slen = n;
+      while (slen-- > 0)
+         *--s = *--st;
+
+      /*
+       * Return the new string.
+       */
+      return string(n, sbuf);
+      }
+end
+
+
+"trim(s,c) - trim trailing characters in c from s."
+
+function{1} trim(s,c)
+
+   if !cnv:string(s) then
+      runerr(103, s)
+   /*
+    * c defaults to a cset containing a blank.
+    */
+   if !def:tmp_cset(c,blankcs) then
+      runerr(104, c)
+
+   abstract {
+      return string
+      }
+
+   body {
+      char *sloc;
+      C_integer slen;
+
+      /*
+       * Start at the end of s and then back up until a character that is
+       *  not in c is found.  The actual trimming is done by having a
+       *  descriptor that points at a substring of s, but with the length
+       *  reduced.
+       */
+      slen = StrLen(s);
+      sloc = StrLoc(s) + slen - 1;
+      while (sloc >= StrLoc(s) && Testb(*sloc, c)) {
+         sloc--;
+         slen--;
+         }
+      return string(slen, StrLoc(s));
+      }
+end
diff --git a/src/runtime/fstranl.r b/src/runtime/fstranl.r
new file mode 100644
index 0000000..be13839
--- /dev/null
+++ b/src/runtime/fstranl.r
@@ -0,0 +1,260 @@
+/*
+ * File: fstranl.r
+ * String analysis functions: any,bal,find,many,match,upto
+ *
+ * str_anal is a macro for performing the standard conversions and
+ *  defaulting for string analysis functions. It takes as arguments the
+ *  parameters for subject, beginning position, and ending position. It
+ *  produces declarations for these 3 names prepended with cnv_. These
+ *  variables will contain the converted versions of the arguments.
+ */
+#begdef str_anal(s, i, j)
+   declare {
+      C_integer cnv_ ## i;
+      C_integer cnv_ ## j;
+      }
+
+   abstract {
+      return integer
+      }
+
+   if is:null(s) then {
+      inline {
+         s = k_subject;
+         }
+      if is:null(i) then inline {
+         cnv_ ## i = k_pos;
+         }
+      }
+   else {
+      if !cnv:string(s) then
+         runerr(103,s)
+      if is:null(i) then inline {
+         cnv_ ## i = 1;
+         }
+      }
+
+   if !is:null(i) then
+      if cnv:C_integer(i,cnv_ ## i) then inline {
+         if ((cnv_ ## i = cvpos(cnv_ ## i, StrLen(s))) == CvtFail)
+            fail;
+         }
+      else
+         runerr(101,i)
+
+
+    if is:null(j) then inline {
+       cnv_ ## j = StrLen(s) + 1;
+       }
+    else if cnv:C_integer(j,cnv_ ## j) then inline {
+       if ((cnv_ ## j = cvpos(cnv_ ## j, StrLen(s))) == CvtFail)
+          fail;
+       if (cnv_ ## i > cnv_ ## j) {
+          register C_integer tmp;
+          tmp = cnv_ ## i;
+          cnv_ ## i = cnv_ ## j;
+          cnv_ ## j = tmp;
+          }
+       }
+    else
+       runerr(101,j)
+
+#enddef
+
+
+"any(c,s,i1,i2) - produces i1+1 if i2 is greater than 1 and s[i] is contained "
+"in c and poseq(i2,x) is greater than poseq(i1,x), but fails otherwise."
+
+function{0,1} any(c,s,i,j)
+   str_anal( s, i, j )
+   if !cnv:tmp_cset(c) then
+      runerr(104,c)
+   body {
+      if (cnv_i == cnv_j)
+         fail;
+      if (!Testb(StrLoc(s)[cnv_i-1], c))
+         fail;
+      return C_integer cnv_i+1;
+      }
+end
+
+
+"bal(c1,c2,c3,s,i1,i2) - generates the sequence of integer positions in s up to"
+" a character of c1 in s[i1:i2] that is balanced with respect to characters in"
+" c2 and c3, but fails if there is no such position."
+
+function{*} bal(c1,c2,c3,s,i,j)
+   str_anal( s, i, j )
+   if !def:tmp_cset(c1,fullcs) then
+      runerr(104,c1)
+   if !def:tmp_cset(c2,lparcs) then
+      runerr(104,c2)
+   if !def:tmp_cset(c3,rparcs) then
+      runerr(104,c3)
+
+   body {
+      C_integer cnt;
+      char c;
+
+      /*
+       * Loop through characters in s[i:j].  When a character in c2
+       * is found, increment cnt; when a character in c3 is found, decrement
+       * cnt.  When cnt is 0 there have been an equal number of occurrences
+       * of characters in c2 and c3, i.e., the string to the left of
+       * i is balanced.  If the string is balanced and the current character
+       * (s[i]) is in c, suspend with i.  Note that if cnt drops below
+       *  zero, bal fails.
+       */
+      cnt = 0;
+      while (cnv_i < cnv_j) {
+         c = StrLoc(s)[cnv_i-1];
+         if (cnt == 0 && Testb(c, c1)) {
+            suspend C_integer cnv_i;
+            }
+         if (Testb(c, c2))
+            cnt++;
+         else if (Testb(c, c3))
+            cnt--;
+         if (cnt < 0)
+            fail;
+         cnv_i++;
+         }
+      /*
+       * Eventually fail.
+       */
+      fail;
+      }
+end
+
+
+"find(s1,s2,i1,i2) - generates the sequence of positions in s2 at which "
+"s1 occurs as a substring in s2[i1:i2], but fails if there is no such position."
+
+function{*} find(s1,s2,i,j)
+   str_anal( s2, i, j )
+   if !cnv:string(s1) then
+      runerr(103,s1)
+
+   body {
+      register char *str1, *str2;
+      C_integer s1_len, l, term;
+
+      /*
+       * Loop through s2[i:j] trying to find s1 at each point, stopping
+       * when the remaining portion s2[i:j] is too short to contain s1.
+       * Optimize me!
+       */
+      s1_len = StrLen(s1);
+      term = cnv_j - s1_len;
+      while (cnv_i <= term) {
+         str1 = StrLoc(s1);
+         str2 = StrLoc(s2) + cnv_i - 1;
+         l    = s1_len;
+
+         /*
+          * Compare strings on a byte-wise basis; if the end is reached
+          * before inequality is found, suspend with the position of the
+          * string.
+          */
+         do {
+            if (l-- <= 0) {
+               suspend C_integer cnv_i;
+               break;
+               }
+            } while (*str1++ == *str2++);
+         cnv_i++;
+         }
+      fail;
+      }
+end
+
+
+"many(c,s,i1,i2) - produces the position in s after the longest initial "
+"sequence of characters in c in s[i1:i2] but fails if there is none."
+
+function{0,1} many(c,s,i,j)
+   str_anal( s, i, j )
+   if !cnv:tmp_cset(c) then
+      runerr(104,c)
+   body {
+      C_integer start_i = cnv_i;
+      /*
+       * Move i along s[i:j] until a character that is not in c is found
+       *  or the end of the string is reached.
+       */
+      while (cnv_i < cnv_j) {
+         if (!Testb(StrLoc(s)[cnv_i-1], c))
+            break;
+         cnv_i++;
+         }
+      /*
+       * Fail if no characters in c were found; otherwise
+       *  return the position of the first character not in c.
+       */
+      if (cnv_i == start_i)
+         fail;
+      return C_integer cnv_i;
+      }
+end
+
+
+"match(s1,s2,i1,i2) - produces i1+*s1 if s1==s2[i1+:*s1], but fails otherwise."
+
+function{0,1} match(s1,s2,i,j)
+   str_anal( s2, i, j )
+   if !cnv:tmp_string(s1) then
+      runerr(103,s1)
+   body {
+      char *str1, *str2;
+
+      /*
+       * Cannot match unless s2[i:j] is as long as s1.
+       */
+      if (cnv_j - cnv_i < StrLen(s1))
+         fail;
+
+      /*
+       * Compare s1 with s2[i:j] for *s1 characters; fail if an
+       *  inequality is found.
+       */
+      str1 = StrLoc(s1);
+      str2 = StrLoc(s2) + cnv_i - 1;
+      for (cnv_j = StrLen(s1); cnv_j > 0; cnv_j--)
+         if (*str1++ != *str2++)
+            fail;
+
+      /*
+       * Return position of end of matched string in s2.
+       */
+      return C_integer cnv_i + StrLen(s1);
+      }
+end
+
+
+"upto(c,s,i1,i2) - generates the sequence of integer positions in s up to a "
+"character in c in s[i2:i2], but fails if there is no such position."
+
+function{*} upto(c,s,i,j)
+   str_anal( s, i, j )
+   if !cnv:tmp_cset(c) then
+      runerr(104,c)
+   body {
+      C_integer tmp;
+
+      /*
+       * Look through s[i:j] and suspend position of each occurrence of
+       * of a character in c.
+       */
+      while (cnv_i < cnv_j) {
+         tmp = (C_integer)StrLoc(s)[cnv_i-1];
+         if (Testb(tmp, c)) {
+            suspend C_integer cnv_i;
+            }
+         cnv_i++;
+         }
+      /*
+       * Eventually fail.
+       */
+      fail;
+      }
+end
diff --git a/src/runtime/fstruct.r b/src/runtime/fstruct.r
new file mode 100644
index 0000000..469c3c5
--- /dev/null
+++ b/src/runtime/fstruct.r
@@ -0,0 +1,906 @@
+/*
+ * File: fstruct.r
+ *  Contents: delete, get, key, insert, list, member, pop, pull, push, put,
+ *  set, table
+ */
+
+"delete(x1,x2) - delete element x2 from set or table x1 if it is there"
+" (always succeeds and returns x1)."
+
+function{1} delete(s,x)
+   abstract {
+      return type(s) ** (set ++ table)
+      }
+
+   /*
+    * The technique and philosophy here are the same
+    *  as used in insert - see comment there.
+    */
+   type_case s of {
+      set:
+         body {
+            register uword hn;
+            register union block **pd;
+            int res;
+
+            hn = hash(&x);
+
+            pd = memb(BlkLoc(s), &x, hn, &res);
+            if (res == 1) {
+               /*
+               * The element is there so delete it.
+               */
+               *pd = (*pd)->selem.clink;
+               (BlkLoc(s)->set.size)--;
+               }
+
+            EVValD(&s, E_Sdelete);
+            EVValD(&x, E_Sval);
+            return s;
+	    }
+      table:
+         body {
+            register union block **pd;
+            register uword hn;
+            int res;
+
+            hn = hash(&x);
+            pd = memb(BlkLoc(s), &x, hn, &res);
+            if (res == 1) {
+               /*
+                * The element is there so delete it.
+                */
+               *pd = (*pd)->telem.clink;
+               (BlkLoc(s)->table.size)--;
+               }
+
+            EVValD(&s, E_Tdelete);
+            EVValD(&x, E_Tsub);
+            return s;
+            }
+      default:
+         runerr(122, s)
+      }
+end
+
+
+/*
+ * c_get - convenient C-level access to the get function
+ *  returns 0 on failure, otherwise fills in res
+ */
+int c_get(hp, res)
+struct b_list *hp;
+struct descrip *res;
+{
+   register word i;
+   register struct b_lelem *bp;
+
+   /*
+    * Fail if the list is empty.
+    */
+   if (hp->size <= 0)
+      return 0;
+
+   /*
+    * Point bp at the first list block.  If the first block has no
+    *  elements in use, point bp at the next list block.
+    */
+   bp = (struct b_lelem *) hp->listhead;
+   if (bp->nused <= 0) {
+      bp = (struct b_lelem *) bp->listnext;
+      hp->listhead = (union block *) bp;
+#ifdef ListFix
+      bp->listprev = (union block *) hp;
+#else					/* ListFix */
+      bp->listprev = NULL;
+#endif					/* ListFix */
+      }
+
+   /*
+    * Locate first element and assign it to result for return.
+    */
+   i = bp->first;
+   *res = bp->lslots[i];
+
+   /*
+    * Set bp->first to new first element, or 0 if the block is now
+    *  empty.  Decrement the usage count for the block and the size
+    *  of the list.
+    */
+   if (++i >= bp->nslots)
+      i = 0;
+   bp->first = i;
+   bp->nused--;
+   hp->size--;
+
+   return 1;
+}
+
+#begdef GetOrPop(get_or_pop)
+#get_or_pop "(x) - " #get_or_pop " an element from the left end of list x."
+/*
+ * get(L) - get an element from end of list L.
+ *  Identical to pop(L).
+ */
+function{0,1} get_or_pop(x)
+   if !is:list(x) then
+      runerr(108, x)
+
+   abstract {
+      return store[type(x).lst_elem]
+      }
+
+   body {
+      EVValD(&x, E_Lget);
+      if (!c_get((struct b_list *)BlkLoc(x), &result)) fail;
+      return result;
+      }
+end
+#enddef
+
+GetOrPop(get) /* get(x) - get an element from the left end of list x. */
+GetOrPop(pop) /* pop(x) - pop an element from the left end of list x. */
+
+
+"key(T) - generate successive keys (entry values) from table T."
+
+function{*} key(t)
+   if !is:table(t) then
+         runerr(124, t)
+
+   abstract {
+      return store[type(t).tbl_key]
+      }
+
+   inline {
+      tended union block *ep;
+      struct hgstate state;
+
+      EVValD(&t, E_Tkey);
+      for (ep = hgfirst(BlkLoc(t), &state); ep != 0;
+	 ep = hgnext(BlkLoc(t), &state, ep)) {
+            EVValD(&ep->telem.tref, E_Tsub);
+            suspend ep->telem.tref;
+            }
+      fail;
+      }
+end
+
+
+"insert(x1, x2, x3) - insert element x2 into set or table x1 if not already there"
+" if x1 is a table, the assigned value for element x2 is x3."
+" (always succeeds and returns x1)."
+
+function{1} insert(s, x, y)
+   type_case s of {
+
+      set: {
+         abstract {
+            store[type(s).set_elem] = type(x)
+            return type(s)
+            }
+
+         body {
+            tended union block *bp, *bp2;
+            register uword hn;
+            int res;
+            struct b_selem *se;
+            register union block **pd;
+
+            bp = BlkLoc(s);
+            hn = hash(&x);
+            /*
+             * If x is a member of set s then res will have the value 1,
+             *  and pd will have a pointer to the pointer
+             *  that points to that member.
+             *  If x is not a member of the set then res will have
+             *  the value 0 and pd will point to the pointer
+             *  which should point to the member - thus we know where
+             *  to link in the new element without having to do any
+             *  repetitive looking.
+             */
+
+	    /* get this now because can't tend pd */
+            Protect(se = alcselem(&x, hn), runerr(0));
+
+            pd = memb(bp, &x, hn, &res);
+            if (res == 0) {
+               /*
+               * The element is not in the set - insert it.
+               */
+               addmem((struct b_set *)bp, se, pd);
+               if (TooCrowded(bp))
+                  hgrow(bp);
+               }
+	    else
+	       deallocate((union block *)se);
+
+            EVValD(&s, E_Sinsert);
+            EVValD(&x, E_Sval);
+            return s;
+            }
+         }
+
+      table: {
+         abstract {
+            store[type(s).tbl_key] = type(x)
+            store[type(s).tbl_val] = type(y)
+            return type(s)
+            }
+
+         body {
+            tended union block *bp, *bp2;
+            union block **pd;
+            struct b_telem *te;
+            register uword hn;
+            int res;
+
+            bp = BlkLoc(s);
+            hn = hash(&x);
+
+	    /* get this now because can't tend pd */
+            Protect(te = alctelem(), runerr(0));
+
+            pd = memb(bp, &x, hn, &res);	/* search table for key */
+            if (res == 0) {
+               /*
+               * The element is not in the table - insert it.
+               */
+               bp->table.size++;
+               te->clink = *pd;
+               *pd = (union block *)te;
+               te->hashnum = hn;
+               te->tref = x;
+               te->tval = y;
+               if (TooCrowded(bp))
+                  hgrow(bp);
+               }
+            else {
+	       /*
+		* We found an existing entry; just change its value.
+		*/
+	       deallocate((union block *)te);
+               te = (struct b_telem *) *pd;
+               te->tval = y;
+               }
+
+            EVValD(&s, E_Tinsert);
+            EVValD(&x, E_Tsub);
+            return s;
+            }
+         }
+
+      default:
+         runerr(122, s);
+      }
+end
+
+
+"list(i, x) - create a list of size i, with initial value x."
+
+function{1} list(n, x)
+   if !def:C_integer(n, 0L) then
+      runerr(101, n)
+
+   abstract {
+      return new list(type(x))
+      }
+
+   body {
+      tended struct b_list *hp;
+      register word i, size;
+      word nslots;
+      register struct b_lelem *bp; /* does not need to be tended */
+
+      nslots = size = n;
+
+      /*
+       * Ensure that the size is positive and that the list-element block
+       *  has at least MinListSlots slots.
+       */
+      if (size < 0) {
+         irunerr(205, n);
+         errorfail;
+         }
+      if (nslots == 0)
+         nslots = MinListSlots;
+
+      /*
+       * Allocate the list-header block and a list-element block.
+       *  Note that nslots is the number of slots in the list-element
+       *  block while size is the number of elements in the list.
+       */
+      Protect(hp = alclist(size), runerr(0));
+      Protect(bp = alclstb(nslots, (word)0, size), runerr(0));
+      hp->listhead = hp->listtail = (union block *) bp;
+#ifdef ListFix
+      bp->listprev = bp->listnext = (union block *) hp;
+#endif					/* ListFix */
+
+      /*
+       * Initialize each slot.
+       */
+      for (i = 0; i < size; i++)
+         bp->lslots[i] = x;
+
+      Desc_EVValD(hp, E_Lcreate, D_List);
+
+      /*
+       * Return the new list.
+       */
+      return list(hp);
+      }
+end
+
+
+"member(x1, x2) - returns x1 if x2 is a member of set or table x2 but fails"
+" otherwise."
+
+function{0,1} member(s, x)
+   type_case s of {
+
+      set: {
+         abstract {
+            return type(x) ** store[type(s).set_elem]
+            }
+         inline {
+            int res;
+            register uword hn;
+
+            EVValD(&s, E_Smember);
+            EVValD(&x, E_Sval);
+
+            hn = hash(&x);
+            memb(BlkLoc(s), &x, hn, &res);
+            if (res==1)
+               return x;
+            else
+               fail;
+            }
+         }
+      table: {
+         abstract {
+            return type(x) ** store[type(s).tbl_key]
+            }
+         inline {
+            int res;
+            register uword hn;
+
+            EVValD(&s, E_Tmember);
+            EVValD(&x, E_Tsub);
+
+            hn = hash(&x);
+            memb(BlkLoc(s), &x, hn, &res);
+            if (res == 1)
+               return x;
+            else
+               fail;
+            }
+         }
+      default:
+         runerr(122, s)
+      }
+end
+
+
+"pull(L) - pull an element from end of list L."
+
+function{0,1} pull(x)
+   /*
+    * x must be a list.
+    */
+   if !is:list(x) then
+      runerr(108, x)
+   abstract {
+      return store[type(x).lst_elem]
+      }
+
+   body {
+      register word i;
+      register struct b_list *hp;
+      register struct b_lelem *bp;
+
+      EVValD(&x, E_Lpull);
+
+      /*
+       * Point at list header block and fail if the list is empty.
+       */
+      hp = (struct b_list *) BlkLoc(x);
+      if (hp->size <= 0)
+         fail;
+
+      /*
+       * Point bp at the last list element block.  If the last block has no
+       *  elements in use, point bp at the previous list element block.
+       */
+      bp = (struct b_lelem *) hp->listtail;
+      if (bp->nused <= 0) {
+         bp = (struct b_lelem *) bp->listprev;
+         hp->listtail = (union block *) bp;
+#ifdef ListFix
+         bp->listnext = (union block *) hp;
+#else					/* ListFix */
+         bp->listnext = NULL;
+#endif					/* ListFix */
+         }
+
+      /*
+       * Set i to position of last element and assign the element to
+       *  result for return.  Decrement the usage count for the block
+       *  and the size of the list.
+       */
+      i = bp->first + bp->nused - 1;
+      if (i >= bp->nslots)
+         i -= bp->nslots;
+      result = bp->lslots[i];
+      bp->nused--;
+      hp->size--;
+      return result;
+      }
+end
+
+#ifdef Graphics
+/*
+ * c_push - C-level, nontending push operation
+ */
+void c_push(l, val)
+dptr l;
+dptr val;
+{
+   register word i;
+   register struct b_lelem *bp; /* does not need to be tended */
+   static int two = 2;		/* some compilers generate bad code for
+				   division by a constant that's a power of 2*/
+   /*
+    * Point bp at the first list-element block.
+    */
+   bp = (struct b_lelem *) BlkLoc(*l)->list.listhead;
+
+#ifdef EventMon		/* initialize i so it's 0 if first list-element */
+   i = 0;			/* block isn't full */
+#endif					/* EventMon */
+
+   /*
+    * If the first list-element block is full, allocate a new
+    *  list-element block, make it the first list-element block,
+    *  and make it the previous block of the former first list-element
+    *  block.
+    */
+   if (bp->nused >= bp->nslots) {
+      /*
+       * Set i to the size of block to allocate.
+       */
+      i = BlkLoc(*l)->list.size / two;
+      if (i < MinListSlots)
+         i = MinListSlots;
+#ifdef MaxListSlots
+      if (i > MaxListSlots)
+         i = MaxListSlots;
+#endif					/* MaxListSlots */
+
+      /*
+       * Allocate a new list element block.  If the block can't
+       *  be allocated, try smaller blocks.
+       */
+      while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
+         i /= 4;
+         if (i < MinListSlots)
+            fatalerr(0, NULL);
+         }
+
+      BlkLoc(*l)->list.listhead->lelem.listprev = (union block *) bp;
+#ifdef ListFix
+      bp->listprev = BlkLoc(*l);
+#endif					/* ListFix */
+      bp->listnext = BlkLoc(*l)->list.listhead;
+      BlkLoc(*l)->list.listhead = (union block *) bp;
+      }
+
+   /*
+    * Set i to position of new first element and assign val to
+    *  that element.
+    */
+   i = bp->first - 1;
+   if (i < 0)
+      i = bp->nslots - 1;
+   bp->lslots[i] = *val;
+   /*
+    * Adjust value of location of first element, block usage count,
+    *  and current list size.
+    */
+   bp->first = i;
+   bp->nused++;
+   BlkLoc(*l)->list.size++;
+   }
+#endif					/* Graphics */
+
+
+"push(L, x1, ..., xN) - push x onto beginning of list L."
+
+function{1} push(x, vals[n])
+   /*
+    * x must be a list.
+    */
+   if !is:list(x) then
+      runerr(108, x)
+   abstract {
+      store[type(x).lst_elem] = type(vals)
+      return type(x)
+      }
+
+   body {
+      tended struct b_list *hp;
+      dptr dp;
+      register word i, val, num;
+      register struct b_lelem *bp; /* does not need to be tended */
+      static int two = 2;	/* some compilers generate bad code for
+				   division by a constant that's a power of 2*/
+
+      if (n == 0) {
+	 dp = &nulldesc;
+	 num = 1;
+	 }
+      else {
+	 dp = vals;
+	 num = n;
+	 }
+
+      for (val = 0; val < num; val++) {
+	 /*
+	  * Point hp at the list-header block and bp at the first
+	  *  list-element block.
+	  */
+	 hp = (struct b_list *) BlkLoc(x);
+	 bp = (struct b_lelem *) hp->listhead;
+
+#ifdef EventMon		/* initialize i so it's 0 if first list-element */
+	 i = 0;			/* block isn't full */
+#endif					/* EventMon */
+
+	 /*
+	  * If the first list-element block is full, allocate a new
+	  *  list-element block, make it the first list-element block,
+	  *  and make it the previous block of the former first list-element
+	  *  block.
+	  */
+	 if (bp->nused >= bp->nslots) {
+	    /*
+	     * Set i to the size of block to allocate.
+	     */
+	    i = hp->size / two;
+	    if (i < MinListSlots)
+	       i = MinListSlots;
+#ifdef MaxListSlots
+	    if (i > MaxListSlots)
+	       i = MaxListSlots;
+#endif					/* MaxListSlots */
+
+	    /*
+	     * Allocate a new list element block.  If the block can't
+	     *  be allocated, try smaller blocks.
+	     */
+	    while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
+	       i /= 4;
+	       if (i < MinListSlots)
+		  runerr(0);
+	       }
+
+	    hp->listhead->lelem.listprev = (union block *) bp;
+#ifdef ListFix
+	    bp->listprev = (union block *) hp;
+#endif					/* ListFix */
+	    bp->listnext = hp->listhead;
+	    hp->listhead = (union block *) bp;
+	    }
+
+	 /*
+	  * Set i to position of new first element and assign val to
+	  *  that element.
+	  */
+	 i = bp->first - 1;
+	 if (i < 0)
+	    i = bp->nslots - 1;
+	 bp->lslots[i] = dp[val];
+	 /*
+	  * Adjust value of location of first element, block usage count,
+	  *  and current list size.
+	  */
+	 bp->first = i;
+	 bp->nused++;
+	 hp->size++;
+	 }
+
+      EVValD(&x, E_Lpush);
+
+      /*
+       * Return the list.
+       */
+      return x;
+      }
+end
+
+/*
+ * c_put - C-level, nontending list put function
+ */
+void c_put(l, val)
+struct descrip *l;
+struct descrip *val;
+{
+   register word i;
+   register struct b_lelem *bp;  /* does not need to be tended */
+   static int two = 2;		/* some compilers generate bad code for
+				   division by a constant that's a power of 2*/
+
+   /*
+    * Point hp at the list-header block and bp at the last
+    *  list-element block.
+    */
+   bp = (struct b_lelem *) BlkLoc(*l)->list.listtail;
+
+#ifdef EventMon		/* initialize i so it's 0 if last list-element */
+   i = 0;			/* block isn't full */
+#endif					/* EventMon */
+
+   /*
+    * If the last list-element block is full, allocate a new
+    *  list-element block, make it the last list-element block,
+    *  and make it the next block of the former last list-element
+    *  block.
+    */
+   if (bp->nused >= bp->nslots) {
+      /*
+       * Set i to the size of block to allocate.
+       */
+      i = ((struct b_list *)BlkLoc(*l))->size / two;
+      if (i < MinListSlots)
+         i = MinListSlots;
+#ifdef MaxListSlots
+      if (i > MaxListSlots)
+         i = MaxListSlots;
+#endif					/* MaxListSlots */
+
+      /*
+       * Allocate a new list element block.  If the block can't
+       *  be allocated, try smaller blocks.
+       */
+      while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
+         i /= 4;
+         if (i < MinListSlots)
+            fatalerr(0, NULL);
+         }
+
+      ((struct b_list *)BlkLoc(*l))->listtail->lelem.listnext =
+	(union block *) bp;
+      bp->listprev = ((struct b_list *)BlkLoc(*l))->listtail;
+#ifdef ListFix
+      bp->listnext = BlkLoc(*l);
+#endif					/* ListFix */
+      ((struct b_list *)BlkLoc(*l))->listtail = (union block *) bp;
+      }
+
+   /*
+    * Set i to position of new last element and assign val to
+    *  that element.
+    */
+   i = bp->first + bp->nused;
+   if (i >= bp->nslots)
+      i -= bp->nslots;
+   bp->lslots[i] = *val;
+
+   /*
+    * Adjust block usage count and current list size.
+    */
+   bp->nused++;
+   ((struct b_list *)BlkLoc(*l))->size++;
+}
+
+
+"put(L, x1, ..., xN) - put elements onto end of list L."
+
+function{1} put(x, vals[n])
+   /*
+    * x must be a list.
+    */
+   if !is:list(x) then
+      runerr(108, x)
+   abstract {
+      store[type(x).lst_elem] = type(vals)
+      return type(x)
+      }
+
+   body {
+      tended struct b_list *hp;
+      dptr dp;
+      register word i, val, num;
+      register struct b_lelem *bp;  /* does not need to be tended */
+      static int two = 2;	/* some compilers generate bad code for
+				   division by a constant that's a power of 2*/
+      if (n == 0) {
+	 dp = &nulldesc;
+	 num = 1;
+	 }
+      else {
+	 dp = vals;
+	 num = n;
+	 }
+
+      /*
+       * Point hp at the list-header block and bp at the last
+       *  list-element block.
+       */
+      for(val = 0; val < num; val++) {
+
+	 hp = (struct b_list *)BlkLoc(x);
+	 bp = (struct b_lelem *) hp->listtail;
+
+#ifdef EventMon		/* initialize i so it's 0 if last list-element */
+	 i = 0;			/* block isn't full */
+#endif					/* EventMon */
+
+	 /*
+	  * If the last list-element block is full, allocate a new
+	  *  list-element block, make it the last list-element block,
+	  *  and make it the next block of the former last list-element
+	  *  block.
+	  */
+	 if (bp->nused >= bp->nslots) {
+	    /*
+	     * Set i to the size of block to allocate.
+	     */
+	    i = hp->size / two;
+	    if (i < MinListSlots)
+	       i = MinListSlots;
+#ifdef MaxListSlots
+	    if (i > MaxListSlots)
+	       i = MaxListSlots;
+#endif					/* MaxListSlots */
+	    /*
+	     * Allocate a new list element block.  If the block can't
+	     *  be allocated, try smaller blocks.
+	     */
+	    while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
+	       i /= 4;
+	       if (i < MinListSlots)
+		  runerr(0);
+	       }
+
+	    hp->listtail->lelem.listnext = (union block *) bp;
+	    bp->listprev = hp->listtail;
+#ifdef ListFix
+	    bp->listnext = (union block *)hp;
+#endif					/* ListFix */
+	    hp->listtail = (union block *) bp;
+	    }
+
+	 /*
+	  * Set i to position of new last element and assign val to
+	  *  that element.
+	  */
+	 i = bp->first + bp->nused;
+	 if (i >= bp->nslots)
+	    i -= bp->nslots;
+	 bp->lslots[i] = dp[val];
+
+	 /*
+	  * Adjust block usage count and current list size.
+	  */
+	 bp->nused++;
+	 hp->size++;
+
+	 }
+
+      EVValD(&x, E_Lput);
+
+      /*
+       * Return the list.
+       */
+      return x;
+      }
+end
+
+
+"set(L) - create a set with members in list L."
+"  The members are linked into hash chains which are"
+" arranged in increasing order by hash number."
+
+function{1} set(l)
+
+   type_case l of {
+      null: {
+         abstract {
+            return new set(empty_type)
+            }
+         inline {
+            register union block * ps;
+            ps = hmake(T_Set, (word)0, (word)0);
+            if (ps == NULL)
+               runerr(0);
+            Desc_EVValD(ps, E_Screate, D_Set);
+            return set(ps);
+            }
+         }
+
+      list: {
+         abstract {
+            return new set(store[type(l).lst_elem])
+            }
+
+         body {
+            tended union block *pb;
+            register uword hn;
+            dptr pd;
+            struct b_selem *ne;      /* does not need to be tended */
+            int res;
+            word i, j;
+            tended union block *ps;
+            union block **pe;
+
+            /*
+             * Make a set of the appropriate size.
+             */
+            pb = BlkLoc(l);
+            ps = hmake(T_Set, (word)0, pb->list.size);
+            if (ps == NULL)
+               runerr(0);
+
+            /*
+             * Chain through each list block and for
+             *  each element contained in the block
+             *  insert the element into the set if not there.
+	     *
+	     * ne always has a new element ready for use.  We must get one
+	     *  in advance, and stay one ahead, because pe can't be tended.
+	     */
+	    Protect(ne = alcselem(&nulldesc, (uword)0), runerr(0));
+
+            for (pb = pb->list.listhead;
+#ifdef ListFix
+		 BlkType(pb) == T_Lelem;
+#else					/* ListFix */
+		 pb != NULL;
+#endif					/* ListFix */
+		 pb = pb->lelem.listnext) {
+               for (i = 0; i < pb->lelem.nused; i++) {
+                  j = pb->lelem.first + i;
+                  if (j >= pb->lelem.nslots)
+                     j -= pb->lelem.nslots;
+                  pd = &pb->lelem.lslots[j];
+                  pe = memb(ps, pd, hn = hash(pd), &res);
+                  if (res == 0) {
+		     ne->setmem = *pd;			/* add new element */
+		     ne->hashnum = hn;
+                     addmem((struct b_set *)ps, ne, pe);
+							/* get another blk */
+	             Protect(ne = alcselem(&nulldesc, (uword)0), runerr(0));
+                     }
+                  }
+               }
+	    deallocate((union block *)ne);
+            Desc_EVValD(ps, E_Screate, D_Set);
+            return set(ps);
+            }
+         }
+
+      default :
+         runerr(108, l)
+      }
+end
+
+
+"table(x) - create a table with default value x."
+
+function{1} table(x)
+   abstract {
+      return new table(empty_type, empty_type, type(x))
+      }
+   inline {
+      union block *bp;
+
+      bp = hmake(T_Table, (word)0, (word)0);
+      if (bp == NULL)
+         runerr(0);
+      bp->table.defvalue = x;
+      Desc_EVValD(bp, E_Tcreate, D_Table);
+      return table(bp);
+      }
+end
diff --git a/src/runtime/fsys.r b/src/runtime/fsys.r
new file mode 100644
index 0000000..6b70b65
--- /dev/null
+++ b/src/runtime/fsys.r
@@ -0,0 +1,1107 @@
+/*
+ * File: fsys.r
+ *  Contents: close, chdir, exit, getenv, open, read, reads, remove, rename,
+ *  seek, stop, system, where, write, writes, [getch, getche, kbhit]
+ */
+
+"close(f) - close file f."
+
+function{1} close(f)
+
+   if !is:file(f) then
+      runerr(105, f)
+
+   abstract {
+      return file ++ integer
+      }
+
+   body {
+      FILE *fp;
+      int status;
+
+      fp = BlkLoc(f)->file.fd;
+      status = BlkLoc(f)->file.status;
+      if ((status & (Fs_Read | Fs_Write)) == 0)
+	 return f;			/* if already closed */
+
+      #ifdef Graphics
+         pollctr >>= 1;
+         pollctr++;
+         if (BlkLoc(f)->file.status & Fs_Window) {
+            /*
+             * Close a window.
+             */
+   	    BlkLoc(f)->file.status = Fs_Window;	/* clears read and write */
+   	    SETCLOSED((wbp) fp);
+   	    wclose((wbp) fp);
+   	    return f;
+   	 }
+      #endif				/* Graphics */
+
+      #ifdef ReadDirectory
+         if (BlkLoc(f)->file.status & Fs_Directory) {
+	    /*
+	     * Close a directory.
+	     */
+            closedir((DIR*) fp);
+	    BlkLoc(f)->file.status = 0;
+	    return f;
+	    }
+      #endif				/* ReadDirectory */
+      
+      #ifdef Pipes
+         if (BlkLoc(f)->file.status & Fs_Pipe) {
+            /*
+             * Close a pipe.  (Returns pclose status, contrary to doc.)
+             */
+	    BlkLoc(f)->file.status = 0;
+	    return C_integer((pclose(fp) >> 8) & 0377);
+	    }
+      #endif				/* Pipes */
+
+      /*
+       * Close a simple file.
+       */
+      fclose(fp);
+      BlkLoc(f)->file.status = 0;
+      return f;
+      }
+end
+
+#undef exit
+#passthru #undef exit
+
+"exit(i) - exit process with status i, which defaults to 0."
+
+function{} exit(status)
+   if !def:C_integer(status, EXIT_SUCCESS) then
+      runerr(101, status)
+   inline {
+      c_exit((int)status);
+      }
+end
+
+
+"getenv(s) - return contents of environment variable s."
+
+function{0,1} getenv(s)
+
+   /*
+    * Make a C-style string out of s
+    */
+   if !cnv:C_string(s) then
+      runerr(103,s)
+   abstract {
+      return string
+      }
+
+   inline {
+      register char *p;
+      long l;
+
+      if ((p = getenv(s)) != NULL) {	/* get environment variable */
+	 l = strlen(p);
+	 Protect(p = alcstr(p,l),runerr(0));
+	 return string(l,p);
+	 }
+      else				/* fail if not in environment */
+	 fail;
+
+      }
+end
+
+
+#ifdef Graphics
+"open(s1, s2, ...) - open file named s1 with options s2"
+" and attributes given in trailing arguments."
+function{0,1} open(fname, spec, attr[n])
+#else					/* Graphics */
+"open(fname, spec) - open file fname with specification spec."
+function{0,1} open(fname, spec)
+#endif					/* Graphics */
+   declare {
+      tended struct descrip filename;
+      }
+
+   /*
+    * fopen and popen require a C string, but it looks terrible in
+    *  error messages, so convert it to a string here and use a local
+    *  variable (fnamestr) to store the C string.
+    */
+   if !cnv:string(fname) then
+      runerr(103, fname)
+
+   /*
+    * spec defaults to "r".
+    */
+   if !def:tmp_string(spec, letr) then
+      runerr(103, spec)
+
+   abstract {
+      return file
+      }
+
+   body {
+      tended char *fnamestr;
+      register word slen;
+      register int i;
+      register char *s;
+      int status;
+      char mode[4];
+      extern FILE *fopen();
+      FILE *f;
+      struct b_file *fl;
+
+#ifdef Graphics
+      int j, err_index = -1;
+      tended struct b_list *hp;
+      tended struct b_lelem *bp;
+#endif					/* Graphics */
+
+      /*
+       * get a C string for the file name
+       */
+      if (!cnv:C_string(fname, fnamestr))
+	 runerr(103,fname);
+
+      status = 0;
+
+      /*
+       * Scan spec, setting appropriate bits in status.  Produce a
+       *  run-time error if an unknown character is encountered.
+       */
+      s = StrLoc(spec);
+      slen = StrLen(spec);
+      for (i = 0; i < slen; i++) {
+	 switch (*s++) {
+	    case 'a':
+	    case 'A':
+	       status |= Fs_Write|Fs_Append;
+	       continue;
+	    case 'b':
+	    case 'B':
+	       status |= Fs_Read|Fs_Write;
+	       continue;
+	    case 'c':
+	    case 'C':
+	       status |= Fs_Create|Fs_Write;
+	       continue;
+	    case 'r':
+	    case 'R':
+	       status |= Fs_Read;
+	       continue;
+	    case 'w':
+	    case 'W':
+	       status |= Fs_Write;
+	       continue;
+	    case 't':
+	    case 'T':
+	       status &= ~Fs_Untrans;
+	       continue;
+	    case 'u':
+	    case 'U':
+	       status |= Fs_Untrans;
+	       continue;
+
+            #ifdef Pipes
+	    case 'p':
+	    case 'P':
+	       status |= Fs_Pipe;
+	       continue;
+            #endif			/* Pipes */
+
+	    case 'x':
+	    case 'X':
+	    case 'g':
+	    case 'G':
+#ifdef Graphics
+	       status |= Fs_Window | Fs_Read | Fs_Write;
+	       continue;
+#else					/* Graphics */
+	       fail;
+#endif					/* Graphics */
+
+	    default:
+	       runerr(209, spec);
+	    }
+	 }
+
+      /*
+       * Construct a mode field for fopen/popen.
+       */
+      mode[0] = '\0';
+      mode[1] = '\0';
+      mode[2] = '\0';
+      mode[3] = '\0';
+
+      if ((status & (Fs_Read|Fs_Write)) == 0)	/* default: read only */
+	 status |= Fs_Read;
+      if (status & Fs_Create)
+	 mode[0] = 'w';
+      else if (status & Fs_Append)
+	 mode[0] = 'a';
+      else if (status & Fs_Read)
+	 mode[0] = 'r';
+      else
+	 mode[0] = 'w';
+
+      if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
+	 mode[1] = '+';
+      if ((status & Fs_Untrans) != 0)
+         strcat(mode, "b");
+
+      /*
+       * Open the file with fopen or popen.
+       */
+
+#ifdef Graphics
+      if (status & Fs_Window) {
+	 /*
+	  * allocate an empty event queue for the window
+	  */
+	 Protect(hp = alclist(0), runerr(0));
+	 Protect(bp = alclstb(MinListSlots, (word)0, 0), runerr(0));
+	 hp->listhead = hp->listtail = (union block *) bp;
+#ifdef ListFix
+	 bp->listprev = bp->listnext = (union block *) hp;
+#endif					/* ListFix */
+
+	 /*
+	  * loop through attributes, checking validity
+	  */
+	 for (j = 0; j < n; j++) {
+	    if (is:null(attr[j]))
+	       attr[j] = emptystr;
+	    if (!is:string(attr[j]))
+	       runerr(109, attr[j]);
+	    }
+
+	 f = (FILE *)wopen(fnamestr, hp, attr, n, &err_index);
+	 if (f == NULL) {
+	    if (err_index >= 0) runerr(145, attr[err_index]);
+	    else if (err_index == -1) fail;
+	    else runerr(305);
+	    }
+	 } else
+#endif					/* Graphics */
+
+#ifdef Pipes
+      if (status & Fs_Pipe) {
+	 if (status != (Fs_Read|Fs_Pipe) && status != (Fs_Write|Fs_Pipe))
+	    runerr(209, spec);
+	 f = popen(fnamestr, mode);
+	 }
+      else
+#endif					/* Pipes */
+
+         {
+#ifdef ReadDirectory
+         struct stat sbuf;
+         if ((status & Fs_Write) == 0
+         && stat(fnamestr, &sbuf) == 0
+         && S_ISDIR(sbuf.st_mode)) {
+            status |= Fs_Directory;
+            f = (FILE*) opendir(fnamestr);
+            }
+         else
+#endif					/* ReadDirectory */
+            f = fopen(fnamestr, mode);
+         }
+
+      /*
+       * Fail if the file cannot be opened.
+       */
+      if (f == NULL) {
+	 fail;
+	 }
+
+      /*
+       * Return the resulting file value.
+       */
+      StrLen(filename) = strlen(fnamestr);
+      StrLoc(filename) = fnamestr;
+
+      Protect(fl = alcfile(f, status, &filename), runerr(0));
+#ifdef Graphics
+      /*
+       * link in the Icon file value so this window can find it
+       */
+      if (status & Fs_Window) {
+	 ((wbp)f)->window->filep.dword = D_File;
+	 BlkLoc(((wbp)f)->window->filep) = (union block *)fl;
+	 if (is:null(lastEventWin)) {
+	    lastEventWin = ((wbp)f)->window->filep;
+            lastEvFWidth = FWIDTH((wbp)f);
+            lastEvLeading = LEADING((wbp)f);
+            lastEvAscent = ASCENT((wbp)f);
+            }
+	 }
+#endif					/* Graphics */
+      return file(fl);
+      }
+end
+
+
+"read(f) - read line on file f."
+
+function{0,1} read(f)
+   /*
+    * Default f to &input.
+    */
+   if is:null(f) then
+      inline {
+	 f.dword = D_File;
+	 BlkLoc(f) = (union block *)&k_input;
+	 }
+   else if !is:file(f) then
+      runerr(105, f)
+
+   abstract {
+      return string
+      }
+
+   body {
+      register word slen, rlen;
+      register char *sp;
+      int status;
+      static char sbuf[MaxReadStr];
+      tended struct descrip s;
+      FILE *fp;
+
+      /*
+       * Get a pointer to the file and be sure that it is open for reading.
+       */
+      fp = BlkLoc(f)->file.fd;
+      status = BlkLoc(f)->file.status;
+      if ((status & Fs_Read) == 0)
+	 runerr(212, f);
+
+      if (status & Fs_Writing) {
+	 fseek(fp, 0L, SEEK_CUR);
+	 BlkLoc(f)->file.status &= ~Fs_Writing;
+	 }
+      BlkLoc(f)->file.status |= Fs_Reading;
+
+#ifdef ReadDirectory
+      if ((BlkLoc(f)->file.status & Fs_Directory) != 0) {
+         struct dirent *de = readdir((DIR*) fp);
+         if (de == NULL)
+            fail;
+         slen = strlen(de->d_name);
+         Protect(sp = alcstr(de->d_name, slen), runerr(0));
+         return string(slen, sp);
+         }
+#endif					/* ReadDirectory */
+
+      /*
+       * Use getstrg to read a line from the file, failing if getstrg
+       *  encounters end of file. [[ What about -2?]]
+       */
+      StrLen(s) = 0;
+      do {
+#ifdef Graphics
+	 pollctr >>= 1;
+	 pollctr++;
+	 if (status & Fs_Window) {
+	    slen = wgetstrg(sbuf,MaxReadStr,fp);
+	    if (slen == -1)
+	       runerr(141);
+	    if (slen == -2)
+	       runerr(143);
+	    if (slen == -3)
+               fail;
+	    }
+	 else
+#endif					/* Graphics */
+
+	 if ((slen = getstrg(sbuf, MaxReadStr, &BlkLoc(f)->file)) == -1)
+	    fail;
+
+	 /*
+	  * Allocate the string read and make s a descriptor for it.
+	  */
+	 rlen = slen < 0 ? (word)MaxReadStr : slen;
+
+	 Protect(reserve(Strings, rlen), runerr(0));
+	 if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) {
+	    Protect(reserve(Strings, StrLen(s)+rlen), runerr(0));
+	    Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0));
+	    }
+
+	 Protect(sp = alcstr(sbuf,rlen), runerr(0));
+	 if (StrLen(s) == 0)
+	    StrLoc(s) = sp;
+	 StrLen(s) += rlen;
+	 } while (slen < 0);
+      return s;
+      }
+end
+
+
+"reads(f,i) - read i characters on file f."
+
+function{0,1} reads(f,i)
+   /*
+    * Default f to &input.
+    */
+   if is:null(f) then
+      inline {
+	 f.dword = D_File;
+	 BlkLoc(f) = (union block *)&k_input;
+	 }
+   else if !is:file(f) then
+      runerr(105, f)
+
+   /*
+    * i defaults to 1 (read a single character)
+    */
+   if !def:C_integer(i,1L) then
+      runerr(101, i)
+
+   abstract {
+      return string
+      }
+
+   body {
+      long tally, nbytes;
+      int status;
+      FILE *fp;
+      tended struct descrip s;
+
+      /*
+       * Get a pointer to the file and be sure that it is open for reading.
+       */
+      fp = BlkLoc(f)->file.fd;
+      status = BlkLoc(f)->file.status;
+      if ((status & Fs_Read) == 0)
+	 runerr(212, f);
+
+      if (status & Fs_Writing) {
+	 fseek(fp, 0L, SEEK_CUR);
+	 BlkLoc(f)->file.status &= ~Fs_Writing;
+	 }
+      BlkLoc(f)->file.status |= Fs_Reading;
+
+      /*
+       * Be sure that a positive number of bytes is to be read.
+       */
+      if (i <= 0) {
+	 irunerr(205, i);
+
+	 errorfail;
+	 }
+
+#ifdef ReadDirectory
+      /*
+       *  If reading a directory, return up to i bytes of next entry.
+       */
+      if ((BlkLoc(f)->file.status & Fs_Directory) != 0) {
+         char *sp;
+         struct dirent *de = readdir((DIR*) fp);
+         if (de == NULL)
+            fail;
+         nbytes = strlen(de->d_name);
+         if (nbytes > i)
+            nbytes = i;
+         Protect(sp = alcstr(de->d_name, nbytes), runerr(0));
+         return string(nbytes, sp);
+         }
+#endif					/* ReadDirectory */
+
+      /*
+       * For now, assume we can read the full number of bytes.
+       */
+      Protect(StrLoc(s) = alcstr(NULL, i), runerr(0));
+      StrLen(s) = 0;
+
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+      if (status & Fs_Window) {
+	 tally = wlongread(StrLoc(s),sizeof(char),i,fp);
+	 if (tally == -1)
+	    runerr(141);
+	 else if (tally == -2)
+	    runerr(143);
+	 else if (tally == -3)
+            fail;
+	 }
+      else
+#endif					/* Graphics */
+      tally = longread(StrLoc(s),sizeof(char),i,fp);
+
+      if (tally == 0)
+	 fail;
+      StrLen(s) = tally;
+      /*
+       * We may not have used the entire amount of storage we reserved.
+       */
+      nbytes = DiffPtrs(StrLoc(s) + tally, strfree);
+      if (nbytes < 0)
+         EVVal(-nbytes, E_StrDeAlc);
+      else
+         EVVal(nbytes, E_String);
+      strtotal += nbytes;
+      strfree = StrLoc(s) + tally;
+      return s;
+      }
+end
+
+
+"remove(s) - remove the file named s."
+
+function{0,1} remove(s)
+
+   /*
+    * Make a C-style string out of s
+    */
+   if !cnv:C_string(s) then
+      runerr(103,s)
+   abstract {
+      return null
+      }
+
+   inline {
+      if (remove(s) != 0)
+	 fail;
+      return nulldesc;
+      }
+end
+
+
+"rename(s1,s2) - rename the file named s1 to have the name s2."
+
+function{0,1} rename(s1,s2)
+
+   /*
+    * Make C-style strings out of s1 and s2
+    */
+   if !cnv:C_string(s1) then
+      runerr(103,s1)
+   if !cnv:C_string(s2) then
+      runerr(103,s2)
+
+   abstract {
+      return null
+      }
+
+   body {
+      if (rename(s1,s2) != 0)
+	 fail;
+      return nulldesc;
+      }
+end
+
+
+"seek(f,i) - seek to offset i in file f."
+" [[ What about seek error ? ]] "
+
+function{0,1} seek(f,o)
+
+   /*
+    * f must be a file
+    */
+   if !is:file(f) then
+      runerr(105,f)
+
+   /*
+    * o must be an integer and defaults to 1.
+    */
+   if !def:C_integer(o,1L) then
+      runerr(0)
+
+   abstract {
+      return file
+      }
+
+   body {
+      FILE *fd;
+
+      fd = BlkLoc(f)->file.fd;
+      if (BlkLoc(f)->file.status == 0)
+	 fail;
+#ifdef ReadDirectory
+      if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
+         fail;
+#endif					/* ReadDirectory */
+
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+      if (BlkLoc(f)->file.status & Fs_Window)
+	 fail;
+#endif					/* Graphics */
+
+      if (o > 0) {
+	 if (fseek(fd, o - 1, SEEK_SET) != 0)
+	    fail;
+	 }
+      else {
+	 if (fseek(fd, o, SEEK_END) != 0)
+	    fail;
+	 }
+      BlkLoc(f)->file.status &= ~(Fs_Reading | Fs_Writing);
+      return f;
+      }
+end
+
+
+"system(s) - execute string s as a system command."
+
+function{1} system(s)
+   /*
+    * Make a C-style string out of s
+    */
+   if !cnv:C_string(s) then
+      runerr(103,s)
+
+   abstract {
+      return integer
+      }
+
+   inline {
+      /*
+       * Pass the C string to the system() function and return
+       * the exit code of the command as the result of system().
+       * Note, the expression on a "return" may not have side effects,
+       * so the exit code must be returned via a variable.
+       */
+      C_integer i;
+
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+#endif					/* Graphics */
+
+      i = (C_integer)system(s);
+      return C_integer i;
+      }
+end
+
+
+
+"where(f) - return current offset position in file f."
+
+function{0,1} where(f)
+
+   if !is:file(f) then
+      runerr(105,f)
+
+   abstract {
+      return integer
+      }
+
+   body {
+      FILE *fd;
+      long ftell();
+      long pos;
+
+      fd = BlkLoc(f)->file.fd;
+
+      if ((BlkLoc(f)->file.status == 0))
+	 fail;
+#ifdef ReadDirectory
+      if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
+         fail;
+#endif					/* ReadDirectory */
+
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+      if (BlkLoc(f)->file.status & Fs_Window)
+	 fail;
+#endif					/* Graphics */
+
+      pos = ftell(fd) + 1;
+      if (pos == 0)
+	 fail;	/* may only be effective on ANSI systems */
+
+      return C_integer pos;
+      }
+end
+
+/*
+ * stop(), write(), and writes() differ in whether they stop the program
+ *  and whether they output newlines. The macro GenWrite is used to
+ *  produce all three functions.
+ */
+#define False 0
+#define True 1
+
+#begdef DefaultFile(error_out)
+   inline {
+#if error_out
+      if ((k_errout.status & Fs_Write) == 0)
+	 runerr(213);
+      else {
+	 f = k_errout.fd;
+	 }
+#else					/* error_out */
+      if ((k_output.status & Fs_Write) == 0)
+	 runerr(213);
+      else {
+	 f = k_output.fd;
+	 }
+#endif					/* error_out */
+      }
+#enddef					/* DefaultFile */
+
+#begdef Finish(retvalue, nl, terminate)
+#if nl
+   /*
+    * Append a newline to the file.
+    */
+#ifdef Graphics
+   pollctr >>= 1;
+   pollctr++;
+   if (status & Fs_Window)
+      wputc('\n',(wbp)f);
+   else
+#endif					/* Graphics */
+      putc('\n', f);
+#endif					/* nl */
+
+   /*
+    * Flush the file.
+    */
+#ifdef Graphics
+   if (!(status & Fs_Window)) {
+#endif					/* Graphics */
+      if (ferror(f))
+	 runerr(214);
+      fflush(f);
+
+#ifdef Graphics
+      }
+#endif					/* Graphics */
+
+
+#if terminate
+	    c_exit(EXIT_FAILURE);
+#else					/* terminate */
+	    return retvalue;
+#endif					/* terminate */
+#enddef					/* Finish */
+
+#begdef GenWrite(name, nl, terminate)
+
+#name "(a,b,...) - write arguments"
+#if !nl
+   " without newline terminator"
+#endif					/* nl */
+#if terminate
+   " (starting on error output) and stop"
+#endif					/* terminate */
+"."
+
+#if terminate
+function {} name(x[nargs])
+#else					/* terminate */
+function {1} name(x[nargs])
+#endif					/* terminate */
+
+   declare {
+      FILE *f = NULL;
+      word status = k_errout.status;
+      }
+
+#if terminate
+   abstract {
+      return empty_type
+      }
+#endif					/* terminate */
+
+   len_case nargs of {
+      0: {
+#if !terminate
+	 abstract {
+	    return null
+	    }
+#endif					/* terminate */
+	 DefaultFile(terminate)
+	 body {
+	    Finish(nulldesc, nl, terminate)
+	    }
+	 }
+
+      default: {
+#if !terminate
+	 abstract {
+	    return type(x)
+	    }
+#endif					/* terminate */
+	 /*
+	  * See if we need to start with the default file.
+	  */
+	 if !is:file(x[0]) then
+	    DefaultFile(terminate)
+
+	 body {
+	    tended struct descrip t;
+	    register word n;
+
+	    /*
+	     * Loop through the arguments.
+	     */
+	    for (n = 0; n < nargs; n++) {
+	       if (is:file(x[n])) {	/* Current argument is a file */
+#if nl
+		  /*
+		   * If this is not the first argument, output a newline to the
+		   * current file and flush it.
+		   */
+		  if (n > 0) {
+
+		     /*
+		      * Append a newline to the file and flush it.
+		      */
+#ifdef Graphics
+		     pollctr >>= 1;
+		     pollctr++;
+		     if (status & Fs_Window) {
+			wputc('\n',(wbp)f);
+			wflush((wbp)f);
+			  }
+		     else {
+#endif					/* Graphics */
+			putc('\n', f);
+			if (ferror(f))
+			   runerr(214);
+			fflush(f);
+#ifdef Graphics
+			}
+#endif					/* Graphics */
+		     }
+#endif					/* nl */
+
+		  /*
+		   * Switch the current file to the file named by the current
+		   * argument providing it is a file.
+		   */
+		  status = BlkLoc(x[n])->file.status;
+		  if ((status & Fs_Write) == 0)
+		     runerr(213, x[n]);
+		  f = BlkLoc(x[n])->file.fd;
+		  }
+	       else {
+		  /*
+		   * Convert the argument to a string, defaulting to a empty
+		   *  string.
+		   */
+		  if (!def:tmp_string(x[n],emptystr,t))
+		     runerr(109, x[n]);
+
+		  /*
+		   * Output the string.
+		   */
+#ifdef Graphics
+		  if (status & Fs_Window)
+		     wputstr((wbp)f, StrLoc(t), StrLen(t));
+		  else
+#endif					/* Graphics */
+		  if (putstr(f, &t) == Failed) {
+		     runerr(214, x[n]);
+		     }
+		  }
+	       }
+
+	    Finish(x[n-1], nl, terminate)
+	    }
+	 }
+      }
+end
+#enddef					/* GenWrite */
+
+GenWrite(stop,	 True,	True)  /* stop(s, ...) - write message and stop */
+GenWrite(write,  True,	False) /* write(s, ...) - write with new-line */
+GenWrite(writes, False, False) /* writes(s, ...) - write with no new-line */
+
+#ifdef KeyboardFncs
+
+"getch() - return a character from console."
+
+function{0,1} getch()
+   abstract {
+      return string;
+      }
+   body {
+      int i;
+      i = getch();
+      if (i<0 || i>255)
+	 fail;
+      return string(1, (char *)&allchars[i & 0xFF]);
+      }
+end
+
+"getche() -- return a character from console with echo."
+
+function{0,1} getche()
+   abstract {
+      return string;
+      }
+   body {
+      int i;
+      i = getche();
+      if (i<0 || i>255)
+	 fail;
+      return string(1, (char *)&allchars[i & 0xFF]);
+      }
+end
+
+
+"kbhit() -- Check to see if there is a keyboard character waiting to be read."
+
+function{0,1} kbhit()
+   abstract {
+      return null
+      }
+   inline {
+      if (kbhit())
+	 return nulldesc;
+      else
+         fail;
+      }
+end
+#endif					/* KeyboardFncs */
+
+"chdir(s) - change working directory to s."
+function{0,1} chdir(s)
+
+   if !cnv:C_string(s) then
+      runerr(103,s)
+   abstract {
+      return null
+      }
+   inline {
+      if (chdir(s) != 0)
+         fail;
+      return nulldesc;
+   }
+end
+
+"delay(i) - delay for i milliseconds."
+
+function{1} delay(n)
+
+   if !cnv:C_integer(n) then
+      runerr(101,n)
+   abstract {
+      return null
+      }
+
+   inline {
+      if (idelay(n) == Failed)
+        fail;
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+#endif					/* Graphics */
+      return nulldesc;
+      }
+end
+
+"flush(f) - flush file f."
+
+function{1} flush(f)
+   if !is:file(f) then
+      runerr(105, f)
+   abstract {
+      return type(f)
+      }
+
+   body {
+      FILE *fp;
+      int status;
+
+      fp = BlkLoc(f)->file.fd;
+      status = BlkLoc(f)->file.status;
+      if ((status & (Fs_Read | Fs_Write)) == 0)
+	 return f;			/* if already closed */
+
+#ifdef ReadDirectory
+      if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
+         return f;
+#endif					/* ReadDirectory */
+
+#ifdef Graphics
+      pollctr >>= 1;
+      pollctr++;
+      if (!(BlkLoc(f)->file.status & Fs_Window))
+	 fflush(fp);
+#else					/* Graphics */
+      fflush(fp);
+#endif					/* Graphics */
+
+      /*
+       * Return the flushed file.
+       */
+      return f;
+      }
+end
+
+#ifdef FAttrib
+
+"fattrib(str, att) - get the attribute of a file "
+
+function{*} fattrib (fname, att[argc])
+
+   if !cnv:C_string(fname) then
+        runerr(103, fname)
+
+   abstract {
+      return string ++ integer
+      }
+
+   body {
+      tended char *s;
+      struct stat fs;
+      int fd, i;
+      char *retval;
+      char *temp;
+      long l;
+
+         if ( stat(fname, &fs) == -1 )
+            fail;
+	 for(i=0; i<argc; i++) {
+	    if (!cnv:C_string(att[i], s)) {
+	       runerr(103, att[i]);
+	       }
+         if ( !strcasecmp("size", s) ) {
+            suspend C_integer(fs.st_size);
+            }
+         else if ( !strcasecmp("status", s) ) {
+            temp = make_mode (fs.st_mode);
+	    l = strlen(temp);
+            Protect(retval = alcstr(temp,l), runerr(0));
+	    free(temp);
+            suspend string(l, retval);
+            }
+         else if ( !strcasecmp("m_time", s) ) {
+	    temp = ctime(&(fs.st_mtime));
+	    l = strlen(temp);
+	    if (temp[l-1] == '\n') l--;
+	    Protect(temp = alcstr(temp, l), runerr(0));
+            suspend string(l, temp);
+            }
+         else if ( !strcasecmp("a_time", s) ) {
+	    temp = ctime(&(fs.st_atime));
+	    l = strlen(temp);
+	    if (temp[l-1] == '\n') l--;
+	    Protect(temp = alcstr(temp, l), runerr(0));
+            suspend string(l, temp);
+            }
+         else if ( !strcasecmp("c_time", s) ) {
+	    temp = ctime(&(fs.st_ctime));
+	    l = strlen(temp);
+	    if (temp[l-1] == '\n') l--;
+	    Protect(temp = alcstr(temp, l), runerr(0));
+            suspend string(l, temp);
+            }
+         else {
+            runerr(205, att[i]);
+            }
+      }
+      fail;
+   }
+end
+#endif					/* FAttrib */
diff --git a/src/runtime/fwindow.r b/src/runtime/fwindow.r
new file mode 100644
index 0000000..010286f
--- /dev/null
+++ b/src/runtime/fwindow.r
@@ -0,0 +1,2720 @@
+/*
+ * File: fwindow.r - Icon graphics interface
+ *
+ * Contents: Active, Bg, Color, CopyArea, Couple,
+ *  DrawArc, DrawCircle, DrawCurve, DrawImage, DrawLine,
+ *  DrawSegment, DrawPoint, DrawPolygon, DrawString,
+ *  DrawRectangle, EraseArea, Event, Fg, FillArc, FillCircle,
+ *  FillRectangle, FillPolygon, Font, FreeColor, GotoRC, GotoXY,
+ *  NewColor, Pattern, PaletteChars, PaletteColor, PaletteKey,
+ *  Pending, QueryPointer, ReadImage, TextWidth, Uncouple,
+ *  WAttrib, WDefault, WFlush, WSync, WriteImage
+ */
+
+#ifdef Graphics
+
+/*
+ * Global variables.
+ *  A poll counter for use in interp.c,
+ *  the binding for the console window - FILE * for simplicity,
+ *  &col, &row, &x, &y, &interval, timestamp, and modifier keys.
+ */
+int pollctr;
+FILE *ConsoleBinding = NULL;
+/*
+ * the global buffer used as work space for printing string, etc
+ */
+char ConsoleStringBuf[MaxReadStr * 48];
+char *ConsoleStringBufPtr = ConsoleStringBuf;
+unsigned long ConsoleFlags = 0;			 /* Console flags */
+
+
+
+"Active() - produce the next active window"
+
+function{0,1} Active()
+   abstract {
+      return file
+      }
+   body {
+      wsp ws;
+      if (!wstates || !(ws = getactivewindow())) fail;
+      return ws->filep;
+      }
+end
+
+
+"Alert(w,volume) - Alert the user"
+
+function{1} Alert(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      C_integer volume;
+      OptWindow(w);
+
+      if (argc == warg) volume = 0;
+      else if (!def:C_integer(argv[warg], 0, volume))
+        runerr(101, argv[warg]);
+      walert(w, volume);
+      ReturnWindow;
+      }
+end
+
+"Bg(w,s) - background color"
+
+function{0,1} Bg(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      char sbuf1[MaxCvtLen];
+      int len;
+      tended char *tmp;
+      int warg = 0;
+      OptWindow(w);
+
+      /*
+       * If there is a (non-window) argument we are setting by
+       * either a mutable color (negative int) or a string name.
+       */
+      if (argc - warg > 0) {
+	 if (is:integer(argv[warg])) {    /* mutable color or packed RGB */
+	    if (isetbg(w, IntVal(argv[warg])) == Failed) fail;
+	    }
+	 else {
+	    if (!cnv:C_string(argv[warg], tmp))
+	       runerr(103,argv[warg]);
+	    if(setbg(w, tmp) == Failed) fail;
+	    }
+         }
+
+      /*
+       * In any event, this function returns the current background color.
+       */
+      getbg(w, sbuf1);
+      len = strlen(sbuf1);
+      Protect(tmp = alcstr(sbuf1, len), runerr(0));
+      return string(len, tmp);
+      }
+end
+
+
+"Clip(w, x, y, w, h) - set context clip rectangle"
+
+function{1} Clip(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0, r;
+      C_integer x, y, width, height;
+      wcp wc;
+      OptWindow(w);
+
+      wc = w->context;
+
+      if (argc <= warg) {
+         wc->clipx = wc->clipy = 0;
+         wc->clipw = wc->cliph = -1;
+         unsetclip(w);
+         }
+      else {
+         r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+         wc->clipx = x;
+         wc->clipy = y;
+         wc->clipw = width;
+         wc->cliph = height;
+         setclip(w);
+         }
+
+      ReturnWindow;
+      }
+end
+
+
+"Clone(w, attribs...) - create a new context bound to w's canvas"
+
+function{1} Clone(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w, w2;
+      int warg = 0, n;
+      tended struct descrip sbuf, sbuf2;
+      char answer[128];
+      OptWindow(w);
+
+      Protect(w2 = alc_wbinding(), runerr(0));
+      w2->window = w->window;
+      w2->window->refcount++;
+
+      if (argc>warg && is:file(argv[warg])) {
+	 if ((BlkLoc(argv[warg])->file.status & Fs_Window) == 0)
+	    runerr(140,argv[warg]);
+	 if ((BlkLoc(argv[warg])->file.status & (Fs_Read|Fs_Write)) == 0)
+	    runerr(142,argv[warg]);
+	 if (ISCLOSED((wbp)BlkLoc(argv[warg])->file.fd))
+	    runerr(142,argv[warg]);
+	 Protect(w2->context =
+		 clone_context((wbp)BlkLoc(argv[warg])->file.fd), runerr(0));
+	 warg++;
+	 }
+      else {
+	 Protect(w2->context = clone_context(w), runerr(0));
+	 }
+
+      for (n = warg; n < argc; n++) {
+	 if (!is:null(argv[n])) {
+	    if (!cnv:tmp_string(argv[n], sbuf))
+	       runerr(109, argv[n]);
+	    switch (wattrib(w2, StrLoc(argv[n]), StrLen(argv[n]), &sbuf2, answer)) {
+	    case Failed: fail;
+	    case Error: runerr(0, argv[n]);
+	       }
+	    }
+	 }
+
+      Protect(BlkLoc(result) =
+	       (union block *)alcfile((FILE *)w2, Fs_Window|Fs_Read|Fs_Write,
+				      &emptystr),runerr(0));
+      result.dword = D_File;
+      return result;
+      }
+end
+
+
+
+"Color(argv[]) - return or set color map entries"
+
+function{0,1} Color(argv[argc])
+   abstract {
+      return file ++ string
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      int i, len;
+      C_integer n;
+      char *colorname, *srcname;
+      tended char *tmp;
+
+      OptWindow(w);
+      if (argc - warg == 0) runerr(101);
+
+      if (argc - warg == 1) {			/* if this is a query */
+         CnvCInteger(argv[warg], n)
+         if ((colorname = get_mutable_name(w, n)) == NULL)
+            fail;
+         len = strlen(colorname);
+         Protect(tmp = alcstr(colorname, len), runerr(0));
+         return string(len, tmp);
+         }
+
+      CheckArgMultiple(2);
+
+      for (i = warg; i < argc; i += 2) {
+         CnvCInteger(argv[i], n)
+         if ((colorname = get_mutable_name(w, n)) == NULL)
+            fail;
+
+         if (is:integer(argv[i+1])) {		/* copy another mutable  */
+            if (IntVal(argv[i+1]) >= 0)
+               runerr(205, argv[i+1]);		/* must be negative */
+            if ((srcname = get_mutable_name(w, IntVal(argv[i+1]))) == NULL)
+               fail;
+            if (set_mutable(w, n, srcname) == Failed) fail;
+            strcpy(colorname, srcname);
+            }
+
+         else {					/* specified by name */
+            tended char *tmp;
+            if (!cnv:C_string(argv[i+1],tmp))
+               runerr(103,argv[i+1]);
+
+            if (set_mutable(w, n, tmp) == Failed) fail;
+            strcpy(colorname, tmp);
+            }
+         }
+
+      ReturnWindow;
+      }
+end
+
+
+"ColorValue(w,s) - produce RGB components from string color name"
+
+function{0,1} ColorValue(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      C_integer n;
+      int warg = 0, len;
+      long r, g, b;
+      tended char *s;
+      char tmp[24], *t;
+
+      if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window)) {
+         w = (wbp)BlkLoc(argv[0])->file.fd;		/* explicit window */
+         warg = 1;
+         }
+      else if (is:file(kywd_xwin[XKey_Window]) &&
+            (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window))
+         w = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;	/* &window */
+      else
+         w = NULL;			/* no window (but proceed anyway) */
+
+      if (!(warg < argc))
+         runerr(103);
+
+      if (cnv:C_integer(argv[warg], n)) {
+         if (w != NULL && (t = get_mutable_name(w, n)))
+            Protect(s = alcstr(t, (word)strlen(t)+1), runerr(306));
+         else
+            fail;
+         }
+      else if (!cnv:C_string(argv[warg], s))
+         runerr(103,argv[warg]);
+
+      if (parsecolor(w, s, &r, &g, &b) == Succeeded) {
+         sprintf(tmp,"%ld,%ld,%ld", r, g, b);
+	 len = strlen(tmp);
+	 Protect(s = alcstr(tmp,len), runerr(306));
+	 return string(len, s);
+         }
+      fail;
+      }
+end
+
+
+"CopyArea(w,w2,x,y,width,height,x2,y2) - copy area"
+
+function{0,1} CopyArea(argv[argc]) /* w,w2,x,y,width,height,x2,y2 */
+   abstract {
+      return file
+      }
+   body {
+      int warg = 0, n, r;
+      C_integer x, y, width, height, x2, y2, width2, height2;
+      wbp w, w2;
+      OptWindow(w);
+
+      /*
+       * 2nd window defaults to value of first window
+       */
+      if (argc>warg && is:file(argv[warg])) {
+	 if ((BlkLoc(argv[warg])->file.status & Fs_Window) == 0)
+	    runerr(140,argv[warg]);
+	 if ((BlkLoc(argv[warg])->file.status & (Fs_Read|Fs_Write)) == 0)
+	    runerr(142,argv[warg]);
+	 w2 = (wbp)BlkLoc(argv[warg])->file.fd;
+	 if (ISCLOSED(w2))
+	    runerr(142,argv[warg]);
+	 warg++;
+	 }
+      else {
+	 w2 = w;
+	 }
+
+      /*
+       * x1, y1, width, and height follow standard conventions.
+       */
+      r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
+      if (r >= 0)
+         runerr(101, argv[r]);
+
+      /*
+       * get x2 and y2, ignoring width and height.
+       */
+      n = argc;
+      if (n > warg + 6)
+         n = warg + 6;
+      r = rectargs(w2, n, argv, warg + 4, &x2, &y2, &width2, &height2);
+      if (r >= 0)
+         runerr(101, argv[r]);
+
+      if (copyArea(w, w2, x, y, width, height, x2, y2) == Failed)
+         fail;
+      ReturnWindow;
+      }
+end
+
+/*
+ * Bind the canvas associated with w to the context
+ *  associated with w2.  If w2 is omitted, create a new context.
+ *  Produces a new window variable.
+ */
+"Couple(w,w2) - couple canvas to context"
+
+function{0,1} Couple(w,w2)
+   abstract {
+      return file
+      }
+   body {
+      tended struct descrip sbuf, sbuf2;
+      wbp wb, wb_new;
+      wsp ws;
+
+      /*
+       * make the new binding
+       */
+      Protect(wb_new = alc_wbinding(), runerr(0));
+
+      /*
+       * if w is a file, then we bind to an existing window
+       */
+      if (is:file(w) && (BlkLoc(w)->file.status & Fs_Window)) {
+	 wb = (wbp)(BlkLoc(w)->file.fd);
+	 wb_new->window = ws = wb->window;
+	 if (is:file(w2) && (BlkLoc(w2)->file.status & Fs_Window)) {
+	    /*
+	     * Bind an existing window to an existing context,
+	     * and up the context's reference count.
+	     */
+	    if (rebind(wb_new, (wbp)(BlkLoc(w2)->file.fd)) == Failed) fail;
+	    wb_new->context->refcount++;
+	    }
+	 else
+	    runerr(140, w2);
+
+	 /* bump up refcount to ws */
+	 ws->refcount++;
+	 }
+      else
+	 runerr(140, w);
+
+      Protect(BlkLoc(result) =
+	 (union block *)alcfile((FILE *)wb_new,	Fs_Window|Fs_Read|Fs_Write,
+				&emptystr),runerr(0));
+      result.dword = D_File;
+      return result;
+      }
+end
+
+/*
+ * DrawArc(w, x1, y1, width1, height1, angle11, angle21,...)
+ */
+"DrawArc(argv[]){1} - draw arc"
+
+function{1} DrawArc(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, r, warg = 0;
+      XArc arcs[MAXXOBJS];
+      C_integer x, y, width, height;
+      double a1, a2;
+
+      OptWindow(w);
+      j = 0;
+      for (i = warg; i < argc || i == warg; i += 6) {
+         if (j == MAXXOBJS) {
+            drawarcs(w, arcs, MAXXOBJS);
+            j = 0;
+            }
+         r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+
+         arcs[j].x = x;
+         arcs[j].y = y;
+         ARCWIDTH(arcs[j]) = width;
+         ARCHEIGHT(arcs[j]) = height;
+
+	 /*
+	  * Angle 1 processing.  Computes in radians and 64'ths of a degree,
+	  *  bounds checks, and handles wraparound.
+	  */
+         if (i + 4 >= argc || is:null(argv[i + 4]))
+	    a1 = 0.0;
+         else {
+            if (!cnv:C_double(argv[i + 4], a1))
+               runerr(102, argv[i + 4]);
+            if (a1 >= 0.0)
+               a1 = fmod(a1, 2 * Pi);
+            else
+               a1 = -fmod(-a1, 2 * Pi);
+            }
+	 /*
+	  * Angle 2 processing
+	  */
+         if (i + 5 >= argc || is:null(argv[i + 5]))
+	    a2 = 2 * Pi;
+         else {
+            if (!cnv:C_double(argv[i + 5], a2))
+               runerr(102, argv[i + 5]);
+            if (fabs(a2) > 3 * Pi)
+               runerr(101, argv[i + 5]);
+            }
+         if (fabs(a2) >= 2 * Pi) {
+	    a2 = 2 * Pi;
+	    }
+         else {
+            if (a2 < 0.0) {
+               a1 += a2;
+               a2 = fabs(a2);
+               }
+            }
+         if (a1 < 0.0)
+            a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
+         else
+            a1 = fmod(a1, 2 * Pi);
+         arcs[j].angle1 = ANGLE(a1);
+         arcs[j].angle2 = EXTENT(a2);
+
+         j++;
+         }
+
+      drawarcs(w, arcs, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawCircle(w, x1, y1, r1, angle11, angle21, ...)
+ */
+"DrawCircle(argv[]){1} - draw circle"
+
+function{1} DrawCircle(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0, r;
+
+      OptWindow(w);
+      r = docircles(w, argc - warg, argv + warg, 0);
+      if (r < 0)
+         ReturnWindow;
+      else if (r >= argc - warg)
+         runerr(146);
+      else
+         runerr(102, argv[warg + r]);
+      }
+end
+
+/*
+ * DrawCurve(w,x1,y1,...xN,yN)
+ *  Draw a smooth curve through the given points.
+ */
+"DrawCurve(argv[]){1} - draw curve"
+
+function{1} DrawCurve(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, n, closed = 0, warg = 0;
+      C_integer dx, dy, x0, y0, xN, yN;
+      XPoint *points;
+
+      OptWindow(w);
+      CheckArgMultiple(2);
+
+      dx = w->context->dx;
+      dy = w->context->dy;
+
+      Protect(points = (XPoint *)malloc(sizeof(XPoint) * (n+2)), runerr(305));
+
+      if (n > 1) {
+	 CnvCInteger(argv[warg], x0)
+	 CnvCInteger(argv[warg + 1], y0)
+	 CnvCInteger(argv[argc - 2], xN)
+	 CnvCInteger(argv[argc - 1], yN)
+         if ((x0 == xN) && (y0 == yN)) {
+            closed = 1;               /* duplicate the next to last point */
+	    CnvCShort(argv[argc-4], points[0].x);
+	    CnvCShort(argv[argc-3], points[0].y);
+	    points[0].x += w->context->dx;
+	    points[0].y += w->context->dy;
+            }
+         else {                       /* duplicate the first point */
+	    CnvCShort(argv[warg], points[0].x);
+	    CnvCShort(argv[warg + 1], points[0].y);
+	    points[0].x += w->context->dx;
+	    points[0].y += w->context->dy;
+            }
+         for (i = 1; i <= n; i++) {
+	    int base = warg + (i-1) * 2;
+            CnvCShort(argv[base], points[i].x);
+            CnvCShort(argv[base + 1], points[i].y);
+	    points[i].x += dx;
+	    points[i].y += dy;
+            }
+         if (closed) {                /* duplicate the second point */
+            points[i] = points[2];
+            }
+         else {                       /* duplicate the last point */
+            points[i] = points[i-1];
+            }
+	 if (n < 3) {
+	    drawlines(w, points+1, n);
+	    }
+	 else {
+	    drawCurve(w, points, n+2);
+	    }
+         }
+      free(points);
+      ReturnWindow;
+      }
+end
+
+
+"DrawImage(w,x,y,s) - draw bitmapped figure"
+
+function{0,1} DrawImage(argv[argc])
+   abstract {
+      return null++integer
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      int c, i, width, height, row, p;
+      C_integer x, y;
+      word nchars;
+      unsigned char *s, *t, *z;
+      struct descrip d;
+      struct palentry *e;
+      OptWindow(w);
+
+      /*
+       * X or y can be defaulted but s is required.
+       * Validate x/y first so that the error message makes more sense.
+       */
+      if (argc - warg >= 1 && !def:C_integer(argv[warg], -w->context->dx, x))
+         runerr(101, argv[warg]);
+      if (argc - warg >= 2 && !def:C_integer(argv[warg + 1], -w->context->dy, y))
+         runerr(101, argv[warg + 1]);
+      if (argc - warg < 3)
+         runerr(103);			/* missing s */
+      if (!cnv:tmp_string(argv[warg+2], d))
+         runerr(103, argv[warg + 2]);
+
+      x += w->context->dx;
+      y += w->context->dy;
+      /*
+       * Extract the Width and skip the following comma.
+       */
+      s = (unsigned char *)StrLoc(d);
+      z = s + StrLen(d);		/* end+1 of string */
+      width = 0;
+      while (s < z && *s == ' ')	/* skip blanks */
+	 s++;
+      while (s < z && isdigit(*s))	/* scan number */
+         width = 10 * width + *s++ - '0';
+      while (s < z && *s == ' ')	/* skip blanks */
+	 s++;
+      if (width == 0 || *s++ != ',')	/* skip comma */
+         fail;
+      while (s < z && *s == ' ')	/* skip blanks */
+	 s++;
+      if (s >= z)			/* if end of string */
+	 fail;
+
+      /*
+       * Check for a bilevel format.
+       */
+      if ((c = *s) == '#' || c == '~') {
+         s++;
+         nchars = 0;
+         for (t = s; t < z; t++)
+            if (isxdigit(*t))
+               nchars++;			/* count hex digits */
+            else if (*t != PCH1 && *t != PCH2)
+               fail;				/* illegal punctuation */
+         if (nchars == 0)
+            fail;
+         row = (width + 3) / 4;			/* digits per row */
+         if (nchars % row != 0)
+            fail;
+         height = nchars / row;
+         if (blimage(w, x, y, width, height, c, s, (word)(z - s)) == Error)
+            runerr(305);
+         else
+            return nulldesc;
+         }
+
+      /*
+       * Extract the palette name and skip its comma.
+       */
+      c = *s++;					/* save initial character */
+      p = 0;
+      while (s < z && isdigit(*s))		/* scan digits */
+         p = 10 * p + *s++ - '0';
+      while (s < z && *s == ' ')		/* skip blanks */
+	 s++;
+      if (s >= z || p == 0 || *s++ != ',')	/* skip comma */
+         fail;
+      if (c == 'g' && p >= 2 && p <= 256)	/* validate grayscale number */
+         p = -p;
+      else if (c != 'c' || p < 1 || p > 6)	/* validate color number */
+         fail;
+
+      /*
+       * Scan the image to see which colors are needed.
+       */
+      e = palsetup(p);
+      if (e == NULL)
+         runerr(305);
+      for (i = 0; i < 256; i++)
+         e[i].used = 0;
+      nchars = 0;
+      for (t = s; t < z; t++) {
+         c = *t;
+         e[c].used = 1;
+         if (e[c].valid || e[c].transpt)
+            nchars++;			/* valid color, or transparent */
+         else if (c != PCH1 && c != PCH2)
+            fail;
+         }
+      if (nchars == 0)
+         fail;					/* empty image */
+      if (nchars % width != 0)
+         fail;					/* not rectangular */
+
+      /*
+       * Call platform-dependent code to draw the image.
+       */
+      height = nchars / width;
+      i = strimage(w, x, y, width, height, e, s, (word)(z - s), 0);
+      if (i == 0)
+         return nulldesc;
+      else if (i < 0)
+         runerr(305);
+      else
+         return C_integer i;
+      }
+end
+
+/*
+ * DrawLine(w,x1,y1,...xN,yN)
+ */
+"DrawLine(argv[]){1} - draw line"
+
+function{1} DrawLine(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, n, warg = 0;
+      XPoint points[MAXXOBJS];
+      int dx, dy;
+
+      OptWindow(w);
+      CheckArgMultiple(2);
+
+      dx = w->context->dx;
+      dy = w->context->dy;
+      for(i=0, j=0;i<n;i++, j++) {
+	 int base = warg + i * 2;
+         if (j==MAXXOBJS) {
+	    drawlines(w, points, MAXXOBJS);
+	    points[0] = points[MAXXOBJS-1];
+	    j = 1;
+            }
+         CnvCShort(argv[base], points[j].x);
+         CnvCShort(argv[base + 1], points[j].y);
+	 points[j].x += dx;
+	 points[j].y += dy;
+         }
+      drawlines(w, points, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawPoint(w, x1, y1, ...xN, yN)
+ */
+"DrawPoint(argv[]){1} - draw point"
+
+function{1} DrawPoint(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, n, warg = 0;
+      XPoint points[MAXXOBJS];
+      int dx, dy;
+
+      OptWindow(w);
+      CheckArgMultiple(2);
+
+      dx = w->context->dx;
+      dy = w->context->dy;
+      for(i=0, j=0; i < n; i++, j++) {
+	 int base = warg + i * 2;
+         if (j == MAXXOBJS) {
+	    drawpoints(w, points, MAXXOBJS);
+            j = 0;
+            }
+         CnvCShort(argv[base], points[j].x);
+         CnvCShort(argv[base + 1], points[j].y);
+	 points[j].x += dx;
+	 points[j].y += dy;
+       }
+      drawpoints(w, points, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawPolygon(w,x1,y1,...xN,yN)
+ */
+"DrawPolygon(argv[]){1} - draw polygon"
+
+function{1} DrawPolygon(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, n, base, dx, dy, warg = 0;
+      XPoint points[MAXXOBJS];
+
+      OptWindow(w);
+      CheckArgMultiple(2);
+
+      dx = w->context->dx;
+      dy = w->context->dy;
+
+      /*
+       * To make a closed polygon, start with the *last* point.
+       */
+      CnvCShort(argv[argc - 2], points[0].x);
+      CnvCShort(argv[argc - 1], points[0].y);
+      points[0].x += dx;
+      points[0].y += dy;
+
+      /*
+       * Now add all points from beginning to end, including last point again.
+       */
+      for(i = 0, j = 1; i < n; i++, j++) {
+         base = warg + i * 2;
+         if (j == MAXXOBJS) {
+            drawlines(w, points, MAXXOBJS);
+            points[0] = points[MAXXOBJS-1];
+            j = 1;
+            }
+         CnvCShort(argv[base], points[j].x);
+         CnvCShort(argv[base + 1], points[j].y);
+         points[j].x += dx;
+         points[j].y += dy;
+         }
+      drawlines(w, points, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawRectangle(w, x1, y1, width1, height1, ..., xN, yN, widthN,heightN)
+ */
+"DrawRectangle(argv[]){1} - draw rectangle"
+
+function{1} DrawRectangle(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, r, warg = 0;
+      XRectangle recs[MAXXOBJS];
+      C_integer x, y, width, height;
+
+      OptWindow(w);
+      j = 0;
+
+      for (i = warg; i < argc || i == warg; i += 4) {
+         r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+         if (j == MAXXOBJS) {
+            drawrectangles(w,recs,MAXXOBJS);
+            j = 0;
+            }
+         RECX(recs[j]) = x;
+         RECY(recs[j]) = y;
+         RECWIDTH(recs[j]) = width;
+         RECHEIGHT(recs[j]) = height;
+         j++;
+         }
+
+      drawrectangles(w, recs, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawSegment(x11,y11,x12,y12,...,xN1,yN1,xN2,yN2)
+ */
+"DrawSegment(argv[]){1} - draw line segment"
+
+function{1} DrawSegment(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, n, warg = 0, dx, dy;
+      XSegment segs[MAXXOBJS];
+
+      OptWindow(w);
+      CheckArgMultiple(4);
+
+      dx = w->context->dx;
+      dy = w->context->dy;
+      for(i=0, j=0; i < n; i++, j++) {
+	 int base = warg + i * 4;
+         if (j == MAXXOBJS) {
+	    drawsegments(w, segs, MAXXOBJS);
+            j = 0;
+            }
+         CnvCShort(argv[base], segs[j].x1);
+         CnvCShort(argv[base + 1], segs[j].y1);
+         CnvCShort(argv[base + 2], segs[j].x2);
+         CnvCShort(argv[base + 3], segs[j].y2);
+	 segs[j].x1 += dx;
+	 segs[j].x2 += dx;
+	 segs[j].y1 += dy;
+	 segs[j].y2 += dy;
+         }
+      drawsegments(w, segs, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * DrawString(w, x1, y1, s1, ..., xN, yN, sN)
+ */
+"DrawString(argv[]){1} - draw text"
+
+function{1} DrawString(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, n, len, warg = 0;
+      char *s;
+
+      OptWindow(w);
+      CheckArgMultiple(3);
+
+      for(i=0; i < n; i++) {
+         C_integer x, y;
+	 int base = warg + i * 3;
+         CnvCInteger(argv[base], x);
+         CnvCInteger(argv[base + 1], y);
+	 x += w->context->dx;
+	 y += w->context->dy;
+         CnvTmpString(argv[base + 2], argv[base + 2]);
+	 s = StrLoc(argv[base + 2]);
+	 len = StrLen(argv[base + 2]);
+	 drawstrng(w, x, y, s, len);
+         }
+      ReturnWindow;
+      }
+end
+
+
+"EraseArea(w,x,y,width,height) - clear an area of the window"
+
+function{1} EraseArea(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0, i, r;
+      C_integer x, y, width, height;
+      OptWindow(w);
+
+      for (i = warg; i < argc || i == warg; i += 4) {
+         r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+         eraseArea(w, x, y, width, height);
+         }
+
+      ReturnWindow;
+      }
+end
+
+
+"Event(w) - return an event from a window"
+
+function{1} Event(argv[argc])
+   abstract {
+      return string ++ integer
+      }
+   body {
+      wbp w;
+      C_integer i;
+      tended struct descrip d;
+      int warg = 0;
+      OptWindow(w);
+
+      d = nulldesc;
+      i = wgetevent(w, &d);
+      if (i == 0) {
+         if (is:file(kywd_xwin[XKey_Window]) &&
+               w == (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd)
+	    lastEventWin = kywd_xwin[XKey_Window];
+	 else
+	    lastEventWin = argv[warg-1];
+         lastEvFWidth = FWIDTH((wbp)BlkLoc(lastEventWin)->file.fd);
+         lastEvLeading = LEADING((wbp)BlkLoc(lastEventWin)->file.fd);
+         lastEvAscent = ASCENT((wbp)BlkLoc(lastEventWin)->file.fd);
+	 return d;
+	 }
+      else if (i == -1)
+	 runerr(141);
+      else
+	 runerr(143);
+      }
+end
+
+
+"Fg(w,s) - foreground color"
+
+function{0,1} Fg(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      char sbuf1[MaxCvtLen];
+      int len;
+      tended char *tmp;
+      int warg = 0;
+      OptWindow(w);
+
+      /*
+       * If there is a (non-window) argument we are setting by
+       *  either a mutable color (negative int) or a string name.
+       */
+      if (argc - warg > 0) {
+	 if (is:integer(argv[warg])) {	/* mutable color or packed RGB */
+	    if (isetfg(w, IntVal(argv[warg])) == Failed) fail;
+	    }
+	 else {
+	    if (!cnv:C_string(argv[warg], tmp))
+	       runerr(103,argv[warg]);
+	    if(setfg(w, tmp) == Failed) fail;
+	    }
+         }
+
+      /*
+       * In any case, this function returns the current foreground color.
+       */
+      getfg(w, sbuf1);
+      len = strlen(sbuf1);
+      Protect(tmp = alcstr(sbuf1, len), runerr(0));
+      return string(len, tmp);
+      }
+end
+
+/*
+ * FillArc(w, x1, y1, width1, height1, angle11, angle21,...)
+ */
+"FillArc(argv[]){1} - fill arc"
+
+function{1} FillArc(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, r, warg = 0;
+      XArc arcs[MAXXOBJS];
+      C_integer x, y, width, height;
+      double a1, a2;
+
+      OptWindow(w);
+      j = 0;
+      for (i = warg; i < argc || i == warg; i += 6) {
+         if (j == MAXXOBJS) {
+            fillarcs(w, arcs, MAXXOBJS);
+            j = 0;
+            }
+         r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+
+         arcs[j].x = x;
+         arcs[j].y = y;
+         ARCWIDTH(arcs[j]) = width;
+         ARCHEIGHT(arcs[j]) = height;
+
+         if (i + 4 >= argc || is:null(argv[i + 4])) {
+            a1 = 0.0;
+	    }
+         else {
+            if (!cnv:C_double(argv[i + 4], a1))
+               runerr(102, argv[i + 4]);
+            if (a1 >= 0.0)
+               a1 = fmod(a1, 2 * Pi);
+            else
+               a1 = -fmod(-a1, 2 * Pi);
+            }
+         if (i + 5 >= argc || is:null(argv[i + 5]))
+	    a2 = 2 * Pi;
+         else {
+            if (!cnv:C_double(argv[i + 5], a2))
+               runerr(102, argv[i + 5]);
+            if (fabs(a2) > 3 * Pi)
+               runerr(101, argv[i + 5]);
+            }
+         if (fabs(a2) >= 2 * Pi) {
+	    a2 = 2 * Pi;
+	    }
+         else {
+            if (a2 < 0.0) {
+               a1 += a2;
+               a2 = fabs(a2);
+               }
+            }
+         arcs[j].angle2 = EXTENT(a2);
+         if (a1 < 0.0)
+            a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
+         else
+           a1 = fmod(a1, 2 * Pi);
+         arcs[j].angle1 = ANGLE(a1);
+
+         j++;
+         }
+
+      fillarcs(w, arcs, j);
+      ReturnWindow;
+      }
+end
+
+/*
+ * FillCircle(w, x1, y1, r1, angle11, angle21, ...)
+ */
+"FillCircle(argv[]){1} - draw filled circle"
+
+function{1} FillCircle(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0, r;
+
+      OptWindow(w);
+      r = docircles(w, argc - warg, argv + warg, 1);
+      if (r < 0)
+         ReturnWindow;
+      else if (r >= argc - warg)
+         runerr(146);
+      else
+         runerr(102, argv[warg + r]);
+      }
+end
+
+/*
+ * FillPolygon(w, x1, y1, ...xN, yN)
+ */
+"FillPolygon(argv[]){1} - fill polygon"
+
+function{1} FillPolygon(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, n, warg = 0;
+      XPoint *points;
+      int dx, dy;
+
+      OptWindow(w);
+
+      CheckArgMultiple(2)
+
+      /*
+       * Allocate space for all the points in a contiguous array,
+       * because a FillPolygon must be performed in a single call.
+       */
+      n = argc>>1;
+      Protect(points = (XPoint *)malloc(sizeof(XPoint) * n), runerr(305));
+      dx = w->context->dx;
+      dy = w->context->dy;
+      for(i=0; i < n; i++) {
+	 int base = warg + i * 2;
+         CnvCShort(argv[base], points[i].x);
+         CnvCShort(argv[base + 1], points[i].y);
+	 points[i].x += dx;
+         points[i].y += dy;
+         }
+      fillpolygon(w, points, n);
+      free(points);
+      ReturnWindow;
+      }
+end
+
+/*
+ * FillRectangle(w, x1, y1, width1, height1,...,xN, yN, widthN, heightN)
+ */
+"FillRectangle(argv[]){1} - draw filled rectangle"
+
+function{1} FillRectangle(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int i, j, r, warg = 0;
+      XRectangle recs[MAXXOBJS];
+      C_integer x, y, width, height;
+
+      OptWindow(w);
+      j = 0;
+
+      for (i = warg; i < argc || i == warg; i += 4) {
+         r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
+         if (r >= 0)
+            runerr(101, argv[r]);
+         if (j == MAXXOBJS) {
+            fillrectangles(w,recs,MAXXOBJS);
+            j = 0;
+            }
+         RECX(recs[j]) = x;
+         RECY(recs[j]) = y;
+         RECWIDTH(recs[j]) = width;
+         RECHEIGHT(recs[j]) = height;
+         j++;
+         }
+
+      fillrectangles(w, recs, j);
+      ReturnWindow;
+      }
+end
+
+
+
+"Font(w,s) - get/set font"
+
+function{0,1} Font(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      tended char *tmp;
+      int len;
+      wbp w;
+      int warg = 0;
+      char buf[MaxCvtLen];
+      OptWindow(w);
+
+      if (warg < argc) {
+         if (!cnv:C_string(argv[warg],tmp))
+            runerr(103,argv[warg]);
+         if (setfont(w,&tmp) == Failed) fail;
+         }
+      getfntnam(w, buf);
+      len = strlen(buf);
+      Protect(tmp = alcstr(buf, len), runerr(0));
+      return string(len,tmp);
+      }
+end
+
+
+"FreeColor(argv[]) - free colors"
+
+function{1} FreeColor(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      int i;
+      C_integer n;
+      tended char *s;
+
+      OptWindow(w);
+      if (argc - warg == 0) runerr(103);
+
+      for (i = warg; i < argc; i++) {
+         if (is:integer(argv[i])) {
+            CnvCInteger(argv[i], n)
+            if (n < 0)
+               free_mutable(w, n);
+            }
+         else {
+            if (!cnv:C_string(argv[i], s))
+               runerr(103,argv[i]);
+            freecolor(w, s);
+            }
+         }
+
+      ReturnWindow;
+      }
+
+end
+
+
+"GotoRC(w,r,c) - move cursor to a particular text row and column"
+
+function{1} GotoRC(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      C_integer r, c;
+      wbp w;
+      int warg = 0;
+      OptWindow(w);
+
+      if (argc - warg < 1)
+	 r = 1;
+      else
+	 CnvCInteger(argv[warg], r)
+      if (argc - warg < 2)
+	 c = 1;
+      else
+	 CnvCInteger(argv[warg + 1], c)
+
+      /*
+       * turn the cursor off
+       */
+      hidecrsr(w->window);
+
+      w->window->y = ROWTOY(w, r);
+      w->window->x = COLTOX(w, c);
+      w->window->x += w->context->dx;
+      w->window->y += w->context->dy;
+
+      /*
+       * turn it back on at new location
+       */
+      UpdateCursorPos(w->window, w->context);
+      showcrsr(w->window);
+
+      ReturnWindow;
+      }
+end
+
+
+"GotoXY(w,x,y) - move cursor to a particular pixel location"
+
+function{1} GotoXY(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      C_integer x, y;
+      int warg = 0;
+      OptWindow(w);
+
+      if (argc - warg < 1)
+	 x = 0;
+      else
+	 CnvCInteger(argv[warg], x)
+      if (argc - warg < 2)
+	 y = 0;
+      else
+	 CnvCInteger(argv[warg + 1], y)
+
+      x += w->context->dx;
+      y += w->context->dy;
+
+      hidecrsr(w->window);
+
+      w->window->x = x;
+      w->window->y = y;
+
+      UpdateCursorPos(w->window, w->context);
+      showcrsr(w->window);
+
+      ReturnWindow;
+      }
+end
+
+
+"Lower(w) - lower w to the bottom of the window stack"
+
+function{1} Lower(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      OptWindow(w);
+      lowerWindow(w);
+      ReturnWindow;
+      }
+end
+
+
+"NewColor(w,s) - allocate an entry in the color map"
+
+function{0,1} NewColor(argv[argc])
+   abstract {
+      return integer
+      }
+   body {
+      wbp w;
+      int rv;
+      int warg = 0;
+      OptWindow(w);
+
+      if (mutable_color(w, argv+warg, argc-warg, &rv) == Failed) fail;
+      return C_integer rv;
+      }
+end
+
+
+
+"PaletteChars(w,p) - return the characters forming keys to palette p"
+
+function{0,1} PaletteChars(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      int n, warg;
+      extern char c1list[], c2list[], c3list[], c4list[];
+
+      if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
+         warg = 1;
+      else
+         warg = 0;		/* window not required */
+      if (argc - warg < 1)
+         n = 1;
+      else
+         n = palnum(&argv[warg]);
+      switch (n) {
+         case -1:  runerr(103, argv[warg]);		/* not a string */
+         case  0:  fail;				/* unrecognized */
+         case  1:  return string(90, c1list);			/* c1 */
+         case  2:  return string(9, c2list);			/* c2 */
+         case  3:  return string(31, c3list);			/* c3 */
+         case  4:  return string(73, c4list);			/* c4 */
+         case  5:  return string(141, (char *)allchars);	/* c5 */
+         case  6:  return string(241, (char *)allchars);	/* c6 */
+         default:					/* gn */
+            if (n >= -64)
+               return string(-n, c4list);
+            else
+               return string(-n, (char *)allchars);
+         }
+      }
+end
+
+
+"PaletteColor(w,p,s) - return color of key s in palette p"
+
+function{0,1} PaletteColor(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      int p, warg, len;
+      char tmp[24], *s;
+      struct palentry *e;
+      tended struct descrip d;
+
+      if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
+         warg = 1;
+      else
+         warg = 0;			/* window not required */
+      if (argc - warg < 2)
+         runerr(103);
+      p = palnum(&argv[warg]);
+      if (p == -1)
+         runerr(103, argv[warg]);
+      if (p == 0)
+         fail;
+      if (!cnv:tmp_string(argv[warg + 1], d))
+         runerr(103, argv[warg + 1]);
+      if (StrLen(d) != 1)
+         runerr(205, d);
+      e = palsetup(p);
+      if (e == NULL)
+         runerr(305);
+      e += *StrLoc(d) & 0xFF;
+      if (!e->valid)
+         fail;
+      sprintf(tmp, "%ld,%ld,%ld", e->clr.red, e->clr.green, e->clr.blue);
+      len = strlen(tmp);
+      Protect(s = alcstr(tmp, len), runerr(306));
+      return string(len, s);
+      }
+end
+
+
+"PaletteKey(w,p,s) - return key of closest color to s in palette p"
+
+function{0,1} PaletteKey(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      int warg = 0, p;
+      C_integer n;
+      tended char *s;
+      long r, g, b;
+
+      if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window)) {
+         w = (wbp)BlkLoc(argv[0])->file.fd;		/* explicit window */
+         warg = 1;
+         }
+      else if (is:file(kywd_xwin[XKey_Window]) &&
+            (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window))
+         w = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;	/* &window */
+      else
+         w = NULL;			/* no window (but proceed anyway) */
+
+      if (argc - warg < 2)
+         runerr(103);
+      p = palnum(&argv[warg]);
+      if (p == -1)
+         runerr(103, argv[warg]);
+      if (p == 0)
+         fail;
+
+      if (cnv:C_integer(argv[warg + 1], n)) {
+         if (w == NULL || (s = get_mutable_name(w, n)) == NULL)
+            fail;
+         }
+      else if (!cnv:C_string(argv[warg + 1], s))
+         runerr(103, argv[warg + 1]);
+
+      if (parsecolor(w, s, &r, &g, &b) == Succeeded)
+         return string(1, rgbkey(p, r / 65535.0, g / 65535.0, b / 65535.0));
+      else
+         fail;
+      }
+end
+
+
+"Pattern(w,s) - sets the context fill pattern by string name"
+
+function{1} Pattern(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      int warg = 0;
+      wbp w;
+      OptWindow(w);
+
+      if (argc - warg == 0)
+         runerr(103, nulldesc);
+
+      if (! cnv:string(argv[warg], argv[warg]))
+         runerr(103, nulldesc);
+
+      switch (SetPattern(w, StrLoc(argv[warg]), StrLen(argv[warg]))) {
+         case Error:
+            runerr(0, argv[warg]);
+         case Failed:
+            fail;
+         }
+
+      ReturnWindow;
+      }
+end
+
+
+"Pending(w,x[]) - produce a list of events pending on window"
+
+function{0,1} Pending(argv[argc])
+   abstract {
+      return list
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      wsp ws;
+      int i;
+      OptWindow(w);
+
+      ws = w->window;
+      wsync(w);
+
+      /*
+       * put additional arguments to Pending on the pending list in
+       * guaranteed consecutive order.
+       */
+      for (i = warg; i < argc; i++) {
+         c_put(&(ws->listp), &argv[i]);
+         }
+
+      /*
+       * retrieve any events that might be relevant before returning the
+       * pending queue.
+       */
+      switch (pollevent()) {
+         case -1: runerr(141);
+         case 0: fail;
+	 }
+      return ws->listp;
+      }
+end
+
+
+
+"Pixel(w,x,y,width,height) - produce the contents of some pixels"
+
+function{3} Pixel(argv[argc])
+   abstract {
+      return integer ++ string
+      }
+   body {
+      struct imgmem imem;
+      C_integer x, y, width, height;
+      wbp w;
+      int warg = 0, slen, r;
+      tended struct descrip lastval;
+      char strout[50];
+      OptWindow(w);
+
+      r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
+      if (r >= 0)
+         runerr(101, argv[r]);
+
+      {
+      int i, j;
+      long rv;
+      wsp ws = w->window;
+
+#ifndef max
+#define max(x,y) (((x)<(y))?(y):(x))
+#define min(x,y) (((x)>(y))?(y):(x))
+#endif
+
+      imem.x = max(x,0);
+      imem.y = max(y,0);
+      imem.width = min(width, (int)ws->width - imem.x);
+      imem.height = min(height, (int)ws->height - imem.y);
+
+      if (getpixel_init(w, &imem) == Failed) fail;
+
+      lastval = emptystr;
+
+      for (j=y; j < y + height; j++) {
+         for (i=x; i < x + width; i++) {
+            getpixel(w, i, j, &rv, strout, &imem);
+            slen = strlen(strout);
+            if (rv >= 0) {
+	       int signal;
+               if (slen != StrLen(lastval) ||
+                     strncmp(strout, StrLoc(lastval), slen)) {
+                  Protect((StrLoc(lastval) = alcstr(strout, slen)), runerr(0));
+                  StrLen(lastval) = slen;
+                  }
+#if COMPILER
+               suspend lastval;		/* memory leak on vanquish */
+#else					/* COMPILER */
+	       /*
+		* suspend, but free up imem if vanquished; RTL workaround
+		* Needs implementing under the compiler.
+		*/
+	       r_args[0] = lastval;
+#ifdef EventMon
+	       if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {
+#else					/* EventMon */
+	       if ((signal = interp(G_Csusp, r_args)) != A_Resume) {
+#endif					/* EventMon */
+		  tend = r_tend.previous;
+		  getpixel_term(w, &imem);
+		  VanquishReturn(signal);
+		  }
+#endif					/* COMPILER */
+               }
+            else {
+#if COMPILER
+               suspend C_integer rv;	/* memory leak on vanquish */
+#else					/* COMPILER */
+	       int signal;
+	       /*
+		* suspend, but free up imem if vanquished; RTL workaround
+		* Needs implementing under the compiler.
+		*/
+	       r_args[0].dword = D_Integer;
+	       r_args[0].vword.integr = rv;
+#ifdef EventMon
+	       if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {
+#else					/* EventMon */
+	       if ((signal = interp(G_Csusp, r_args)) != A_Resume) {
+#endif					/* EventMon */
+		  tend = r_tend.previous;
+		  getpixel_term(w, &imem);
+		  VanquishReturn(signal);
+		  }
+#endif					/* COMPILER */
+               }
+            }
+         }
+      getpixel_term(w, &imem);
+      fail;
+      }
+      }
+end
+
+
+"QueryPointer(w) - produce mouse position"
+
+function{0,2} QueryPointer(w)
+
+   declare {
+      XPoint xp;
+      }
+   abstract {
+      return integer
+      }
+   body {
+      pollevent();
+      if (is:null(w)) {
+	 query_rootpointer(&xp);
+	 }
+      else {
+	 if (!is:file(w) || !(BlkLoc(w)->file.status & Fs_Window))
+	    runerr(140, w);
+	 query_pointer((wbp)BlkLoc(w)->file.fd, &xp);
+	 }
+      suspend C_integer xp.x;
+      suspend C_integer xp.y;
+      fail;
+      }
+end
+
+
+"Raise(w) - raise w to the top of the window stack"
+
+function{1} Raise(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      OptWindow(w);
+      raiseWindow(w);
+      ReturnWindow;
+      }
+end
+
+
+"ReadImage(w, s, x, y, p) - load image file"
+
+function{0,1} ReadImage(argv[argc])
+   abstract {
+      return integer
+      }
+   body {
+      wbp w;
+      char filename[MaxPath + 1];
+      tended char *tmp;
+      int status, warg = 0;
+      C_integer x, y;
+      int p, r;
+      struct imgdata imd;
+      OptWindow(w);
+
+      if (argc - warg == 0)
+	 runerr(103,nulldesc);
+      if (!cnv:C_string(argv[warg], tmp))
+	 runerr(103,argv[warg]);
+
+      /*
+       * x and y must be integers; they default to the upper left pixel.
+       */
+      if (argc - warg < 2) x = -w->context->dx;
+      else if (!def:C_integer(argv[warg+1], -w->context->dx, x))
+         runerr(101, argv[warg+1]);
+      if (argc - warg < 3) y = -w->context->dy;
+      else if (!def:C_integer(argv[warg+2], -w->context->dy, y))
+         runerr(101, argv[warg+2]);
+
+      /*
+       * p is an optional palette name.
+       */
+      if (argc - warg < 4 || is:null(argv[warg+3])) p = 0;
+      else {
+         p = palnum(&argv[warg+3]);
+         if (p == -1)
+            runerr(103, argv[warg+3]);
+         if (p == 0)
+            fail;
+         }
+
+      x += w->context->dx;
+      y += w->context->dy;
+      strncpy(filename, tmp, MaxPath);	/* copy to loc that won't move */
+      filename[MaxPath] = '\0';
+
+      /*
+       * First try to read as a GIF file.
+       * If that doesn't work, try platform-dependent image reading code.
+       */
+      r = readGIF(filename, p, &imd);
+      if (r == Succeeded) {
+         status = strimage(w, x, y, imd.width, imd.height, imd.paltbl,
+			   imd.data, (word)imd.width * (word)imd.height, 0);
+         if (status < 0)
+            r = Error;
+         free((pointer)imd.paltbl);
+         free((pointer)imd.data);
+         }
+      else if (r == Failed)
+         r = readimage(w, filename, x, y, &status);
+      if (r == Error)
+         runerr(305);
+      if (r == Failed)
+         fail;
+      if (status == 0)
+         return nulldesc;
+      else
+         return C_integer (word)status;
+      }
+end
+
+
+
+"WSync(w) - synchronize with server"
+
+function{1} WSync(w)
+   abstract {
+      return file++null
+      }
+   body {
+      wbp _w_;
+
+      if (is:null(w)) {
+	 _w_ = NULL;
+	 }
+      else if (!is:file(w)) runerr(140,w);
+      else {
+         if (!(BlkLoc(w)->file.status & Fs_Window))
+            runerr(140,w);
+         _w_ = (wbp)BlkLoc(w)->file.fd;
+	 }
+
+      wsync(_w_);
+      pollevent();
+      return w;
+      }
+end
+
+
+"TextWidth(w,s) - compute text pixel width"
+
+function{1} TextWidth(argv[argc])
+   abstract {
+      return integer
+      }
+   body {
+      wbp w;
+      int warg=0;
+      C_integer i;
+      OptWindow(w);
+
+      if (warg == argc) runerr(103,nulldesc);
+      else if (!cnv:tmp_string(argv[warg],argv[warg]))
+	 runerr(103,argv[warg]);
+
+      i = TEXTWIDTH(w, StrLoc(argv[warg]), StrLen(argv[warg]));
+      return C_integer i;
+      }
+end
+
+
+"Uncouple(w) - uncouple window"
+
+function{1} Uncouple(w)
+   abstract {
+      return file
+      }
+   body {
+      wbp _w_;
+      if (!is:file(w)) runerr(140,w);
+      if ((BlkLoc(w)->file.status & Fs_Window) == 0) runerr(140,w);
+      if ((BlkLoc(w)->file.status & (Fs_Read|Fs_Write)) == 0) runerr(142,w);
+      _w_ = (wbp)BlkLoc(w)->file.fd;
+      BlkLoc(w)->file.status = Fs_Window; /* no longer open for read/write */
+      free_binding(_w_);
+      return w;
+      }
+end
+
+"WAttrib(argv[]) - read/write window attributes"
+
+function{*} WAttrib(argv[argc])
+   abstract {
+      return file++string++integer
+      }
+   body {
+      wbp w, wsave;
+      word n;
+      tended struct descrip sbuf, sbuf2;
+      char answer[128];
+      int  pass, config = 0;
+      int warg = 0;
+      OptWindow(w);
+
+      wsave = w;
+      /*
+       * Loop through the arguments.
+       */
+      for (pass = 1; pass <= 2; pass++) {
+	 w = wsave;
+	 if (config && pass == 2) {
+	    if (do_config(w, config) == Failed) fail;
+	    }
+         for (n = warg; n < argc; n++) {
+            if (is:file(argv[n])) {/* Current argument is a file */
+               /*
+                * Switch the current file to the file named by the
+                *  current argument providing it is a file.  argv[n]
+                *  is made to be a empty string to avoid a special case.
+                */
+               if (!(BlkLoc(argv[n])->file.status & Fs_Window))
+                  runerr(140,argv[n]);
+               w = (wbp)BlkLoc(argv[n])->file.fd;
+	       if (config && pass == 2) {
+		  if (do_config(w, config) == Failed) fail;
+		  }
+               }
+            else {	/* Current argument should be a string */
+	       /*
+		* In pass 1, a null argument is an error; failed attribute
+		*  assignments are turned into null descriptors for pass 2
+		*  and are ignored.
+		*/
+               if (is:null(argv[n])) {
+		  if (pass == 2)
+		     continue;
+		  else runerr(109, argv[n]);
+		  }
+               /*
+                * If its an integer or real, it can't be a valid attribute.
+                */
+	       if (is:integer(argv[n]) || is:real(argv[n])) {
+		  runerr(145, argv[n]);
+		  }
+               /*
+                * Convert the argument to a string
+                */
+               if (!cnv:tmp_string(argv[n], sbuf))
+                  runerr(109, argv[n]);
+               /*
+                * Various parts of the code can't handle long attributes.
+		* (ugh.)
+                */
+	       if (StrLen(sbuf) > 127)
+	          runerr(145, argv[n]);
+               /*
+                * Read/write the attribute
+                */
+               if (pass == 1) {
+		  char *tmp_s = StrLoc(sbuf);
+		  char *tmp_s2 = StrLoc(sbuf) + StrLen(sbuf);
+		  for ( ; tmp_s < tmp_s2; tmp_s++)
+		     if (*tmp_s == '=') break;
+		  if (tmp_s < tmp_s2) {
+		     /*
+		      * pass 1: perform attribute assignments
+		      */
+		     switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
+				     &sbuf2, answer)) {
+		     case Failed:
+		        /*
+			 * Mark the attribute so we don't produce a result
+			 */
+		        argv[n] = nulldesc;
+		        continue;
+		     case Error: runerr(0, argv[n]);
+		     }
+		     if (StrLen(sbuf) > 4) {
+			if (!strncmp(StrLoc(sbuf), "pos=", 4)) config |= 1;
+			if (StrLen(sbuf) > 5) {
+			   if (!strncmp(StrLoc(sbuf), "posx=", 5)) config |= 1;
+			   if (!strncmp(StrLoc(sbuf), "posy=", 5)) config |= 1;
+			   if (!strncmp(StrLoc(sbuf), "rows=", 5)) config |= 2;
+			   if (!strncmp(StrLoc(sbuf), "size=", 5)) config |= 2;
+			   if (StrLen(sbuf) > 6) {
+			      if (!strncmp(StrLoc(sbuf), "width=", 6))
+				 config |= 2;
+			      if (!strncmp(StrLoc(sbuf), "lines=", 6))
+				 config |= 2;
+			      if (StrLen(sbuf) > 7) {
+				 if (!strncmp(StrLoc(sbuf), "height=", 7))
+				    config |= 2;
+				 if (!strncmp(StrLoc(sbuf), "resize=", 7))
+				    config |= 2;
+				 if (StrLen(sbuf) > 8) {
+				    if (!strncmp(StrLoc(sbuf), "columns=", 8))
+				       config |= 2;
+				    if (StrLen(sbuf) > 9) {
+				       if (!strncmp(StrLoc(sbuf),
+						    "geometry=", 9))
+					  config |= 3;
+				       }
+				    }
+				 }
+			      }
+			   }
+			}
+		     }
+		  }
+	       /*
+		* pass 2: perform attribute queries, suspend result(s)
+		*/
+               else if (pass==2) {
+		  char *stmp, *stmp2;
+		  /*
+		   * Turn assignments into queries.
+		   */
+		  for( stmp = StrLoc(sbuf),
+		      stmp2 = stmp + StrLen(sbuf); stmp < stmp2; stmp++)
+		     if (*stmp == '=') break;
+		  if (stmp < stmp2)
+		     StrLen(sbuf) = stmp - StrLoc(sbuf);
+
+		  switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
+				  &sbuf2, answer)) {
+		  case Failed: continue;
+		  case Error:  runerr(0, argv[n]);
+		     }
+		  if (is:string(sbuf2))
+		     Protect(StrLoc(sbuf2) = alcstr(StrLoc(sbuf2),StrLen(sbuf2)), runerr(0));
+                  suspend sbuf2;
+                  }
+               }
+            }
+	 }
+      fail;
+      }
+end
+
+
+"WDefault(w,program,option) - get a default value from the environment"
+
+function{0,1} WDefault(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      long l;
+      tended char *prog, *opt;
+      char sbuf1[MaxCvtLen];
+      OptWindow(w);
+
+      if (argc-warg < 2)
+         runerr(103);
+      if (!cnv:C_string(argv[warg],prog))
+         runerr(103,argv[warg]);
+      if (!cnv:C_string(argv[warg+1],opt))
+         runerr(103,argv[warg+1]);
+
+      if (getdefault(w, prog, opt, sbuf1) == Failed) fail;
+      l = strlen(sbuf1);
+      Protect(prog = alcstr(sbuf1,l),runerr(0));
+      return string(l,prog);
+      }
+end
+
+
+"WFlush(w) - flush all output to window w"
+
+function{1} WFlush(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int warg = 0;
+      OptWindow(w);
+      wflush(w);
+      ReturnWindow;
+      }
+end
+
+
+"WriteImage(w,filename,x,y,width,height) - write an image to a file"
+
+function{0,1} WriteImage(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      int r;
+      C_integer x, y, width, height, warg = 0;
+      tended char *s;
+      OptWindow(w);
+
+      if (argc - warg == 0)
+         runerr(103, nulldesc);
+      else if (!cnv:C_string(argv[warg], s))
+         runerr(103, argv[warg]);
+
+      r = rectargs(w, argc, argv, warg + 1, &x, &y, &width, &height);
+      if (r >= 0)
+         runerr(101, argv[r]);
+
+      /*
+       * clip image to window, and fail if zero-sized.
+       * (the casts to long are necessary to avoid unsigned comparison.)
+       */
+      if (x < 0)  {
+         width += x;
+         x = 0;
+         }
+      if (y < 0)  {
+         height += y;
+         y = 0;
+         }
+      if (x + width > (long) w->window->width)
+         width = w->window->width - x;
+      if (y + height > (long) w->window->height)
+         height = w->window->height - y;
+      if (width <= 0 || height <= 0)
+	 fail;
+
+      /*
+       * try platform-dependent code first; it will reject the call
+       * if the file name s does not specify a platform-dependent format.
+       */
+      r = dumpimage(w, s, x, y, width, height);
+      if (r == NoCvt)
+         r = writeGIF(w, s, x, y, width, height);
+      if (r != Succeeded)
+         fail;
+      ReturnWindow;
+      }
+end
+
+#ifdef WinExtns
+
+"WinPlayMedia(w,x[]) - play a multimedia resource"
+
+function{0,1} WinPlayMedia(argv[argc])
+   abstract {
+      return null
+      }
+   body {
+      wbp w;
+      tended char *tmp;
+      int warg = 0;
+      int i;
+      wsp ws;
+      word n;
+      OptWindow(w);
+
+      ws = w->window;
+      for (n = warg; n < argc; n++) {
+         if (!cnv:C_string(argv[n], tmp))
+	    runerr(103,argv[warg]);
+         if (playmedia(w, tmp) == Failed) fail;
+         }
+      return nulldesc;
+      }
+end
+
+
+
+/*
+ * Simple Windows-native pushbutton
+ */
+"WinButton(w, s, x, y, wd, ht) - install a pushbutton with label s on window w"
+
+function{0,1} WinButton(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      wsp ws;
+      int i, ii, i2, r, total = 0;
+      C_integer x, y, width, height, warg = 0;
+      tended char *s, *s2;
+      tended struct descrip d;
+      tended struct b_list *hp;
+      OptWindow(w);
+      ws = w->window;
+      if (warg == argc) fail;
+      if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
+      warg++;
+      /*
+       * look for an existing button with this id.
+       */
+      for(i = 0; i < ws->nChildren; i++) {
+         if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_BUTTON)
+            break;
+         }
+      /*
+       * create a new button if none is found
+       */
+      if (i == ws->nChildren) {
+         ws->nChildren++;
+         ws->child = realloc(ws->child,
+			     ws->nChildren * sizeof(childcontrol));
+	 makebutton(ws, ws->child + i, s);
+         }
+
+      if (warg >= argc) x = 0;
+      else if (!def:C_integer(argv[warg], 0, x))
+	 runerr(101, argv[warg]);
+      warg++;
+      if (warg >= argc) y = 0;
+      else if (!def:C_integer(argv[warg], 0, y))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * default width is width of text in system font + 2 chars
+       */
+      ii = sysTextWidth(w, s, strlen(s)) + 10;
+      if (warg >= argc) width = i2;
+      else if (!def:C_integer(argv[warg], i2, width))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * default height is height of text in system font * 7/4
+       */
+      i2 = sysFontHeight(w) * 7 / 4;
+      if (warg >= argc) height = i2;
+      else if (!def:C_integer(argv[warg], i2, height))
+	 runerr(101, argv[warg]);
+
+      movechild(ws->child + i, x, y, width, height);
+      ReturnWindow;
+      }
+end
+
+"WinScrollBar(w, s, i1, i2, i3, x, y, wd, ht) - install a scrollbar"
+
+function{0,1} WinScrollBar(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      wsp ws;
+      C_integer x, y, width, height, warg = 0, i1, i2, i3, i, ii;
+      tended char *s, *s2;
+      tended struct descrip d;
+      tended struct b_list *hp;
+
+      OptWindow(w);
+      ws = w->window;
+      if (warg == argc) fail;
+      if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
+      warg++;
+      /*
+       * look for an existing scrollbar with this id.
+       */
+      for(i = 0; i < ws->nChildren; i++) {
+         if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_EDIT)
+            break;
+         }
+      /*
+       * i1, the min of the scrollbar range, defaults to 0
+       */
+      if (warg >= argc) i1 = 0;
+      else if (!def:C_integer(argv[warg], 0, i1)) runerr(101, argv[warg]);
+      warg++;
+      /*
+       * i2, the max of the scrollbar range, defaults to 100
+       */
+      if (warg >= argc) i2 = 100;
+      else if (!def:C_integer(argv[warg], 100, i2)) runerr(101, argv[warg]);
+      warg++;
+      /*
+       * create a new scrollbar at end of array if none was found
+       */
+      if (i == ws->nChildren) {
+         ws->nChildren++;
+         ws->child = realloc(ws->child, ws->nChildren * sizeof(childcontrol));
+	 makescrollbar(ws, ws->child + i, s, i1, i2);
+         }
+      /*
+       * i3, the interval, defaults to 10
+       */
+      if (warg >= argc) i3 = 10;
+      else if (!def:C_integer(argv[warg], 10, i3))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * x defaults to the right edge of the window - system scrollbar width
+       */
+      ii = ws->width - sysScrollWidth();
+      if (warg >= argc) x = ii;
+      else if (!def:C_integer(argv[warg], ii, x))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * y defaults to 0
+       */
+      if (warg >= argc) y = 0;
+      else if (!def:C_integer(argv[warg], 0, y))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * width defaults to system scrollbar width
+       */
+      ii = sysScrollWidth();
+      if (warg >= argc) width = ii;
+      else if (!def:C_integer(argv[warg], ii, width))
+	 runerr(101, argv[warg]);
+      warg++;
+      /*
+       * height defaults to height of the client window
+       */
+      if (warg >= argc) height = ws->height;
+      else if (!def:C_integer(argv[warg], ws->height, height))
+	 runerr(101, argv[warg]);
+
+      movechild(ws->child + i, x, y, width, height);
+      ReturnWindow;
+      }
+end
+
+/*
+ * Simple Windows-native menu bar
+ */
+"WinMenuBar(w,L1,L2,...) - install a set of top-level menus"
+
+function{0,1} WinMenuBar(argv[argc])
+   abstract {
+      return file
+      }
+   body {
+      wbp w;
+      wsp ws;
+      int i, total = 0;
+      C_integer x, y, warg = 0;
+      tended char *s;
+      tended struct descrip d;
+      OptWindow(w);
+      ws = w->window;
+
+      if (warg == argc) fail;
+      for (i = warg; i < argc; i++) {
+         if (!is:list(argv[i])) runerr(108, argv[i]);
+         total += BlkLoc(argv[i])->list.size;
+	 }
+      /*
+       * free up memory for the old menu map
+       */
+      if (ws->nmMapElems) {
+         for (i=0; i<ws->nmMapElems; i++) free(ws->menuMap[i]);
+         free(ws->menuMap);
+         }
+      ws->menuMap = (char **)calloc(total, sizeof(char *));
+
+      if (nativemenubar(w, total, argc, argv, warg, &d) == Error)
+        runerr(103, d);
+      ReturnWindow;
+      }
+end
+
+/*
+ * Windows-native editor
+ */
+"WinEditRegion(w, s, s2, x, y, wd, ht) = install an edit box with label s"
+
+function{0, 1} WinEditRegion(argv[argc])
+   abstract {
+      return file ++ string
+      }
+   body {
+      wbp w;
+      wsp ws;
+      tended char *s, *s2;
+      C_integer i, x, y, width, height, warg = 0;
+      OptWindow(w);
+      ws = w->window;
+      if (warg == argc) fail;
+      if (!cnv:C_string(argv[warg], s))
+	 runerr(103, argv[warg]);
+      warg++;
+      /*
+       * look for an existing edit region with this id.
+       */
+      for(i = 0; i < ws->nChildren; i++) {
+         if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_EDIT)
+            break;
+         }
+      /*
+       * create a new edit region if none is found
+       */
+      if (i == ws->nChildren) {
+         ws->nChildren++;
+         ws->child = realloc(ws->child, ws->nChildren * sizeof(childcontrol));
+	 makeeditregion(w, ws->child + i, s);
+         }
+      /*
+       * Invoked with no value, return the current value of an existing
+       * edit region (entire buffer is one gigantic string).
+       */
+      else if (warg == argc) {
+         geteditregion(ws->child + i, &result);
+	 return result;
+         }
+      /*
+       * Assign a value (s2 string contents) or perform editing command
+       */
+      if (is:null(argv[warg])) s2 = NULL;
+      else if (!cnv:C_string(argv[warg], s2)) runerr(103, argv[warg]);
+      warg++;
+
+      if (warg >= argc) x = 0;
+      else if (!def:C_integer(argv[warg], 0, x)) runerr(101, argv[warg]);
+      warg++;
+      if (warg >= argc) y = 0;
+      else if (!def:C_integer(argv[warg], 0, y)) runerr(101, argv[warg]);
+      warg++;
+      if (warg >= argc) width = ws->width - x;
+      else if (!def:C_integer(argv[warg], ws->width -x, width))
+         runerr(101, argv[warg]);
+      warg++;
+      if (warg >= argc) height = ws->height - y;
+      else if (!def:C_integer(argv[warg], ws->height - y, height))
+         runerr(101, argv[warg]);
+
+      if (s2 && !strcmp("!clear", s2)) {
+         cleareditregion(ws->child + i);
+         s2 = NULL;
+         }
+      else if (s2 && !strcmp("!copy", s2)) {
+         copyeditregion(ws->child + i);
+         s2 = NULL;
+         }
+      else if (s2 && !strcmp("!cut", s2)) {
+         cuteditregion(ws->child + i);
+         s2 = NULL;
+         }
+      else if (s2 && !strcmp("!paste", s2)) {
+         pasteeditregion(ws->child + i);
+         s2 = NULL;
+         }
+      else if (s2 && !strcmp("!undo", s2)) {
+         if (undoeditregion(ws->child + i) == Failed) fail;
+         s2 = NULL;
+         }
+      else if (s2 && !strncmp("!modified=", s2, 10)) {
+         setmodifiededitregion(ws->child + i, atoi(s2+10));
+         s2 = NULL;
+         }
+      else if (s2 && !strcmp("!modified", s2)) {
+         if (modifiededitregion(ws->child + i) == Failed) fail;
+         s2 = NULL;
+         }
+      else if (s2 && !strncmp("!font=", s2, 6)) {
+	 if (setchildfont(ws->child + i, s2 + 6) == Succeeded) {
+            ReturnWindow;
+	    }
+	 else fail;
+         }
+      else if (s2 && !strcmp("!setsel", s2)) {
+	 setchildselection(ws, ws->child + i, x, y);
+         ReturnWindow;
+         }
+
+      if (s2) {
+         seteditregion(ws->child + i, s2);
+	 }
+      movechild(ws->child + i, x, y, width, height);
+      setfocusonchild(ws, ws->child + i, width, height);
+      ReturnWindow;
+      }
+end
+
+
+/*
+ * common dialog functions
+ */
+
+"WinColorDialog(w,s) - choose a color for a window's context"
+
+function{0,1} WinColorDialog(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      C_integer x, y, width, height, warg = 0;
+      long r, g, b;
+      tended char *s;
+      char buf[64], *tmp = buf;
+      OptWindow(w);
+
+      if (warg < argc) {
+         if (is:null(argv[warg])) s = "white";
+	 else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
+         }
+      else s = "white";
+      if (parsecolor(w, s, &r, &g, &b) == Failed) fail;
+
+      if (nativecolordialog(w, r, g, b, buf) == NULL) fail;
+      StrLoc(result) = alcstr(buf, strlen(buf));
+      StrLen(result) = strlen(buf);
+      return result;
+      }
+end
+
+"WinFontDialog(w,s) - choose a font for a window's context"
+
+function{0,1} WinFontDialog(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      int r;
+      C_integer x, y, width, height, warg = 0, fheight;
+      int flags;
+      tended char *s;
+      char buf[64], *tmp = buf;
+      OptWindow(w);
+
+      if (warg < argc) {
+         if (is:null(argv[warg])) s = "fixed";
+	 else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
+         }
+      else s = "fixed";
+
+      parsefont(s, buf, &flags, &fheight);
+
+      if (nativefontdialog(w, buf, flags, fheight) == Failed) fail;
+      StrLoc(result) = alcstr(buf, strlen(buf));
+      StrLen(result) = strlen(buf);
+      return result;
+      }
+end
+
+
+"WinOpenDialog(w,s1,s2,i,s3,j) - choose a file to open"
+
+function{0,1} WinOpenDialog(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      int len, slen;
+      C_integer i, j, x, y, width, height, warg = 0;
+      char buf2[64], buf3[256], chReplace;
+      char *tmpstr;
+      tended char *s1, *s2, *s3;
+      OptWindow(w);
+
+      if (warg >= argc || is:null(argv[warg])) {
+         s1 = "Open:";
+         }
+      else if (!cnv:C_string(argv[warg], s1)) {
+         runerr(103, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc || is:null(argv[warg])) {
+         s2 = "";
+         }
+      else if (!cnv:C_string(argv[warg], s2)) {
+         runerr(103, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc) {
+         i = 50;
+         }
+      else if (!def:C_integer(argv[warg], 50, i)) {
+         runerr(101, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc || is:null(argv[warg])) {
+         strcpy(buf3,"All Files(*.*)|*.*|");
+         s3 = buf3;
+         }
+      else if (!cnv:C_string(argv[warg], s3)) {
+         runerr(103, argv[warg]);
+         }
+      else {
+         strncpy(buf3, s3, 255);
+	 buf3[255] = '\0';
+	 s3 = buf3;
+         }
+      chReplace = s3[strlen(s3)-1];
+      slen = strlen(s3);
+      for(j=0; j < slen; j++)
+         if(s3[j] == chReplace) s3[j] = '\0';
+      warg++;
+
+      if (warg >= argc) {
+         j = 1;
+         }
+      else if (!def:C_integer(argv[warg], 1, j)) {
+         runerr(101, argv[warg]);
+         }
+      warg++;
+
+      if ((tmpstr = nativeopendialog(w,s1,s2,s3,i,j)) == NULL) fail;
+      len = strlen(tmpstr);
+      StrLoc(result) = alcstr(tmpstr, len);
+      StrLen(result) = len;
+      return result;
+      }
+end
+
+
+"WinSelectDialog(w, s1, buttons) - select from a set of choices"
+
+function{0,1} WinSelectDialog(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      C_integer i, j, warg = 0, len;
+      tended char *s1;
+      char *s2 = NULL, *tmpstr;
+      tended struct descrip d;
+      tended struct b_list *hp;
+      int lsize;
+      OptWindow(w);
+
+      /*
+       * look for list of text for the message.  concatenate text strings.
+       */
+      if (warg == argc)
+         fail;
+      if (!is:list(argv[warg])) runerr(108, argv[warg]);
+      hp  = (struct b_list *)BlkLoc(argv[warg]);
+      lsize = hp->size;
+      for(i=0; i < lsize; i++) {
+         c_get(hp, &d);
+         if (!cnv:C_string(d, s1)) runerr(103, d);
+         len += strlen(s1)+2;
+	 if (s2) {
+	    s2 = realloc(s2, len);
+	    if (!s2) fail;
+            strcat(s2, "\r\n");
+	    strcat(s2, s1);
+	    }
+	 else s2 = salloc(s1);
+         c_put(&(argv[warg]), &d);
+	 }
+      warg++;
+
+      if (warg >= argc) {
+         hp = NULL;
+         }
+      else {
+         if (!is:list(argv[warg])) runerr(108, argv[warg]);
+         hp  = (struct b_list *)BlkLoc(argv[warg]);
+         lsize = hp->size;
+         for(i=0; i < lsize; i++) {
+            c_get(hp, &d);
+            if (!cnv:C_string(d, s1)) runerr(103, d);
+            c_put(&(argv[warg]), &d);
+            }
+         }
+      tmpstr = nativeselectdialog(w, hp, s2);
+      if (tmpstr == NULL) fail;
+      free(s2);
+      len = strlen(tmpstr);
+      StrLoc(result) = alcstr(tmpstr, len);
+      StrLen(result) = len;
+      return result;
+      }
+end
+
+"WinSaveDialog(w,s1,s2,i,s3,j) - choose a file to save"
+
+function{0,1} WinSaveDialog(argv[argc])
+   abstract {
+      return string
+      }
+   body {
+      wbp w;
+      int len;
+      C_integer i, j, warg = 0, slen;
+      char buf3[128], chReplace;
+      tended char *tmpstr;
+      tended char *s1, *s2, *s3;
+      OptWindow(w);
+
+      if (warg >= argc || is:null(argv[warg])) {
+         s1 = "Save:";
+         }
+      else if (!cnv:C_string(argv[warg], s1)) {
+         runerr(103, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc || is:null(argv[warg])) {
+         s2 = "";
+         }
+      else if (!cnv:C_string(argv[warg], s2)) {
+         runerr(103, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc) {
+         i = 50;
+         }
+      else if (!def:C_integer(argv[warg], 50, i)) {
+         runerr(101, argv[warg]);
+         }
+      warg++;
+
+      if (warg >= argc || is:null(argv[warg])) {
+         strcpy(buf3,"All Files(*.*)|*.*|");
+         s3 = buf3;
+         }
+      else if (!cnv:C_string(argv[warg], s3)) {
+         runerr(103, argv[warg]);
+         }
+      else {
+         strcpy(buf3, s3);
+	 s3 = buf3;
+         }
+      chReplace = s3[strlen(s3)-1];
+      slen = strlen(s3);
+      for(j=0; j < slen; j++)
+         if(s3[j] == chReplace) s3[j] = '\0';
+      warg++;
+
+      if (warg >= argc) {
+         j = 1;
+         }
+      else if (!def:C_integer(argv[warg], 1, j)) {
+         runerr(101, argv[warg]);
+         }
+      warg++;
+      if ((tmpstr = nativesavedialog(w, s1, s2, s3, i, j)) == NULL) fail;
+      len = strlen(tmpstr);
+      StrLoc(result) = alcstr(tmpstr, len);
+      StrLen(result) = len;
+      return result;
+      }
+end
+#endif					/* WinExtns */
+
+#endif					/* Graphics */
diff --git a/src/runtime/imain.r b/src/runtime/imain.r
new file mode 100644
index 0000000..424a4f6
--- /dev/null
+++ b/src/runtime/imain.r
@@ -0,0 +1,384 @@
+#if !COMPILER
+/*
+ * File: imain.r
+ * Interpreter main program, argument handling, and such.
+ * Contents: main, iconx, ixopts, resolve
+ */
+
+#include "../h/version.h"
+#include "../h/header.h"
+#include "../h/opdefs.h"
+
+static int iconx(int argc, char *argv[]);
+static void ixopts(int argc, char *argv[], int *ip);
+
+/*
+ * Initial interpreter entry point (for all remaining platforms).
+ */
+int main(int argc, char *argv[]) {
+   return iconx(argc, argv);
+}
+
+/*
+ * Initial icode sequence. This is used to invoke the main procedure
+ *  with one argument.  If main returns, the Op_Quit is executed.
+ */
+int iconx(int argc, char *argv[]) {
+   int i, slen;
+   static word istart[4];
+   static int mterm = Op_Quit;
+
+   #ifdef MultiThread
+      /*
+       * Look for MultiThread programming environment in which to execute
+       * this program, specified by MTENV environment variable.
+       */
+      {
+      char *p;
+      char **new_argv;
+      int i, j = 1, k = 1;
+      if ((p = getenv("MTENV")) != NULL) {
+         for(i=0;p[i];i++)
+   	 if (p[i] == ' ')
+   	    j++;
+         new_argv = malloc((argc + j) * sizeof(char *));
+         new_argv[0] = argv[0];
+         for (i=0; p[i]; ) {
+   	 new_argv[k++] = p+i;
+   	 while (p[i] && (p[i] != ' '))
+   	    i++;
+   	 if (p[i] == ' ')
+   	    p[i++] = '\0';
+   	 }
+         for(i=1;i<argc;i++)
+   	 new_argv[k++] = argv[i];
+         argc += j;
+         argv = new_argv;
+         }
+      }
+   #endif				/* MultiThread */
+
+   ipc.opnd = NULL;
+
+   #ifdef LoadFunc
+      /*
+       *  Append to FPATH the bin directory from which iconx was executed.
+       */
+      {
+         char *p, *q, buf[1000];
+         p = getenv("FPATH");
+         q = relfile(argv[0], "/..");
+         sprintf(buf, "FPATH=%s %s", (p ? p : "."), (q ? q : "."));
+         putenv(buf);
+         }
+   #endif				/* LoadFunc */
+
+   /*
+    * Setup Icon interface.  It's done this way to avoid duplication
+    *  of code, since the same thing has to be done if calling Icon
+    *  is enabled.
+    */
+
+   ixopts(argc, argv, &i);
+
+   if (i < 0) {
+      argc++;
+      argv--;
+      i++;
+      }
+
+   while (i--) {			/* skip option arguments */
+      argc--;
+      argv++;
+      }
+
+   if (argc <= 1)
+      error(NULL, "no icode file specified");
+
+   /*
+    * Call icon_init with the name of the icode file to execute.	[[I?]]
+    */
+   icon_init(argv[1], &argc, argv);
+
+   /*
+    *  Point sp at word after b_coexpr block for &main, point ipc at initial
+    *	icode segment, and clear the gfp.
+    */
+
+   stackend = stack + mstksize/WordSize;
+   sp = stack + Wsizeof(struct b_coexpr);
+
+   ipc.opnd = istart;
+   *ipc.op++ = Op_Noop;  /* aligns Invoke's operand */	/*	[[I?]] */
+   *ipc.op++ = Op_Invoke;				/*	[[I?]] */
+   *ipc.opnd++ = 1;
+   *ipc.op = Op_Quit;
+   ipc.opnd = istart;
+
+   gfp = 0;
+
+   /*
+    * Set up expression frame marker to contain execution of the
+    *  main procedure.  If failure occurs in this context, control
+    *  is transferred to mterm, the address of an Op_Quit.
+    */
+   efp = (struct ef_marker *)(sp);
+   efp->ef_failure.op = &mterm;
+   efp->ef_gfp = 0;
+   efp->ef_efp = 0;
+   efp->ef_ilevel = 1;
+   sp += Wsizeof(*efp) - 1;
+
+   pfp = 0;
+   ilevel = 0;
+
+   /*
+    * We have already loaded the
+    * icode and initialized things, so it's time to just push main(),
+    * build an Icon list for the rest of the arguments, and called
+    * interp on a "invoke 1" bytecode.
+    */
+
+   /*
+    * The first global variable holds the value of "main".  If it
+    *  is not of type procedure, this is noted as run-time error 117.
+    *  Otherwise, this value is pushed on the stack.
+    */
+   if (globals[0].dword != D_Proc)
+      fatalerr(117, NULL);
+   PushDesc(globals[0]);
+   PushNull;
+   glbl_argp = (dptr)(sp - 1);
+
+   /*
+    * If main() has a parameter, it is to be invoked with one argument, a list
+    *  of the command line arguments.  The command line arguments are pushed
+    *  on the stack as a series of descriptors and Ollist is called to create
+    *  the list.  The null descriptor first pushed serves as Arg0 for
+    *  Ollist and receives the result of the computation.
+    */
+   if (((struct b_proc *)BlkLoc(globals[0]))->nparam > 0) {
+      for (i = 2; i < argc; i++) {
+         char *tmp;
+         slen = strlen(argv[i]);
+         PushVal(slen);
+         Protect(tmp=alcstr(argv[i],(word)slen), fatalerr(0,NULL));
+         PushAVal(tmp);
+         }
+
+      Ollist(argc - 2, glbl_argp);
+      }
+
+   sp = (word *)glbl_argp + 1;
+   glbl_argp = 0;
+   ixinited = 1;		/* post fact that iconx is initialized */
+
+   /*
+    * Start things rolling by calling interp.  This call to interp
+    *  returns only if an Op_Quit is executed.	If this happens,
+    *  c_exit() is called to wrap things up.
+    */
+   interp(0,(dptr)NULL);
+   c_exit(EXIT_SUCCESS);
+   return 0;
+}
+
+/*
+ * ixopts - handle interpreter command line options.
+ */
+void ixopts(argc,argv,ip)
+int argc;
+char **argv;
+int *ip;
+   {
+
+   #ifdef TallyOpt
+      extern int tallyopt;
+   #endif				/* TallyOpt */
+
+   *ip = 0;			/* number of arguments processed */
+
+   #if MSWIN
+      /*
+       * if we didn't start with iconx.exe, backup one
+       * so that our icode filename is argv[1].
+       */
+      {
+      char tmp[256], *t2, *basename, *ext;
+      int len = 0;
+      strcpy(tmp, argv[0]);
+      for (t2 = tmp; *t2; t2++) {
+         switch (*t2) {
+	    case ':':
+	    case '/':
+	    case '\\':
+	       basename = t2 + 1;
+	       ext = NULL;
+	       break;
+	    case '.':
+	       ext = t2;
+	       break;
+	    default:
+         *t2 = tolower(*t2);
+	       break;
+	    }
+         }
+      /* If present, cut the ".exe" extension. */
+      if (ext != NULL && !strcmp(ext, ".exe"))
+         *ext = 0;
+
+      /*
+       * if argv[0] is not a reference to our interpreter, take it as the
+       * name of the icode file, and back up for it.
+       */
+      if (strcmp(basename, "iconx")) {
+         argv--;
+         argc++;
+         (*ip)--;
+         }
+      }
+   #endif				/* MSWIN */
+
+   /*
+    * Handle command line options.
+    */
+   while ( argv[1] != 0 && *argv[1] == '-' ) {
+
+      switch ( *(argv[1]+1) ) {
+
+         #ifdef TallyOpt
+         /*
+          * Set tallying flag if -T option given
+          */
+         case 'T':
+            tallyopt = 1;
+            break;
+         #endif				/* TallyOpt */
+
+         /*
+          * Announce version on stderr if -V is given.
+          */
+         case 'V':
+            fprintf(stderr, "%s  (%s, %s)\n", Version, Config, __DATE__);
+	    if (!argv[2])
+	       exit(0);
+            break;
+   
+         }
+
+      argc--;
+      (*ip)++;
+      argv++;
+      }
+   }
+
+/*
+ * resolve - perform various fix-ups on the data read from the icode
+ *  file.
+ */
+#ifdef MultiThread
+   void resolve(pstate)
+   struct progstate *pstate;
+#else					/* MultiThread */
+   void resolve()
+#endif					/* MultiThread */
+
+   {
+   register word i, j;
+   register struct b_proc *pp;
+   register dptr dp;
+   extern int Omkrec();
+   #ifdef MultiThread
+      register struct progstate *savedstate;
+   #endif				/* MultiThread */
+
+   #ifdef MultiThread
+      savedstate = curpstate;
+      if (pstate) curpstate = pstate;
+   #endif				/* MultiThread */
+
+   /*
+    * Relocate the names of the global variables.
+    */
+   for (dp = gnames; dp < egnames; dp++)
+      StrLoc(*dp) = strcons + (uword)StrLoc(*dp);
+
+   /*
+    * Scan the global variable array for procedures and fill in appropriate
+    *  addresses.
+    */
+   for (j = 0; j < n_globals; j++) {
+
+      if (globals[j].dword != D_Proc)
+         continue;
+
+      /*
+       * The second word of the descriptor for procedure variables tells
+       *  where the procedure is.  Negative values are used for built-in
+       *  procedures and positive values are used for Icon procedures.
+       */
+      i = IntVal(globals[j]);
+
+      if (i < 0) {
+         /*
+          * globals[j] points to a built-in function; call (bi_)strprc
+	  *  to look it up by name in the interpreter's table of built-in
+	  *  functions.
+          */
+	 if((BlkLoc(globals[j])= (union block *)bi_strprc(gnames+j,0)) == NULL)
+            globals[j] = nulldesc;		/* undefined, set to &null */
+         }
+      else {
+
+         /*
+          * globals[j] points to an Icon procedure or a record; i is an offset
+          *  to location of the procedure block in the code section.  Point
+          *  pp at the block and replace BlkLoc(globals[j]).
+          */
+         pp = (struct b_proc *)(code + i);
+         BlkLoc(globals[j]) = (union block *)pp;
+
+         /*
+          * Relocate the address of the name of the procedure.
+          */
+         StrLoc(pp->pname) = strcons + (uword)StrLoc(pp->pname);
+
+         if (pp->ndynam == -2) {
+            /*
+             * This procedure is a record constructor.	Make its entry point
+             *	be the entry point of Omkrec().
+             */
+            pp->entryp.ccode = Omkrec;
+
+	    /*
+	     * Initialize field names
+	     */
+            for (i = 0; i < pp->nfields; i++)
+               StrLoc(pp->lnames[i]) = strcons + (uword)StrLoc(pp->lnames[i]);
+
+	    }
+         else {
+            /*
+             * This is an Icon procedure.  Relocate the entry point and
+             *	the names of the parameters, locals, and static variables.
+             */
+            pp->entryp.icode = code + pp->entryp.ioff;
+            for (i = 0; i < abs((int)pp->nparam)+pp->ndynam+pp->nstatic; i++)
+               StrLoc(pp->lnames[i]) = strcons + (uword)StrLoc(pp->lnames[i]);
+            }
+         }
+      }
+
+   /*
+    * Relocate the names of the fields.
+    */
+
+   for (dp = fnames; dp < efnames; dp++)
+      StrLoc(*dp) = strcons + (uword)StrLoc(*dp);
+
+   #ifdef MultiThread
+      curpstate = savedstate;
+   #endif				/* MultiThread */
+   }
+
+#endif					/* !COMPILER */
diff --git a/src/runtime/imisc.r b/src/runtime/imisc.r
new file mode 100644
index 0000000..cde8a90
--- /dev/null
+++ b/src/runtime/imisc.r
@@ -0,0 +1,357 @@
+#if !COMPILER
+/*
+ * File: imisc.r
+ *  Contents: field, mkrec, limit, llist, bscan, escan
+ */
+
+/*
+ * x.y - access field y of record x.
+ */
+
+LibDcl(field,2,".")
+   {
+   register word fnum;
+   register struct b_record *rp;
+   register dptr dp;
+
+#ifdef MultiThread
+   register union block *bptr;
+#else					/* MultiThread */
+   extern int *ftabp;
+   #ifdef FieldTableCompression
+      extern int *fo;
+      extern unsigned char *focp;
+      extern short *fosp;
+      extern char *bm;
+   #endif				/* FieldTableCompression */
+   extern word *records;
+#endif					/* MultiThread */
+
+   Deref(Arg1);
+
+   /*
+    * Arg1 must be a record and Arg2 must be a field number.
+    */
+   if (!is:record(Arg1))
+      RunErr(107, &Arg1);
+   if (IntVal(Arg2) == -1)	/* if was known bad at ilink time */
+      RunErr(207, &Arg1);	/* was warning then, now it's fatal */
+
+   /*
+    * Map the field number into a field number for the record x.
+    */
+   rp = (struct b_record *) BlkLoc(Arg1);
+
+#ifdef MultiThread
+   bptr = rp->recdesc;
+   if (!InRange(curpstate->Records, bptr, curpstate->Ftabp)) {
+      int i;
+      int nfields = bptr->proc.nfields;
+      /*
+       * Look up the field number by a brute force search through
+       * the record constructor's field names.
+       */
+      Arg0 = fnames[IntVal(Arg2)];
+      fprintf(stderr,"looking up interprogram field %.*s\n", StrLen(Arg0),
+         StrLoc(Arg0));
+      for (i=0;i<nfields;i++){
+	 if ((StrLen(Arg0) == StrLen(bptr->proc.lnames[i])) &&
+	     !strncmp(StrLoc(Arg0), StrLoc(bptr->proc.lnames[i]),StrLen(Arg0)))
+	   break;
+         }
+      if (i<nfields) fnum = i;
+      else fnum = -1;
+      }
+   else
+#endif					/* MultiThread */
+
+#ifdef FieldTableCompression
+#define FO(i) ((foffwidth==1)?focp[i]:((foffwidth==2)?fosp[i]:fo[i]))
+#define FTAB(i) ((ftabwidth==1)?ftabcp[i]:((ftabwidth==2)?ftabsp[i]:ftabp[i]))
+#else					/* FieldTableCompression */
+#define FO(i) fo[i]
+#define FTAB(i) ftabp[i]
+#endif					/* FieldTableCompression */
+
+#ifdef FieldTableCompression
+      fnum = FTAB(FO(IntVal(Arg2)) + (rp->recdesc->proc.recnum - 1));
+#else					/* FieldTableCompression */
+      fnum = FTAB(IntVal(Arg2) * *records + rp->recdesc->proc.recnum - 1);
+#endif					/* FieldTableCompression */
+
+   /*
+    * If fnum < 0, x doesn't contain the specified field.
+    */
+
+#ifdef FieldTableCompression
+{
+   int bytes, index;
+   unsigned char this_bit = 0200;
+
+   bytes = *records >> 3;
+   if ((*records & 07) != 0)
+      bytes++;
+   index = IntVal(Arg2) * bytes + (rp->recdesc->proc.recnum - 1) / 8;
+   this_bit = this_bit >> (rp->recdesc->proc.recnum - 1) % 8;
+   if ((bm[index] | this_bit) != bm[index])
+      RunErr(207, &Arg1);
+}
+
+   if (ftabwidth == 1) {
+      if (fnum == 255)
+         RunErr(207, &Arg1);
+      }
+   else
+#endif					/* FieldTableCompression */
+   if (fnum < 0)
+      RunErr(207, &Arg1);
+
+   EVValD(&Arg1, E_Rref);
+   EVVal(fnum + 1, E_Rsub);
+
+   /*
+    * Return a pointer to the descriptor for the appropriate field.
+    */
+   dp = &rp->fields[fnum];
+   Arg0.dword = D_Var + ((word *)dp - (word *)rp);
+   VarLoc(Arg0) = (dptr)rp;
+   Return;
+   }
+
+
+/*
+ * mkrec - create a record.
+ */
+
+LibDcl(mkrec,-1,"mkrec")
+   {
+   register int i;
+   register struct b_proc *bp;
+   register struct b_record *rp;
+
+   /*
+    * Be sure that call is from a procedure.
+    */
+
+   /*
+    * Get a pointer to the record constructor procedure and allocate
+    *  a record with the appropriate number of fields.
+    */
+   bp = (struct b_proc *) BlkLoc(Arg0);
+   Protect(rp = alcrecd((int)bp->nfields, (union block *)bp), RunErr(0,NULL));
+
+   /*
+    * Set all fields in the new record to null value.
+    */
+   for (i = (int)bp->nfields; i > nargs; i--)
+      rp->fields[i-1] = nulldesc;
+
+   /*
+    * Assign each argument value to a record element and dereference it.
+    */
+   for ( ; i > 0; i--) {
+      rp->fields[i-1] = cargp[i]; /* Arg(i), expanded to avoid CLCC bug on Sun*/
+      Deref(rp->fields[i-1]);
+      }
+
+   ArgType(0) = D_Record;
+   Arg0.vword.bptr = (union block *)rp;
+   EVValD(&Arg0, E_Rcreate);
+   Return;
+   }
+
+/*
+ * limit - explicit limitation initialization.
+ */
+
+
+LibDcl(limit,2,"\\")
+   {
+
+   C_integer tmp;
+
+   /*
+    * The limit is both passed and returned in Arg0.  The limit must
+    *  be an integer.  If the limit is 0, the expression being evaluated
+    *  fails.  If the limit is < 0, it is an error.  Note that the
+    *  result produced by limit is ultimately picked up by the lsusp
+    *  function.
+    */
+   Deref(Arg0);
+
+   if (!cnv:C_integer(Arg0,tmp))
+      RunErr(101, &Arg0);
+   MakeInt(tmp,&Arg0);
+
+   if (IntVal(Arg0) < 0)
+      RunErr(205, &Arg0);
+   if (IntVal(Arg0) == 0)
+      Fail;
+   Return;
+   }
+
+/*
+ * bscan - set &subject and &pos upon entry to a scanning expression.
+ *
+ *  Arguments are:
+ *	Arg0 - new value for &subject
+ *	Arg1 - saved value of &subject
+ *	Arg2 - saved value of &pos
+ *
+ * A variable pointing to the saved &subject and &pos is returned to be
+ *  used by escan.
+ */
+
+LibDcl(bscan,2,"?")
+   {
+   int rc;
+   struct pf_marker *cur_pfp;
+
+   /*
+    * Convert the new value for &subject to a string.
+    */
+   Deref(Arg0);
+
+   if (!cnv:string(Arg0,Arg0))
+      RunErr(103, &Arg0);
+
+   EVValD(&Arg0, E_Snew);
+
+   /*
+    * Establish a new &subject value and set &pos to 1.
+    */
+   k_subject = Arg0;
+   k_pos = 1;
+
+   /* If the saved scanning environment belongs to the current procedure
+    *  call, put a reference to it in the procedure frame.
+    */
+   if (pfp->pf_scan == NULL)
+      pfp->pf_scan = &Arg1;
+   cur_pfp = pfp;
+
+   /*
+    * Suspend with a variable pointing to the saved &subject and &pos.
+    */
+   ArgType(0) = D_Var;
+   VarLoc(Arg0) = &Arg1;
+
+   rc = interp(G_Csusp,cargp);
+
+#ifdef EventMon
+   if (rc != A_Resume)
+      EVValD(&Arg1, E_Srem);
+   else
+      EVValD(&Arg1, E_Sfail);
+#endif					/* EventMon */
+
+   if (pfp != cur_pfp)
+      return rc;
+
+   /*
+    * Leaving scanning environment. Restore the old &subject and &pos values.
+    */
+   k_subject = Arg1;
+   k_pos = IntVal(Arg2);
+
+   if (pfp->pf_scan == &Arg1)
+      pfp->pf_scan = NULL;
+
+   return rc;
+
+   }
+
+/*
+ * escan - restore &subject and &pos at the end of a scanning expression.
+ *
+ *  Arguments:
+ *    Arg0 - variable pointing to old values of &subject and &pos
+ *    Arg1 - result of the scanning expression
+ *
+ * The two arguments are reversed, so that the result of the scanning
+ *  expression becomes the result of escan. This result is dereferenced
+ *  if it refers to &subject or &pos. Then the saved values of &subject
+ *  and &pos are exchanged with the current ones.
+ *
+ * Escan suspends once it has restored the old &subject; on failure
+ *  the new &subject and &pos are "unrestored", and the failure is
+ *  propagated into the using clause.
+ */
+
+LibDcl(escan,1,"escan")
+   {
+   struct descrip tmp;
+   int rc;
+   struct pf_marker *cur_pfp;
+
+   /*
+    * Copy the result of the scanning expression into Arg0, which will
+    *  be the result of the scan.
+    */
+   tmp = Arg0;
+   Arg0 = Arg1;
+   Arg1 = tmp;
+
+   /*
+    * If the result of the scanning expression is &subject or &pos,
+    *  it is dereferenced. #%#%  following is incorrect #%#%
+    */
+   /*if ((Arg0 == k_subject) ||
+      (Arg0 == kywd_pos))
+         Deref(Arg0); */
+
+   /*
+    * Swap new and old values of &subject
+    */
+   tmp = k_subject;
+   k_subject = *VarLoc(Arg1);
+   *VarLoc(Arg1) = tmp;
+
+   /*
+    * Swap new and old values of &pos
+    */
+   tmp = *(VarLoc(Arg1) + 1);
+   IntVal(*(VarLoc(Arg1) + 1)) = k_pos;
+   k_pos = IntVal(tmp);
+
+   /*
+    * If we are returning to the scanning environment of the current
+    *  procedure call, indicate that it is no longed in a saved state.
+    */
+   if (pfp->pf_scan == VarLoc(Arg1))
+      pfp->pf_scan = NULL;
+   cur_pfp = pfp;
+
+   /*
+    * Suspend with the value of the scanning expression.
+    */
+
+   EVValD(&k_subject, E_Ssusp);
+
+   rc = interp(G_Csusp,cargp);
+   if (pfp != cur_pfp)
+      return rc;
+
+   /*
+    * Re-entering scanning environment, exchange the values of &subject
+    *  and &pos again
+    */
+   tmp = k_subject;
+   k_subject = *VarLoc(Arg1);
+   *VarLoc(Arg1) = tmp;
+
+#ifdef EventMon
+   if (rc == A_Resume)
+      EVValD(&k_subject, E_Sresum);
+#endif					/* EventMon */
+
+   tmp = *(VarLoc(Arg1) + 1);
+   IntVal(*(VarLoc(Arg1) + 1)) = k_pos;
+   k_pos = IntVal(tmp);
+
+   if (pfp->pf_scan == NULL)
+      pfp->pf_scan = VarLoc(Arg1);
+
+   return rc;
+   }
+#endif					/* !COMPILER */
diff --git a/src/runtime/init.r b/src/runtime/init.r
new file mode 100644
index 0000000..248bda8
--- /dev/null
+++ b/src/runtime/init.r
@@ -0,0 +1,1118 @@
+/*
+ * File: init.r
+ * Initialization, termination, and such.
+ * Contents: readhdr, init/icon_init, envset, env_err, env_int,
+ *  fpe_trap, inttrag, segvtrap, error, syserr, c_exit, err,
+ *  fatalerr, pstrnmcmp, datainit, [loadicode, savepstate, loadpstate]
+ */
+
+static void	env_err		(char *msg, char *name, char *val);
+FILE		*pathOpen       (char *fname, char *mode);
+
+#if !COMPILER
+   #include "../h/header.h"
+   static FILE *readhdr(char *name, struct header *hdr);
+
+   #passthru #define OpDef(p,n,s,u) int Cat(O,p) (dptr cargp);
+   #passthru #include "../h/odefs.h"
+   #passthru #undef OpDef
+
+   /*
+    * External declarations for operator blocks.
+    */
+
+   #passthru #define OpDef(f,nargs,sname,underef)\
+	{\
+	T_Proc,\
+	Vsizeof(struct b_proc),\
+	Cat(O,f),\
+	nargs,\
+	-1,\
+	underef,\
+	0,\
+	{{sizeof(sname)-1,sname}}},
+   #passthru static B_IProc(2) init_op_tbl[] = {
+   #passthru #include "../h/odefs.h"
+   #passthru   };
+   #undef OpDef
+#endif					/* !COMPILER */
+
+#ifdef WinGraphics
+   static void MSStartup(HINSTANCE hInstance, HINSTANCE hPrevInstance);
+#endif					/* WinGraphics */
+
+/*
+ * A number of important variables follow.
+ */
+
+char *prog_name;		/* name of icode file */
+
+int line_info;			/* flag: line information is available */
+char *file_name = NULL;		/* source file for current execution point */
+int line_num = 0;		/* line number for current execution point */
+struct b_proc *op_tbl;		/* operators available for string invocation */
+
+extern struct errtab errtab[];	/* error numbers and messages */
+
+word mstksize = MStackSize;	/* initial size of main stack */
+word stksize = StackSize;	/* co-expression stack size */
+
+int k_level = 0;		/* &level */
+
+#ifndef MultiThread
+   struct descrip k_main;	/* &main */
+#endif					/* MultiThread */
+
+int ixinited = 0;		/* set-up switch */
+
+char *currend = NULL;		/* current end of memory region */
+
+
+word qualsize = QualLstSize;	/* size of quallist for fixed regions */
+
+word memcushion = RegionCushion;  /* memory region cushion factor */
+word memgrowth = RegionGrowth;	  /* memory region growth factor */
+
+uword stattotal = 0;		/* cumulative total static allocation */
+#ifndef MultiThread
+   uword strtotal = 0;		/* cumulative total string allocation */
+   uword blktotal = 0;		/* cumulative total block allocation */
+#endif					/* MultiThread */
+
+int dodump;			/* if nonzero, core dump on error */
+int noerrbuf;			/* if nonzero, do not buffer stderr */
+
+struct descrip maps2;		/* second cached argument of map */
+struct descrip maps3;		/* third cached argument of map */
+
+#ifndef MultiThread
+   struct descrip k_current;	/* current expression stack pointer */
+   int k_errornumber = 0;	/* &errornumber */
+   char *k_errortext = "";	/* &errortext */
+   struct descrip k_errorvalue;	/* &errorvalue */
+   int have_errval = 0;		/* &errorvalue has legal value */
+   int t_errornumber = 0;	/* tentative k_errornumber value */
+   int t_have_val = 0;		/* tentative have_errval flag */
+   struct descrip t_errorvalue;	/* tentative k_errorvalue value */
+#endif					/* MultiThread */
+
+struct b_coexpr *stklist;	/* base of co-expression block list */
+
+struct tend_desc *tend = NULL;  /* chain of tended descriptors */
+
+struct region rootstring, rootblock;
+
+#ifndef MultiThread
+   dptr glbl_argp = NULL;	/* argument pointer */
+   dptr globals, eglobals;	/* pointer to global variables */
+   dptr gnames, egnames;	/* pointer to global variable names */
+   dptr estatics;		/* pointer to end of static variables */
+   struct region *curstring, *curblock;
+   #if !COMPILER
+      int n_globals = 0;	/* number of globals */
+      int n_statics = 0;	/* number of statics */
+   #endif				/* !COMPILER */
+#endif					/* MultiThread */
+
+#if COMPILER
+   struct p_frame *pfp = NULL;	/* procedure frame pointer */
+
+   int debug_info;		/* flag: is debugging information available */
+   int err_conv;		/* flag: is error conversion supported */
+   int largeints;		/* flag: large integers are supported */
+
+   struct b_coexpr *mainhead;	/* &main */
+
+#else					/* COMPILER */
+
+   int debug_info=1;		/* flag: debugging information IS available */
+   int err_conv=1;		/* flag: error conversion IS supported */
+
+   int op_tbl_sz = (sizeof(init_op_tbl) / sizeof(struct b_proc));
+   struct pf_marker *pfp = NULL;  /* Procedure frame pointer */
+
+   #ifdef MultiThread
+      struct progstate *curpstate;  /* lastop accessed in program state */
+      struct progstate rootpstate;
+   #else				/* MultiThread */
+
+      struct b_coexpr *mainhead;  /* &main */
+
+      char *code;		/* interpreter code buffer */
+      char *ecode;		/* end of interpreter code buffer */
+      word *records;		/* pointer to record procedure blocks */
+
+      int *ftabp;		/* pointer to record/field table */
+
+      #ifdef FieldTableCompression
+         word ftabwidth;		/* field table entry width */
+         word foffwidth;		/* field offset entry width */
+         unsigned char *ftabcp, *focp;	/* pointers to record/field table */
+         short *ftabsp, *fosp;		/* pointers to record/field table */
+
+         int *fo;		/* field offset (row in field table) */
+         char *bm;		/* bitmap array of valid field bits */
+      #endif				/* FieldTableCompression */
+
+      dptr fnames, efnames;	/* pointer to field names */
+      dptr statics;		/* pointer to static variables */
+      char *strcons;		/* pointer to string constant table */
+      struct ipc_fname *filenms, *efilenms; /* pointer to ipc/file name table */
+      struct ipc_line *ilines, *elines;	/* pointer to ipc/line number table */
+   #endif				/* MultiThread */
+
+   #ifdef TallyOpt
+      word tallybin[16];	/* counters for tallying */
+      int tallyopt = 0;		/* want tally results output? */
+   #endif				/* TallyOpt */
+
+   word *stack;			/* Interpreter stack */
+   word *stackend;		/* End of interpreter stack */
+
+#endif					/* COMPILER */
+
+#if !COMPILER
+
+/*
+ * Open the icode file and read the header.
+ * Used by icon_init() as well as MultiThread's loadicode()
+ */
+static FILE *readhdr(name,hdr)
+char *name;
+struct header *hdr;
+   {
+   FILE *fname = NULL;
+   int n;
+   struct fileparts fp;
+
+   if (!name)
+      error(name, "No interpreter file supplied");
+
+   /*
+    * Try adding the suffix if the file name doesn't end in it.
+    */
+   n = strlen(name);
+   fp = *fparse(name);
+
+   if ( IcodeSuffix[0] != '\0' && strcmp(fp.ext,IcodeSuffix) != 0
+   && ( IcodeASuffix[0] == '\0' || strcmp(fp.ext,IcodeASuffix) != 0 ) ) {
+      char tname[100], ext[50];
+      if (n + strlen(IcodeSuffix) + 1 > 100)
+	 error(name, "icode file name too long");
+      strcpy(ext,fp.ext);
+      strcat(ext,IcodeSuffix);
+      makename(tname,NULL,name,ext);
+
+      #if MSWIN
+	  fname = pathOpen(tname,"rb");	/* try to find path */
+      #else				/* MSWIN */
+	  fname = fopen(tname, "rb");
+      #endif				/* MSWIN */
+
+      }
+
+   if (fname == NULL)			/* try the name as given */
+      #if MSWIN
+         fname = pathOpen(name, "rb");
+      #else				/* MSWIN */
+         fname = fopen(name, "rb");
+      #endif				/* MSWIN */
+
+   if (fname == NULL)
+      return NULL;
+
+   {
+   static char errmsg[] = "can't read interpreter file header";
+
+#ifdef BinaryHeader
+   if (fseek(fname, (long)MaxHdr, 0) == -1)
+      error(name, errmsg);
+#else					/* BinaryHeader */
+   char buf[200];
+
+   for (;;) {
+      if (fgets(buf, sizeof buf-1, fname) == NULL)
+	 error(name, errmsg);
+         if (strncmp(buf, "[executable Icon binary follows]", 32) == 0)
+            break;
+      }
+
+   while ((n = getc(fname)) != EOF && n != '\f')	/* read thru \f\n\0 */
+      ;
+   getc(fname);
+   getc(fname);
+#endif					/* BinaryHeader */
+
+   if (fread((char *)hdr, sizeof(char), sizeof(*hdr), fname) != sizeof(*hdr))
+      error(name, errmsg);
+   }
+
+   return fname;
+   }
+
+#endif					/* !COMPILER */
+
+/*
+ * init/icon_init - initialize memory and prepare for Icon execution.
+ */
+#if !COMPILER
+   struct header hdr;
+#endif					/* !COMPILER */
+
+#if COMPILER
+   void init(name, argcp, argv, trc_init)
+   char *name;
+   int *argcp;
+   char *argv[];
+   int trc_init;
+#else					/* COMPILER */
+   void icon_init(name, argcp, argv)
+   char *name;
+   int *argcp;
+   char *argv[];
+#endif					/* COMPILER */
+
+   {
+   int delete_icode = 0;
+#if !COMPILER
+   FILE *fname = NULL;
+   word cbread, longread();
+#endif					/* COMPILER */
+
+   prog_name = name;			/* Set icode file name */
+
+#ifdef WinGraphics
+   {
+   STARTUPINFO si;
+
+   /*
+    * Initialize windows stuff.
+    */
+   GetStartupInfo(&si);
+   ncmdShow = si.wShowWindow;
+   if ( ncmdShow == SW_HIDE )
+      /* Started from command line, show normal windows in this case. */
+      ncmdShow = SW_SHOWNORMAL;
+   mswinInstance = GetModuleHandle( NULL );
+   MSStartup( mswinInstance, NULL );
+   }
+#endif					/* WinGraphics */
+
+   /*
+    * Look for environment variable ICODE_TEMP=xxxxx:yyyyy as a message
+    * from icont to delete icode file xxxxx and to use yyyyy for &progname.
+    * (This is used with Unix "#!" script files written in Icon.)
+    */
+   {
+      char *itval = getenv("ICODE_TEMP");
+      int nlen = strlen(name);
+      if (itval != NULL && itval[nlen] == ':' && strncmp(name,itval,nlen)==0) {
+         delete_icode = 1;
+         prog_name = itval + nlen + 1;
+         }
+      }
+
+#if COMPILER
+   curstring = &rootstring;
+   curblock  = &rootblock;
+   rootstring.size = MaxStrSpace;
+   rootblock.size  = MaxAbrSize;
+#else					/* COMPILER */
+
+#ifdef MultiThread
+   /*
+    * initialize root pstate
+    */
+   curpstate = &rootpstate;
+   rootpstate.parentdesc = nulldesc;
+   rootpstate.eventmask= nulldesc;
+   rootpstate.opcodemask = nulldesc;
+   rootpstate.eventcode= nulldesc;
+   rootpstate.eventval = nulldesc;
+   rootpstate.eventsource = nulldesc;
+   rootpstate.Glbl_argp = NULL;
+   MakeInt(0, &(rootpstate.Kywd_err));
+   MakeInt(1, &(rootpstate.Kywd_pos));
+   StrLen(rootpstate.ksub) = 0;
+   StrLoc(rootpstate.ksub) = "";
+   MakeInt(hdr.trace, &(rootpstate.Kywd_trc));
+   StrLen(rootpstate.Kywd_prog) = strlen(prog_name);
+   StrLoc(rootpstate.Kywd_prog) = prog_name;
+   MakeInt(0, &(rootpstate.Kywd_ran));
+   rootpstate.K_errornumber = 0;
+   rootpstate.T_errornumber = 0;
+   rootpstate.Have_errval = 0;
+   rootpstate.T_have_val = 0;
+   rootpstate.K_errortext = "";
+   rootpstate.K_errorvalue = nulldesc;
+   rootpstate.T_errorvalue = nulldesc;
+
+#ifdef Graphics
+   MakeInt(0,&(rootpstate.AmperX));
+   MakeInt(0,&(rootpstate.AmperY));
+   MakeInt(0,&(rootpstate.AmperRow));
+   MakeInt(0,&(rootpstate.AmperCol));
+   MakeInt(0,&(rootpstate.AmperInterval));
+   rootpstate.LastEventWin = nulldesc;
+   rootpstate.Kywd_xwin[XKey_Window] = nulldesc;
+#endif					/* Graphics */
+
+   rootpstate.Coexp_ser = 2;
+   rootpstate.List_ser  = 1;
+   rootpstate.Set_ser   = 1;
+   rootpstate.Table_ser = 1;
+   rootpstate.stringregion = &rootstring;
+   rootpstate.blockregion = &rootblock;
+
+#else					/* MultiThread */
+
+   curstring = &rootstring;
+   curblock  = &rootblock;
+#endif					/* MultiThread */
+
+   rootstring.size = MaxStrSpace;
+   rootblock.size  = MaxAbrSize;
+#endif					/* COMPILER */
+
+#if !COMPILER
+   op_tbl = (struct b_proc*)init_op_tbl;
+#endif					/* !COMPILER */
+
+#ifdef Double
+   if (sizeof(struct size_dbl) != sizeof(double))
+      syserr("Icon configuration does not handle double alignment");
+#endif					/* Double */
+
+   /*
+    * Catch floating-point traps and memory faults.
+    */
+   signal(SIGFPE, fpetrap);
+   signal(SIGSEGV, segvtrap);
+
+   /*
+    * Initialize data that can't be initialized statically.
+    */
+
+   datainit();
+
+   #if COMPILER
+      IntVal(kywd_trc) = trc_init;
+   #else				/* COMPILER */
+      fname = readhdr(name,&hdr);
+      if (fname == NULL)
+         error(name, "cannot open interpreter file");
+      k_trace = hdr.trace;
+   #endif				/* COMPILER */
+
+   /*
+    * Examine the environment and make appropriate settings.    [[I?]]
+    */
+   envset();
+
+   /*
+    * Convert stack sizes from words to bytes.
+    */
+   stksize *= WordSize;
+   mstksize *= WordSize;
+
+   /*
+    * Allocate memory for various regions.
+    */
+#if COMPILER
+   initalloc();
+#else					/* COMPILER */
+#ifdef MultiThread
+   initalloc(hdr.hsize,&rootpstate);
+#else					/* MultiThread */
+   initalloc(hdr.hsize);
+#endif					/* MultiThread */
+#endif					/* COMPILER */
+
+#if !COMPILER
+   /*
+    * Establish pointers to icode data regions.		[[I?]]
+    */
+   ecode = code + hdr.Records;
+   records = (word *)ecode;
+   ftabp = (int *)(code + hdr.Ftab);
+#ifdef FieldTableCompression
+   fo = (int *)(code + hdr.Fo);
+   focp = (unsigned char *)(fo);
+   fosp = (short *)(fo);
+   if (hdr.FoffWidth == 1) {
+      bm = (char *)(focp + hdr.Nfields);
+      }
+   else if (hdr.FoffWidth == 2) {
+      bm = (char *)(fosp + hdr.Nfields);
+      }
+   else
+      bm = (char *)(fo + hdr.Nfields);
+
+   ftabwidth = hdr.FtabWidth;
+   foffwidth = hdr.FoffWidth;
+   ftabcp = (unsigned char *)(code + hdr.Ftab);
+   ftabsp = (short *)(code + hdr.Ftab);
+#endif					/* FieldTableCompression */
+   fnames = (dptr)(code + hdr.Fnames);
+   globals = efnames = (dptr)(code + hdr.Globals);
+   gnames = eglobals = (dptr)(code + hdr.Gnames);
+   statics = egnames = (dptr)(code + hdr.Statics);
+   estatics = (dptr)(code + hdr.Filenms);
+   filenms = (struct ipc_fname *)estatics;
+   efilenms = (struct ipc_fname *)(code + hdr.linenums);
+   ilines = (struct ipc_line *)efilenms;
+   elines = (struct ipc_line *)(code + hdr.Strcons);
+   strcons = (char *)elines;
+   n_globals = eglobals - globals;
+   n_statics = estatics - statics;
+#endif					/* COMPILER */
+
+   /*
+    * Allocate stack and initialize &main.
+    */
+
+#if COMPILER
+   mainhead = (struct b_coexpr *)malloc(sizeof(struct b_coexpr));
+#else					/* COMPILER */
+   stack = (word *)malloc(mstksize);
+   mainhead = (struct b_coexpr *)stack;
+
+#endif					/* COMPILER */
+
+   if (mainhead == NULL)
+#if COMPILER
+      err_msg(305, NULL);
+#else					/* COMPILER */
+      fatalerr(303, NULL);
+#endif					/* COMPILER */
+
+   mainhead->title = T_Coexpr;
+   mainhead->id = 1;
+   mainhead->size = 1;			/* pretend main() does an activation */
+   mainhead->nextstk = NULL;
+   mainhead->es_tend = NULL;
+   mainhead->freshblk = nulldesc;	/* &main has no refresh block. */
+					/*  This really is a bug. */
+#ifdef MultiThread
+   mainhead->program = &rootpstate;
+#endif					/* MultiThread */
+#if COMPILER
+   mainhead->file_name = "";
+   mainhead->line_num = 0;
+#endif					/* COMPILER */
+
+#ifdef Coexpr
+   Protect(mainhead->es_actstk = alcactiv(), fatalerr(0,NULL));
+   pushact(mainhead, mainhead);
+#endif					/* Coexpr */
+
+   /*
+    * Point &main at the co-expression block for the main procedure and set
+    *  k_current, the pointer to the current co-expression, to &main.
+    */
+   k_main.dword = D_Coexpr;
+   BlkLoc(k_main) = (union block *) mainhead;
+   k_current = k_main;
+
+#if !COMPILER
+   /*
+    * Read the interpretable code and data into memory.
+    */
+   if ((cbread = longread(code, sizeof(char), (long)hdr.hsize, fname)) !=
+      hdr.hsize) {
+      fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
+	(long)hdr.hsize,(long)cbread);
+      error(name, "bad icode file");
+      }
+   fclose(fname);
+   if (delete_icode)		/* delete icode file if flag set earlier */
+      remove(name);
+
+/*
+ * Make sure the version number of the icode matches the interpreter version.
+ */
+   if (strcmp((char *)hdr.config,IVersion)) {
+      fprintf(stderr,"icode version mismatch in %s\n", name);
+      fprintf(stderr,"\ticode version: %s\n",(char *)hdr.config);
+      fprintf(stderr,"\texpected version: %s\n",IVersion);
+      error(name, "cannot run");
+      }
+#endif					/* !COMPILER */
+
+   /*
+    * Initialize the event monitoring system, if configured.
+    */
+
+#ifdef EventMon
+   EVInit();
+#endif					/* EventMon */
+
+#if !COMPILER
+   /*
+    * Resolve references from icode to run-time system.
+    */
+#ifdef MultiThread
+   resolve(NULL);
+#else					/* MultiThread */
+   resolve();
+#endif					/* MultiThread */
+#endif					/* COMPILER */
+
+   /*
+    * Allocate and assign a buffer to stderr if possible.
+    */
+   if (noerrbuf)
+      setbuf(stderr, NULL);
+   else {
+      void *buf = malloc(BUFSIZ);
+      if (buf == NULL)
+         fatalerr(305, NULL);
+      setbuf(stderr, buf);
+      }
+
+   /*
+    * Start timing execution.
+    */
+   millisec();
+   }
+
+/*
+ * Service routines related to getting things started.
+ */
+
+
+/*
+ * Check for environment variables that Icon uses and set system
+ *  values as is appropriate.
+ */
+void envset()
+   {
+   register char *p;
+
+   if ((p = getenv("NOERRBUF")) != NULL)
+      noerrbuf++;
+   env_int("TRACE", &k_trace, 0, (uword)0);
+   env_int("COEXPSIZE", &stksize, 1, (uword)MaxUnsigned);
+   env_int("STRSIZE", &ssize, 1, (uword)MaxBlock);
+   env_int("BLKSIZE", &abrsize, 1, (uword)MaxBlock);
+   env_int("MSTKSIZE", &mstksize, 1, (uword)MaxUnsigned);
+   env_int("QLSIZE", &qualsize, 1, (uword)MaxBlock);
+   env_int("IXCUSHION", &memcushion, 1, (uword)100);	/* max 100 % */
+   env_int("IXGROWTH", &memgrowth, 1, (uword)10000);	/* max 100x growth */
+
+   if ((p = getenv("ICONCORE")) != NULL && *p != '\0') {
+      /*
+       * ICONCORE is set.  Reset traps to allow dump after abnormal termination.
+       */
+      dodump++;
+      signal(SIGFPE, SIG_DFL);
+      signal(SIGSEGV, SIG_DFL);
+      }
+   }
+
+/*
+ * env_err - print an error mesage about the value of an environment
+ *  variable.
+ */
+static void env_err(msg, name, val)
+char *msg;
+char *name;
+char *val;
+{
+   char msg_buf[100];
+
+   strncpy(msg_buf, msg, 99);
+   strncat(msg_buf, ": ", 99 - (int)strlen(msg_buf));
+   strncat(msg_buf, name, 99 - (int)strlen(msg_buf));
+   strncat(msg_buf, "=", 99 - (int)strlen(msg_buf));
+   strncat(msg_buf, val, 99 - (int)strlen(msg_buf));
+   error("", msg_buf);
+}
+
+/*
+ * env_int - get the value of an integer-valued environment variable.
+ */
+void env_int(name, variable, non_neg, limit)
+char *name;
+word *variable;
+int non_neg;
+uword limit;
+{
+   char *value;
+   char *s;
+   register uword n = 0;
+   register uword d;
+   int sign = 1;
+
+   if ((value = getenv(name)) == NULL || *value == '\0')
+      return;
+
+   s = value;
+   if (*s == '-') {
+      if (non_neg)
+	 env_err("environment variable out of range", name, value);
+      sign = -1;
+      ++s;
+      }
+   else if (*s == '+')
+      ++s;
+   while (isdigit(*s)) {
+      d = *s++ - '0';
+      /*
+       * See if 10 * n + d > limit, but do it so there can be no overflow.
+       */
+      if ((d > (uword)(limit / 10 - n) * 10 + limit % 10) && (limit > 0))
+	 env_err("environment variable out of range", name, value);
+      n = n * 10 + d;
+      }
+   if (*s != '\0')
+      env_err("environment variable not numeric", name, value);
+   *variable = sign * n;
+}
+
+/*
+ * Termination routines.
+ */
+
+/*
+ * Produce run-time error 204 on floating-point traps.
+ */
+
+void fpetrap(int sig)
+   {
+   fatalerr(204, NULL);
+   }
+
+/*
+ * Produce run-time error 302 on segmentation faults.
+ */
+void segvtrap(int sig)
+   {
+   static int n = 0;
+
+   if (n != 0) {			/* only try traceback once */
+      fprintf(stderr, "[Traceback failed]\n");
+      exit(1);
+      }
+   n++;
+   fatalerr(302, NULL);
+   exit(1);
+   }
+
+/*
+ * error - print error message from s1 and s2; used only in startup code.
+ */
+void error(s1, s2)
+char *s1, *s2;
+   {
+   if (!s1)
+      fprintf(stderr, "error in startup code\n%s\n", s2);
+   else
+      fprintf(stderr, "error in startup code\n%s: %s\n", s1, s2);
+   fflush(stderr);
+   if (dodump)
+      abort();
+   c_exit(EXIT_FAILURE);
+   }
+
+/*
+ * syserr - print s as a system error.
+ */
+void syserr(s)
+char *s;
+   {
+   fprintf(stderr, "System error");
+   if (pfp == NULL)
+      fprintf(stderr, " in startup code");
+   else {
+#if COMPILER
+      if (line_info)
+	 fprintf(stderr, " at line %d in %s", line_num, file_name);
+#else					/* COMPILER */
+      fprintf(stderr, " at line %ld in %s", (long)findline(ipc.opnd),
+	 findfile(ipc.opnd));
+#endif					/* COMPILER */
+      }
+   fprintf(stderr, "\n%s\n", s);
+   fflush(stderr);
+   if (dodump)
+      abort();
+   c_exit(EXIT_FAILURE);
+   }
+
+/*
+ * c_exit(i) - flush all buffers and exit with status i.
+ */
+void c_exit(i)
+int i;
+{
+
+#ifdef EventMon
+   if (curpstate != NULL) {
+      EVVal((word)i, E_Exit);
+      }
+#endif					/* EventMon */
+
+#ifdef MultiThread
+   if (curpstate != NULL && curpstate->parent != NULL) {
+      /* might want to get to the lterm somehow, instead */
+      while (1) {
+	 struct descrip dummy;
+	 co_chng(curpstate->parent->Mainhead, NULL, &dummy, A_Cofail, 1);
+	 }
+      }
+#endif					/* MultiThread */
+
+#ifdef TallyOpt
+   {
+   int j;
+
+   if (tallyopt) {
+      fprintf(stderr,"tallies: ");
+      for (j=0; j<16; j++)
+	 fprintf(stderr," %ld", (long)tallybin[j]);
+	 fprintf(stderr,"\n");
+	 }
+      }
+#endif					/* TallyOpt */
+
+   if (k_dump && ixinited) {
+      fprintf(stderr,"\nTermination dump:\n\n");
+      fflush(stderr);
+      fprintf(stderr,"co-expression #%ld(%ld)\n",
+	 (long)BlkLoc(k_current)->coexpr.id,
+	 (long)BlkLoc(k_current)->coexpr.size);
+      fflush(stderr);
+      xdisp(pfp,glbl_argp,k_level,stderr);
+      }
+
+   exit(i);
+
+}
+
+/*
+ * err() is called if an erroneous situation occurs in the virtual
+ *  machine code.  It is typed as int to avoid declaration problems
+ *  elsewhere.
+ */
+int err()
+{
+   syserr("call to 'err'\n");
+   return 1;		/* unreachable; make compilers happy */
+}
+
+/*
+ * fatalerr - disable error conversion and call run-time error routine.
+ */
+void fatalerr(n, v)
+int n;
+dptr v;
+   {
+   IntVal(kywd_err) = 0;
+   err_msg(n, v);
+   }
+
+/*
+ * pstrnmcmp - compare names in two pstrnm structs; used for qsort.
+ */
+int pstrnmcmp(a,b)
+struct pstrnm *a, *b;
+{
+  return strcmp(a->pstrep, b->pstrep);
+}
+
+/*
+ * datainit - initialize some global variables.
+ */
+void datainit()
+   {
+
+   /*
+    * Initializations that cannot be performed statically (at least for
+    * some compilers).					[[I?]]
+    */
+
+#ifdef MultiThread
+   k_errout.title = T_File;
+   k_input.title = T_File;
+   k_output.title = T_File;
+#endif					/* MultiThread */
+
+   k_errout.fd = stderr;
+   StrLen(k_errout.fname) = 7;
+   StrLoc(k_errout.fname) = "&errout";
+   k_errout.status = Fs_Write;
+
+   if (k_input.fd == NULL)
+      k_input.fd = stdin;
+   StrLen(k_input.fname) = 6;
+   StrLoc(k_input.fname) = "&input";
+   k_input.status = Fs_Read;
+
+   if (k_output.fd == NULL)
+      k_output.fd = stdout;
+   StrLen(k_output.fname) = 7;
+   StrLoc(k_output.fname) = "&output";
+   k_output.status = Fs_Write;
+
+   IntVal(kywd_pos) = 1;
+   IntVal(kywd_ran) = 0;
+   StrLen(kywd_prog) = strlen(prog_name);
+   StrLoc(kywd_prog) = prog_name;
+   StrLen(k_subject) = 0;
+   StrLoc(k_subject) = "";
+
+#ifdef MSwindows
+   if (i != EXIT_SUCCESS)
+   {
+      char exit_msg[40];
+
+      sprintf(exit_msg, "Terminated with exit code %d", i);
+      MessageBox(NULL, exit_msg, prog_name, MB_OK | MB_ICONSTOP);
+   }
+#endif					/* defined(MSwindows) */
+
+   StrLen(blank) = 1;
+   StrLoc(blank) = " ";
+   StrLen(emptystr) = 0;
+   StrLoc(emptystr) = "";
+   BlkLoc(nullptr) = (union block *)NULL;
+   StrLen(lcase) = 26;
+   StrLoc(lcase) = "abcdefghijklmnopqrstuvwxyz";
+   StrLen(letr) = 1;
+   StrLoc(letr) = "r";
+   IntVal(nulldesc) = 0;
+   k_errorvalue = nulldesc;
+   IntVal(onedesc) = 1;
+   StrLen(ucase) = 26;
+   StrLoc(ucase) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+   IntVal(zerodesc) = 0;
+
+#ifdef EventMon
+/*
+ *  Initialization needed for event monitoring
+ */
+
+   BlkLoc(csetdesc) = (union block *)&fullcs;
+   BlkLoc(rzerodesc) = (union block *)&realzero;
+
+#endif					/* EventMon */
+
+   maps2 = nulldesc;
+   maps3 = nulldesc;
+
+   #if !COMPILER
+      qsort((char *)pntab,pnsize,sizeof(struct pstrnm), (int(*)())pstrnmcmp);
+   #endif				/* COMPILER */
+
+   }
+
+#ifdef MultiThread
+/*
+ * loadicode - initialize memory particular to a given icode file
+ */
+struct b_coexpr * loadicode(name, theInput, theOutput, theError, bs, ss, stk)
+char *name;
+struct b_file *theInput, *theOutput, *theError;
+C_integer bs, ss, stk;
+   {
+   struct b_coexpr *coexp;
+   struct progstate *pstate;
+   struct header hdr;
+   FILE *fname = NULL;
+   word cbread, longread();
+
+   /*
+    * open the icode file and read the header
+    */
+   fname = readhdr(name,&hdr);
+   if (fname == NULL)
+      return NULL;
+
+   /*
+    * Allocate memory for icode and the struct that describes it
+    */
+     Protect(coexp = alccoexp(hdr.hsize, stk),
+      { fprintf(stderr,"can't malloc new icode region\n");c_exit(EXIT_FAILURE);});
+
+   pstate = coexp->program;
+   /*
+    * Initialize values.
+    */
+   pstate->hsize = hdr.hsize;
+   pstate->parent= NULL;
+   pstate->parentdesc= nulldesc;
+   pstate->opcodemask= nulldesc;
+   pstate->eventmask= nulldesc;
+   pstate->eventcode= nulldesc;
+   pstate->eventval = nulldesc;
+   pstate->eventsource = nulldesc;
+   pstate->K_current.dword = D_Coexpr;
+
+   MakeInt(0, &(pstate->Kywd_err));
+   MakeInt(1, &(pstate->Kywd_pos));
+   MakeInt(0, &(pstate->Kywd_ran));
+
+   StrLen(pstate->Kywd_prog) = strlen(prog_name);
+   StrLoc(pstate->Kywd_prog) = prog_name;
+   StrLen(pstate->ksub) = 0;
+   StrLoc(pstate->ksub) = "";
+   MakeInt(hdr.trace, &(pstate->Kywd_trc));
+
+#ifdef EventMon
+   pstate->Linenum = pstate->Column = pstate->Lastline = pstate->Lastcol = 0;
+#endif					/* EventMon */
+   pstate->Lastop = 0;
+   /*
+    * might want to override from TRACE environment variable here.
+    */
+
+   /*
+    * Establish pointers to icode data regions.		[[I?]]
+    */
+   pstate->Mainhead= ((struct b_coexpr *)pstate)-1;
+   pstate->K_main.dword = D_Coexpr;
+   BlkLoc(pstate->K_main) = (union block *) pstate->Mainhead;
+   pstate->Code    = (char *)(pstate + 1);
+   pstate->Ecode    = (char *)(pstate->Code + hdr.Records);
+   pstate->Records = (word *)(pstate->Code + hdr.Records);
+   pstate->Ftabp   = (int *)(pstate->Code + hdr.Ftab);
+#ifdef FieldTableCompression
+   pstate->Fo = (int *)(pstate->Code + hdr.Fo);
+   pstate->Focp =   (unsigned char *)(pstate->Fo);
+   pstate->Fosp =   (short *)(pstate->Fo);
+   pstate->Foffwidth = hdr.FoffWidth;
+   if (hdr.FoffWidth == 1) {
+      pstate->Bm = (char *)(pstate->Focp + hdr.Nfields);
+      }
+   else if (hdr.FoffWidth == 2) {
+      pstate->Bm = (char *)(pstate->Fosp + hdr.Nfields);
+      }
+   else
+      pstate->Bm = (char *)(pstate->Fo + hdr.Nfields);
+   pstate->Ftabwidth= hdr.FtabWidth;
+   pstate->Foffwidth = hdr.FoffWidth;
+   pstate->Ftabcp   = (unsigned char *)(pstate->Code + hdr.Ftab);
+   pstate->Ftabsp   = (short *)(pstate->Code + hdr.Ftab);
+#endif					/* FieldTableCompression */
+   pstate->Fnames  = (dptr)(pstate->Code + hdr.Fnames);
+   pstate->Globals = pstate->Efnames = (dptr)(pstate->Code + hdr.Globals);
+   pstate->Gnames  = pstate->Eglobals = (dptr)(pstate->Code + hdr.Gnames);
+   pstate->NGlobals = pstate->Eglobals - pstate->Globals;
+   pstate->Statics = pstate->Egnames = (dptr)(pstate->Code + hdr.Statics);
+   pstate->Estatics = (dptr)(pstate->Code + hdr.Filenms);
+   pstate->NStatics = pstate->Estatics - pstate->Statics;
+   pstate->Filenms = (struct ipc_fname *)(pstate->Estatics);
+   pstate->Efilenms = (struct ipc_fname *)(pstate->Code + hdr.linenums);
+   pstate->Ilines = (struct ipc_line *)(pstate->Efilenms);
+   pstate->Elines = (struct ipc_line *)(pstate->Code + hdr.Strcons);
+   pstate->Strcons = (char *)(pstate->Elines);
+   pstate->K_errornumber = 0;
+   pstate->T_errornumber = 0;
+   pstate->Have_errval = 0;
+   pstate->T_have_val = 0;
+   pstate->K_errortext = "";
+   pstate->K_errorvalue = nulldesc;
+   pstate->T_errorvalue = nulldesc;
+
+#ifdef Graphics
+   MakeInt(0, &(pstate->AmperX));
+   MakeInt(0, &(pstate->AmperY));
+   MakeInt(0, &(pstate->AmperRow));
+   MakeInt(0, &(pstate->AmperCol));
+   MakeInt(0, &(pstate->AmperInterval));
+   pstate->LastEventWin = nulldesc;
+   pstate->Kywd_xwin[XKey_Window] = nulldesc;
+#endif					/* Graphics */
+
+   pstate->Coexp_ser = 2;
+   pstate->List_ser = 1;
+   pstate->Set_ser = 1;
+   pstate->Table_ser = 1;
+
+   pstate->stringtotal = pstate->blocktotal =
+   pstate->colltot     = pstate->collstat   =
+   pstate->collstr     = pstate->collblk    = 0;
+
+   pstate->stringregion = (struct region *)malloc(sizeof(struct region));
+   pstate->blockregion  = (struct region *)malloc(sizeof(struct region));
+   pstate->stringregion->size = ss;
+   pstate->blockregion->size = bs;
+
+   /*
+    * the local program region list starts out with this region only
+    */
+   pstate->stringregion->prev = NULL;
+   pstate->blockregion->prev = NULL;
+   pstate->stringregion->next = NULL;
+   pstate->blockregion->next = NULL;
+   /*
+    * the global region list links this region with curpstate's
+    */
+   pstate->stringregion->Gprev = curpstate->stringregion;
+   pstate->blockregion->Gprev = curpstate->blockregion;
+   pstate->stringregion->Gnext = curpstate->stringregion->Gnext;
+   pstate->blockregion->Gnext = curpstate->blockregion->Gnext;
+   if (curpstate->stringregion->Gnext)
+      curpstate->stringregion->Gnext->Gprev = pstate->stringregion;
+   curpstate->stringregion->Gnext = pstate->stringregion;
+   if (curpstate->blockregion->Gnext)
+      curpstate->blockregion->Gnext->Gprev = pstate->blockregion;
+   curpstate->blockregion->Gnext = pstate->blockregion;
+   initalloc(0, pstate);
+
+   pstate->K_errout = *theError;
+   pstate->K_input  = *theInput;
+   pstate->K_output = *theOutput;
+
+   /*
+    * Read the interpretable code and data into memory.
+    */
+   if ((cbread = longread(pstate->Code, sizeof(char), (long)hdr.hsize, fname))
+       != hdr.hsize) {
+      fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
+	(long)hdr.hsize,(long)cbread);
+      error(name, "can't read interpreter code");
+      }
+   fclose(fname);
+
+   /*
+    * Make sure the version number of the icode matches the interpreter version
+    */
+   if (strcmp((char *)hdr.config,IVersion)) {
+      fprintf(stderr,"icode version mismatch in %s\n", name);
+      fprintf(stderr,"\ticode version: %s\n",(char *)hdr.config);
+      fprintf(stderr,"\texpected version: %s\n",IVersion);
+      error(name, "cannot run");
+      }
+
+   /*
+    * Resolve references from icode to run-time system.
+    * The first program has this done in icon_init after
+    * initializing the event monitoring system.
+    */
+   resolve(pstate);
+
+   return coexp;
+   }
+#endif					/* MultiThread */
+
+#ifdef WinGraphics
+static void MSStartup(HINSTANCE hInstance, HINSTANCE hPrevInstance)
+   {
+   WNDCLASS wc;
+   if (!hPrevInstance) {
+      wc.style = CS_HREDRAW | CS_VREDRAW;
+      wc.lpfnWndProc = WndProc;
+      wc.cbClsExtra = 0;
+      wc.cbWndExtra = 0;
+      wc.hInstance  = hInstance;
+      wc.hIcon      = NULL;
+      wc.hCursor    = NULL;
+      wc.hbrBackground = GetStockObject(WHITE_BRUSH);
+      wc.lpszMenuName = NULL;
+      wc.lpszClassName = "iconx";
+      RegisterClass(&wc);
+      }
+   }
+#endif					/* WinGraphics */
diff --git a/src/runtime/interp.r b/src/runtime/interp.r
new file mode 100644
index 0000000..c5fd713
--- /dev/null
+++ b/src/runtime/interp.r
@@ -0,0 +1,1818 @@
+#if !COMPILER
+/*
+ * File: interp.r
+ *  The interpreter proper.
+ */
+
+#include "../h/opdefs.h"
+
+extern fptr fncentry[];
+
+
+/*
+ * Prototypes for static functions.
+ */
+#ifdef EventMon
+static struct ef_marker *vanq_bound (struct ef_marker *efp_v,
+                                      struct gf_marker *gfp_v);
+static void           vanq_proc (struct ef_marker *efp_v,
+                                     struct gf_marker *gfp_v);
+#endif					/* EventMon */
+
+#ifndef MultiThread
+word lastop;			/* Last operator evaluated */
+#endif					/* MultiThread */
+
+/*
+ * Istate variables.
+ */
+struct ef_marker *efp;		/* Expression frame pointer */
+struct gf_marker *gfp;		/* Generator frame pointer */
+inst ipc;			/* Interpreter program counter */
+word *sp = NULL;		/* Stack pointer */
+
+int ilevel;			/* Depth of recursion in interp() */
+struct descrip value_tmp;	/* list argument to Op_Apply */
+struct descrip eret_tmp;	/* eret value during unwinding */
+
+int coexp_act;			/* last co-expression action */
+
+#ifndef MultiThread
+dptr xargp;
+word xnargs;
+#endif					/* MultiThread */
+
+/*
+ * Macros for use inside the main loop of the interpreter.
+ */
+
+#ifdef EventMon
+#define E_Misc    -1
+#define E_Operator 0
+#define E_Function 1
+#endif					/* EventMon */
+
+/*
+ * Setup_Op sets things up for a call to the C function for an operator.
+ *  InterpEVValD expands to nothing if EventMon is not defined.
+ */
+#begdef Setup_Op(nargs)
+#ifdef EventMon
+   lastev = E_Operator;
+   value_tmp.dword = D_Proc;
+   value_tmp.vword.bptr = (union block *)&op_tbl[lastop - 1];
+   InterpEVValD(&value_tmp, E_Ocall);
+#endif					/* EventMon */
+   rargp = (dptr)(rsp - 1) - nargs;
+   xargp = rargp;
+   ExInterp;
+#enddef					/* Setup_Op */
+
+/*
+ * Setup_Arg sets things up for a call to the C function.
+ *  It is the same as Setup_Op, except the latter is used only
+ *  operators.
+ */
+#begdef Setup_Arg(nargs)
+#ifdef EventMon
+   lastev = E_Misc;
+#endif					/* EventMon */
+   rargp = (dptr)(rsp - 1) - nargs;
+   xargp = rargp;
+   ExInterp;
+#enddef					/* Setup_Arg */
+
+#begdef Call_Cond
+   if ((*(optab[lastop]))(rargp) == A_Resume) {
+#ifdef EventMon
+     InterpEVVal((word)-1, E_Ofail);
+#endif					/* EventMon */
+     goto efail_noev;
+   }
+   rsp = (word *) rargp + 1;
+#ifdef EventMon
+   goto return_term;
+#else					/* EventMon */
+   break;
+#endif					/* EventMon */
+#enddef					/* Call_Cond */
+
+/*
+ * Call_Gen - Call a generator. A C routine associated with the
+ *  current opcode is called. When it when it terminates, control is
+ *  passed to C_rtn_term to deal with the termination condition appropriately.
+ */
+#begdef Call_Gen
+   signal = (*(optab[lastop]))(rargp);
+   goto C_rtn_term;
+#enddef					/* Call_Gen */
+
+/*
+ * GetWord fetches the next icode word.  PutWord(x) stores x at the current
+ * icode word.
+ */
+#define GetWord (*ipc.opnd++)
+#define PutWord(x) ipc.opnd[-1] = (x)
+#define GetOp (word)(*ipc.op++)
+#define PutOp(x) ipc.op[-1] = (x)
+
+/*
+ * DerefArg(n) dereferences the nth argument.
+ */
+#define DerefArg(n)   Deref(rargp[n])
+
+/*
+ * For the sake of efficiency, the stack pointer is kept in a register
+ *  variable, rsp, in the interpreter loop.  Since this variable is
+ *  only accessible inside the loop, and the global variable sp is used
+ *  for the stack pointer elsewhere, rsp must be stored into sp when
+ *  the context of the loop is left and conversely, rsp must be loaded
+ *  from sp when the loop is reentered.  The macros ExInterp and EntInterp,
+ *  respectively, handle these operations.  Currently, this register/global
+ *  scheme is only used for the stack pointer, but it can be easily extended
+ *  to other variables.
+ */
+
+#define ExInterp	sp = rsp;
+#define EntInterp	rsp = sp;
+
+/*
+ * Inside the interpreter loop, PushDesc, PushNull, PushAVal, and
+ *  PushVal use rsp instead of sp for efficiency.
+ */
+#undef PushDesc
+#undef PushNull
+#undef PushVal
+#undef PushAVal
+#define PushDesc(d)   PushDescSP(rsp,d)
+#define PushNull      PushNullSP(rsp)
+#define PushVal(v)    PushValSP(rsp,v)
+#define PushAVal(a)   PushValSP(rsp,a)
+
+
+/*
+ * The main loop of the interpreter.
+ */
+int interp(fsig,cargp)
+int fsig;
+dptr cargp;
+   {
+   register word opnd;
+   register word *rsp;
+   register dptr rargp;
+   register struct ef_marker *newefp;
+   register struct gf_marker *newgfp;
+   register word *wd;
+   register word *firstwd, *lastwd;
+   word *oldsp;
+   int type, signal, args;
+   extern int (*optab[])();
+   extern int (*keytab[])();
+   struct b_proc *bproc;
+#ifdef EventMon
+   int lastev = E_Misc;
+#endif					/* EventMon */
+
+#ifdef TallyOpt
+   extern word tallybin[];
+#endif					/* TallyOpt */
+
+#ifdef EventMon
+   EVVal(fsig, E_Intcall);
+   EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+
+#ifndef MultiThread
+   /*
+    * Make a stab at catching interpreter stack overflow.  This does
+    * nothing for invocation in a co-expression other than &main.
+    */
+   if (BlkLoc(k_current) == BlkLoc(k_main) &&
+      ((char *)sp + PerilDelta) > (char *)stackend)
+         fatalerr(301, NULL);
+#endif					/* MultiThread */
+
+#ifdef Polling
+   if (!pollctr--) {
+      pollctr = pollevent();
+      if (pollctr == -1) fatalerr(141, NULL);
+      }
+#endif					/* Polling */
+
+   ilevel++;
+
+   EntInterp;
+
+#ifdef EventMon
+   switch (fsig) {
+   case G_Csusp:
+   case G_Fsusp:
+   case G_Osusp:
+      value_tmp = *(dptr)(rsp - 1);	/* argument */
+      Deref(value_tmp);
+      InterpEVValD(&value_tmp,
+		   (fsig == G_Fsusp)?E_Fsusp:(fsig == G_Osusp?E_Osusp:E_Bsusp));
+#else					/* EventMon */
+   if (fsig == G_Csusp) {
+#endif					/* EventMon */
+
+      oldsp = rsp;
+
+      /*
+       * Create the generator frame.
+       */
+      newgfp = (struct gf_marker *)(rsp + 1);
+      newgfp->gf_gentype = fsig;
+      newgfp->gf_gfp = gfp;
+      newgfp->gf_efp = efp;
+      newgfp->gf_ipc = ipc;
+      rsp += Wsizeof(struct gf_smallmarker);
+
+      /*
+       * Region extends from first word after the marker for the generator
+       *  or expression frame enclosing the call to the now-suspending
+       *  routine to the first argument of the routine.
+       */
+      if (gfp != 0) {
+	 if (gfp->gf_gentype == G_Psusp)
+	    firstwd = (word *)gfp + Wsizeof(*gfp);
+	 else
+	    firstwd = (word *)gfp + Wsizeof(struct gf_smallmarker);
+	 }
+      else
+	 firstwd = (word *)efp + Wsizeof(*efp);
+      lastwd = (word *)cargp + 1;
+
+      /*
+       * Copy the portion of the stack with endpoints firstwd and lastwd
+       *  (inclusive) to the top of the stack.
+       */
+      for (wd = firstwd; wd <= lastwd; wd++)
+	 *++rsp = *wd;
+      gfp = newgfp;
+      }
+/*
+ * Top of the interpreter loop.
+ */
+
+   for (;;) {
+
+#ifdef EventMon
+
+   /*
+    * Location change events are generated by checking to see if the opcode
+    *  has changed indices in the "line number" (now line + column) table;
+    *  "straight line" forward code does not require a binary search to find
+    *  the new location; instead, a pointer is simply incremented.
+    *  Further optimization here is planned.
+    */
+   if (!is:null(curpstate->eventmask) && (
+       Testb((word)E_Loc, curpstate->eventmask) ||
+       Testb((word)E_Line, curpstate->eventmask)
+       )) {
+
+      if (InRange(code, ipc.opnd, ecode)) {
+	uword ipc_offset = DiffPtrs((char *)ipc.opnd, (char *)code);
+	uword size;
+	word temp_no;
+	if (!current_line_ptr ||
+	    current_line_ptr->ipc > ipc_offset ||
+	    current_line_ptr[1].ipc <= ipc_offset) {
+#ifdef LineCodes
+#ifdef Polling
+            if (!pollctr--) {
+	       ExInterp;
+               pollctr = pollevent();
+	       EntInterp;
+	       if (pollctr == -1) fatalerr(141, NULL);
+	       }
+#endif					/* Polling */
+#endif					/* LineCodes */
+
+
+	    if(current_line_ptr &&
+	       current_line_ptr + 2 < elines &&
+	       current_line_ptr[1].ipc < ipc_offset &&
+	       ipc_offset < current_line_ptr[2].ipc) {
+	       current_line_ptr ++;
+	       }
+	    else {
+	       current_line_ptr = ilines;
+	       size = DiffPtrs((char *)elines, (char *)ilines) /
+		  sizeof(struct ipc_line *);
+	       while (size > 1) {
+		  if (ipc_offset >= current_line_ptr[size>>1].ipc) {
+		     current_line_ptr = &current_line_ptr[size>>1];
+		     size -= (size >> 1);
+		     }
+		  else {
+		     size >>= 1;
+		     }
+		  }
+	       }
+	    linenum = current_line_ptr->line;
+            temp_no = linenum & 65535;
+            if ((lastline & 65535) != temp_no) {
+               if (Testb((word)E_Line, curpstate->eventmask))
+                     if (temp_no)
+                        InterpEVVal(temp_no, E_Line);
+	       }
+	    if (lastline != linenum) {
+	       lastline = linenum;
+	       if (Testb((word)E_Loc, curpstate->eventmask) &&
+		   current_line_ptr->line >> 16)
+		  InterpEVVal(current_line_ptr->line, E_Loc);
+	       }
+	    }
+	}
+      }
+#endif					/* EventMon */
+
+      lastop = GetOp;		/* Instruction fetch */
+
+#ifdef EventMon
+      /*
+       * If we've asked for ALL opcode events, or specifically for this one
+       * generate an MT-style event.
+       */
+      if ((!is:null(curpstate->eventmask) &&
+	   Testb((word)E_Opcode, curpstate->eventmask)) &&
+	  (is:null(curpstate->opcodemask) ||
+	   Testb((word)lastop, curpstate->opcodemask))) {
+	 ExInterp;
+	 MakeInt(lastop, &(curpstate->parent->eventval));
+	 actparent(E_Opcode);
+	 EntInterp
+	 }
+#endif					/* EventMon */
+
+      switch ((int)lastop) {		/*
+				 * Switch on opcode.  The cases are
+				 * organized roughly by functionality
+				 * to make it easier to find things.
+				 * For some C compilers, there may be
+				 * an advantage to arranging them by
+				 * likelihood of selection.
+				 */
+
+				/* ---Constant construction--- */
+
+	 case Op_Cset:		/* cset */
+	    PutOp(Op_Acset);
+	    PushVal(D_Cset);
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+	    PutWord(opnd);
+	    PushAVal(opnd);
+	    break;
+
+	 case Op_Acset:		/* cset, absolute address */
+	    PushVal(D_Cset);
+	    PushAVal(GetWord);
+	    break;
+
+	 case Op_Int:		/* integer */
+	    PushVal(D_Integer);
+	    PushVal(GetWord);
+	    break;
+
+	 case Op_Real:		/* real */
+	    PutOp(Op_Areal);
+	    PushVal(D_Real);
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+	    PushAVal(opnd);
+	    PutWord(opnd);
+	    break;
+
+	 case Op_Areal:		/* real, absolute address */
+	    PushVal(D_Real);
+	    PushAVal(GetWord);
+	    break;
+
+	 case Op_Str:		/* string */
+	    PutOp(Op_Astr);
+	    PushVal(GetWord);
+	    opnd = (word)strcons + GetWord;
+	    PutWord(opnd);
+	    PushAVal(opnd);
+	    break;
+
+	 case Op_Astr:		/* string, absolute address */
+	    PushVal(GetWord);
+	    PushAVal(GetWord);
+	    break;
+
+				/* ---Variable construction--- */
+
+	 case Op_Arg:		/* argument */
+	    PushVal(D_Var);
+	    PushAVal(&glbl_argp[GetWord + 1]);
+	    break;
+
+	 case Op_Global:	/* global */
+	    PutOp(Op_Aglobal);
+	    PushVal(D_Var);
+	    opnd = GetWord;
+	    PushAVal(&globals[opnd]);
+	    PutWord((word)&globals[opnd]);
+	    break;
+
+	 case Op_Aglobal:	/* global, absolute address */
+	    PushVal(D_Var);
+	    PushAVal(GetWord);
+	    break;
+
+	 case Op_Local:		/* local */
+	    PushVal(D_Var);
+	    PushAVal(&pfp->pf_locals[GetWord]);
+	    break;
+
+	 case Op_Static:	/* static */
+	    PutOp(Op_Astatic);
+	    PushVal(D_Var);
+	    opnd = GetWord;
+	    PushAVal(&statics[opnd]);
+	    PutWord((word)&statics[opnd]);
+	    break;
+
+	 case Op_Astatic:	/* static, absolute address */
+	    PushVal(D_Var);
+	    PushAVal(GetWord);
+	    break;
+
+
+				/* ---Operators--- */
+
+				/* Unary operators */
+
+	 case Op_Compl:		/* ~e */
+	 case Op_Neg:		/* -e */
+	 case Op_Number:	/* +e */
+	 case Op_Refresh:	/* ^e */
+	 case Op_Size:		/* *e */
+	    Setup_Op(1);
+	    DerefArg(1);
+	    Call_Cond;
+
+	 case Op_Value:		/* .e */
+            Setup_Op(1);
+            DerefArg(1);
+            Call_Cond;
+
+	 case Op_Nonnull:	/* \e */
+	 case Op_Null:		/* /e */
+	    Setup_Op(1);
+	    Call_Cond;
+
+	 case Op_Random:	/* ?e */
+	    PushNull;
+	    Setup_Op(2)
+	    Call_Cond
+
+				/* Generative unary operators */
+
+	 case Op_Tabmat:	/* =e */
+	    Setup_Op(1);
+	    DerefArg(1);
+	    Call_Gen;
+
+	 case Op_Bang:		/* !e */
+	    PushNull;
+	    Setup_Op(2);
+	    Call_Gen;
+
+				/* Binary operators */
+
+	 case Op_Cat:		/* e1 || e2 */
+	 case Op_Diff:		/* e1 -- e2 */
+	 case Op_Div:		/* e1 / e2 */
+	 case Op_Inter:		/* e1 ** e2 */
+	 case Op_Lconcat:	/* e1 ||| e2 */
+	 case Op_Minus:		/* e1 - e2 */
+	 case Op_Mod:		/* e1 % e2 */
+	 case Op_Mult:		/* e1 * e2 */
+	 case Op_Power:		/* e1 ^ e2 */
+	 case Op_Unions:	/* e1 ++ e2 */
+	 case Op_Plus:		/* e1 + e2 */
+	 case Op_Eqv:		/* e1 === e2 */
+	 case Op_Lexeq:		/* e1 == e2 */
+	 case Op_Lexge:		/* e1 >>= e2 */
+	 case Op_Lexgt:		/* e1 >> e2 */
+	 case Op_Lexle:		/* e1 <<= e2 */
+	 case Op_Lexlt:		/* e1 << e2 */
+	 case Op_Lexne:		/* e1 ~== e2 */
+	 case Op_Neqv:		/* e1 ~=== e2 */
+	 case Op_Numeq:		/* e1 = e2 */
+	 case Op_Numge:		/* e1 >= e2 */
+	 case Op_Numgt:		/* e1 > e2 */
+	 case Op_Numle:		/* e1 <= e2 */
+	 case Op_Numne:		/* e1 ~= e2 */
+	 case Op_Numlt:		/* e1 < e2 */
+	    Setup_Op(2);
+	    DerefArg(1);
+	    DerefArg(2);
+	    Call_Cond;
+
+	 case Op_Asgn:		/* e1 := e2 */
+	    Setup_Op(2);
+	    Call_Cond;
+
+	 case Op_Swap:		/* e1 :=: e2 */
+	    PushNull;
+	    Setup_Op(3);
+	    Call_Cond;
+
+	 case Op_Subsc:		/* e1[e2] */
+	    PushNull;
+	    Setup_Op(3);
+	    Call_Cond;
+				/* Generative binary operators */
+
+	 case Op_Rasgn:		/* e1 <- e2 */
+	    Setup_Op(2);
+	    Call_Gen;
+
+	 case Op_Rswap:		/* e1 <-> e2 */
+	    PushNull;
+	    Setup_Op(3);
+	    Call_Gen;
+
+				/* Conditional ternary operators */
+
+	 case Op_Sect:		/* e1[e2:e3] */
+	    PushNull;
+	    Setup_Op(4);
+	    Call_Cond;
+				/* Generative ternary operators */
+
+	 case Op_Toby:		/* e1 to e2 by e3 */
+	    Setup_Op(3);
+	    DerefArg(1);
+	    DerefArg(2);
+	    DerefArg(3);
+	    Call_Gen;
+
+         case Op_Noop:		/* no-op */
+
+#ifdef LineCodes
+#ifdef Polling
+            if (!pollctr--) {
+	       ExInterp;
+               pollctr = pollevent();
+	       EntInterp;
+	       if (pollctr == -1) fatalerr(141, NULL);
+	       }
+#endif					/* Polling */
+
+
+#endif					/* LineCodes */
+
+            break;
+
+
+         case Op_Colm:		/* source column number */
+            {
+#ifdef EventMon
+            word loc;
+            column = GetWord;
+            loc = column;
+            loc <<= (WordBits >> 1);	/* column in high-order part */
+            loc += linenum;
+            InterpEVVal(loc, E_Loc);
+#endif					/* EventMon */
+            break;
+            }
+
+         case Op_Line:		/* source line number */
+
+#ifdef LineCodes
+#ifdef Polling
+            if (!pollctr--) {
+	       ExInterp;
+               pollctr = pollevent();
+	       EntInterp;
+	       if (pollctr == -1) fatalerr(141, NULL);
+	       }
+#endif					/* Polling */
+
+
+#endif					/* LineCodes */
+
+#ifdef EventMon
+            linenum = GetWord;
+            lastline = linenum;
+#endif					/* EventMon */
+
+            break;
+
+				/* ---String Scanning--- */
+
+	 case Op_Bscan:		/* prepare for scanning */
+	    PushDesc(k_subject);
+	    PushVal(D_Integer);
+	    PushVal(k_pos);
+	    Setup_Arg(2);
+
+	    signal = Obscan(2,rargp);
+
+	    goto C_rtn_term;
+
+	 case Op_Escan:		/* exit from scanning */
+	    Setup_Arg(1);
+
+	    signal = Oescan(1,rargp);
+
+	    goto C_rtn_term;
+
+				/* ---Other Language Operations--- */
+
+         case Op_Apply: {	/* apply */
+            union block *bp;
+            int i, j;
+
+            value_tmp = *(dptr)(rsp - 1);	/* argument */
+            Deref(value_tmp);
+            switch (Type(value_tmp)) {
+               case T_List: {
+                  rsp -= 2;				/* pop it off */
+                  bp = BlkLoc(value_tmp);
+                  args = (int)bp->list.size;
+
+#ifndef MultiThread
+                 /*
+                  * Make a stab at catching interpreter stack overflow.
+                  * This does nothing for invocation in a co-expression other
+                  * than &main.
+                  */
+                 if (BlkLoc(k_current) == BlkLoc(k_main) &&
+                    ((char *)sp + args * sizeof(struct descrip) >
+                       (char *)stackend))
+                          fatalerr(301, NULL);
+#endif					/* MultiThread */
+
+                  for (bp = bp->list.listhead;
+#ifdef ListFix
+		       BlkType(bp) == T_Lelem;
+#else					/* ListFix */
+		       bp != NULL;
+#endif					/* ListFix */
+                     bp = bp->lelem.listnext) {
+                        for (i = 0; i < bp->lelem.nused; i++) {
+                           j = bp->lelem.first + i;
+                           if (j >= bp->lelem.nslots)
+                              j -= bp->lelem.nslots;
+                           PushDesc(bp->lelem.lslots[j]);
+                           }
+                        }
+		  goto invokej;
+		  }
+
+               case T_Record: {
+                  rsp -= 2;		/* pop it off */
+                  bp = BlkLoc(value_tmp);
+                  args = bp->record.recdesc->proc.nfields;
+                  for (i = 0; i < args; i++) {
+                     PushDesc(bp->record.fields[i]);
+                     }
+                  goto invokej;
+                  }
+
+               default: {		/* illegal type for invocation */
+
+                  xargp = (dptr)(rsp - 3);
+                  err_msg(126, &value_tmp);
+                  goto efail;
+                  }
+               }
+	    }
+
+	 case Op_Invoke: {	/* invoke */
+            args = (int)GetWord;
+invokej:
+	    {
+            int nargs;
+	    dptr carg;
+
+	    ExInterp;
+	    type = invoke(args, &carg, &nargs);
+	    EntInterp;
+
+	    if (type == I_Fail)
+	       goto efail_noev;
+	    if (type == I_Continue)
+	       break;
+	    else {
+
+               rargp = carg;		/* valid only for Vararg or Builtin */
+
+#ifdef Polling
+	       /*
+		* Do polling here
+		*/
+	       pollctr >>= 1;
+               if (!pollctr) {
+	          ExInterp;
+                  pollctr = pollevent();
+	          EntInterp;
+	          if (pollctr == -1) fatalerr(141, NULL);
+	          }
+#endif					/* Polling */
+
+#ifdef EventMon
+	       lastev = E_Function;
+	       InterpEVValD(rargp, E_Fcall);
+#endif					/* EventMon */
+
+	       bproc = (struct b_proc *)BlkLoc(*rargp);
+
+#ifdef FncTrace
+               typedef int (*bfunc2)(dptr, struct descrip *);
+#endif					/* FncTrace */
+
+
+	       /* ExInterp not needed since no change since last EntInterp */
+	       if (type == I_Vararg) {
+	          int (*bfunc)();
+                  bfunc = bproc->entryp.ccode;
+
+#ifdef FncTrace
+                  signal = (*bfunc)(nargs, rargp, &(procs->pname));
+#else					/* FncTrace */
+		  signal = (*bfunc)(nargs,rargp);
+#endif					/* FncTrace */
+
+                  }
+	       else
+                  {
+                  int (*bfunc)();
+                  bfunc = bproc->entryp.ccode;
+
+#ifdef FncTrace
+                  signal = (*(bfunc2)bfunc)(rargp, &(bproc->pname));
+#else					/* FncTrace */
+		  signal = (*bfunc)(rargp);
+#endif					/* FncTrace */
+                  }
+
+#ifdef FncTrace
+               if (k_ftrace) {
+                  k_ftrace--;
+                  if (signal == A_Failure)
+                     failtrace(&(bproc->pname));
+                  else
+                     rtrace(&(bproc->pname),rargp);
+                  }
+#endif					/* FncTrace */
+
+	       goto C_rtn_term;
+	       }
+	    }
+	    }
+
+	 case Op_Keywd:		/* keyword */
+
+            PushNull;
+            opnd = GetWord;
+            Setup_Arg(0);
+
+	    signal = (*(keytab[(int)opnd]))(rargp);
+	    goto C_rtn_term;
+
+	 case Op_Llist:		/* construct list */
+	    opnd = GetWord;
+
+#ifdef EventMon
+            lastev = E_Operator;
+            value_tmp.dword = D_Proc;
+            value_tmp.vword.bptr = (union block *)&mt_llist;
+            InterpEVValD(&value_tmp, E_Ocall);
+            rargp = (dptr)(rsp - 1) - opnd;
+            xargp = rargp;
+            ExInterp;
+#else					/* EventMon */
+	    Setup_Arg(opnd);
+#endif					/* EventMon */
+
+	    {
+	    int i;
+	    for (i=1;i<=opnd;i++)
+               DerefArg(i);
+	    }
+
+	    signal = Ollist((int)opnd,rargp);
+
+	    goto C_rtn_term;
+
+				/* ---Marking and Unmarking--- */
+
+	 case Op_Mark:		/* create expression frame marker */
+	    PutOp(Op_Amark);
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+	    PutWord(opnd);
+	    newefp = (struct ef_marker *)(rsp + 1);
+	    newefp->ef_failure.opnd = (word *)opnd;
+	    goto mark;
+
+	 case Op_Amark:		/* mark with absolute fipc */
+	    newefp = (struct ef_marker *)(rsp + 1);
+	    newefp->ef_failure.opnd = (word *)GetWord;
+mark:
+	    newefp->ef_gfp = gfp;
+	    newefp->ef_efp = efp;
+	    newefp->ef_ilevel = ilevel;
+	    rsp += Wsizeof(*efp);
+	    efp = newefp;
+	    gfp = 0;
+	    break;
+
+	 case Op_Mark0:		/* create expression frame with 0 ipl */
+mark0:
+	    newefp = (struct ef_marker *)(rsp + 1);
+	    newefp->ef_failure.opnd = 0;
+	    newefp->ef_gfp = gfp;
+	    newefp->ef_efp = efp;
+	    newefp->ef_ilevel = ilevel;
+	    rsp += Wsizeof(*efp);
+	    efp = newefp;
+	    gfp = 0;
+	    break;
+
+	 case Op_Unmark:	/* remove expression frame */
+
+#ifdef EventMon
+	    ExInterp;
+            vanq_bound(efp, gfp);
+	    EntInterp;
+#endif					/* EventMon */
+
+	    gfp = efp->ef_gfp;
+	    rsp = (word *)efp - 1;
+
+	    /*
+	     * Remove any suspended C generators.
+	     */
+Unmark_uw:
+	    if (efp->ef_ilevel < ilevel) {
+	       --ilevel;
+
+	       ExInterp;
+
+#ifdef EventMon
+	       EVVal(A_Unmark_uw, E_Intret);
+               EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+
+	       return A_Unmark_uw;
+	       }
+
+	    efp = efp->ef_efp;
+	    break;
+
+				/* ---Suspensions--- */
+
+	 case Op_Esusp: {	/* suspend from expression */
+
+	    /*
+	     * Create the generator frame.
+	     */
+	    oldsp = rsp;
+	    newgfp = (struct gf_marker *)(rsp + 1);
+	    newgfp->gf_gentype = G_Esusp;
+	    newgfp->gf_gfp = gfp;
+	    newgfp->gf_efp = efp;
+	    newgfp->gf_ipc = ipc;
+	    gfp = newgfp;
+	    rsp += Wsizeof(struct gf_smallmarker);
+
+	    /*
+	     * Region extends from first word after enclosing generator or
+	     *	expression frame marker to marker for current expression frame.
+	     */
+	    if (efp->ef_gfp != 0) {
+	       newgfp = (struct gf_marker *)(efp->ef_gfp);
+	       if (newgfp->gf_gentype == G_Psusp)
+		  firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp);
+	       else
+		  firstwd = (word *)efp->ef_gfp +
+		     Wsizeof(struct gf_smallmarker);
+		}
+	    else
+	       firstwd = (word *)efp->ef_efp + Wsizeof(*efp);
+	    lastwd = (word *)efp - 1;
+	    efp = efp->ef_efp;
+
+	    /*
+	     * Copy the portion of the stack with endpoints firstwd and lastwd
+	     *	(inclusive) to the top of the stack.
+	     */
+	    for (wd = firstwd; wd <= lastwd; wd++)
+	       *++rsp = *wd;
+	    PushVal(oldsp[-1]);
+	    PushVal(oldsp[0]);
+	    break;
+	    }
+
+	 case Op_Lsusp: {	/* suspend from limitation */
+	    struct descrip sval;
+
+	    /*
+	     * The limit counter is contained in the descriptor immediately
+	     *	prior to the current expression frame.	lval is established
+	     *	as a pointer to this descriptor.
+	     */
+	    dptr lval = (dptr)((word *)efp - 2);
+
+	    /*
+	     * Decrement the limit counter and check it.
+	     */
+	    if (--IntVal(*lval) > 0) {
+	       /*
+		* The limit has not been reached, set up stack.
+		*/
+
+	       sval = *(dptr)(rsp - 1);	/* save result */
+
+	       /*
+		* Region extends from first word after enclosing generator or
+		*  expression frame marker to the limit counter just prior to
+		*  to the current expression frame marker.
+		*/
+	       if (efp->ef_gfp != 0) {
+		  newgfp = (struct gf_marker *)(efp->ef_gfp);
+		  if (newgfp->gf_gentype == G_Psusp)
+		     firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp);
+		  else
+		     firstwd = (word *)efp->ef_gfp +
+			Wsizeof(struct gf_smallmarker);
+		  }
+	       else
+		  firstwd = (word *)efp->ef_efp + Wsizeof(*efp);
+	       lastwd = (word *)efp - 3;
+	       if (gfp == 0)
+		  gfp = efp->ef_gfp;
+	       efp = efp->ef_efp;
+
+	       /*
+		* Copy the portion of the stack with endpoints firstwd and lastwd
+		*  (inclusive) to the top of the stack.
+		*/
+	       rsp -= 2;		/* overwrite result */
+	       for (wd = firstwd; wd <= lastwd; wd++)
+		  *++rsp = *wd;
+	       PushDesc(sval);		/* push saved result */
+	       }
+	    else {
+	       /*
+		* Otherwise, the limit has been reached.  Instead of
+		*  suspending, remove the current expression frame and
+		*  replace the limit counter with the value on top of
+		*  the stack (which would have been suspended had the
+		*  limit not been reached).
+		*/
+	       *lval = *(dptr)(rsp - 1);
+
+#ifdef EventMon
+	       ExInterp;
+               vanq_bound(efp, gfp);
+	       EntInterp;
+#endif					/* EventMon */
+
+	       gfp = efp->ef_gfp;
+
+	       /*
+		* Since an expression frame is being removed, inactive
+		*  C generators contained therein are deactivated.
+		*/
+Lsusp_uw:
+	       if (efp->ef_ilevel < ilevel) {
+		  --ilevel;
+		  ExInterp;
+
+#ifdef EventMon
+                  EVVal(A_Lsusp_uw, E_Intret);
+                  EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+
+		  return A_Lsusp_uw;
+		  }
+	       rsp = (word *)efp - 1;
+	       efp = efp->ef_efp;
+	       }
+	    break;
+	    }
+
+	 case Op_Psusp: {	/* suspend from procedure */
+
+	    /*
+	     * An Icon procedure is suspending a value.  Determine if the
+	     *	value being suspended should be dereferenced and if so,
+	     *	dereference it. If tracing is on, strace is called
+	     *  to generate a message.  Appropriate values are
+	     *	restored from the procedure frame of the suspending procedure.
+	     */
+
+	    struct descrip tmp;
+            dptr svalp;
+	    struct b_proc *sproc;
+
+#ifdef EventMon
+            value_tmp = *(dptr)(rsp - 1);	/* argument */
+            Deref(value_tmp);
+            InterpEVValD(&value_tmp, E_Psusp);
+#endif					/* EventMon */
+
+	    svalp = (dptr)(rsp - 1);
+	    if (Var(*svalp)) {
+               ExInterp;
+               retderef(svalp, (word *)glbl_argp, sp);
+               EntInterp;
+               }
+
+	    /*
+	     * Create the generator frame.
+	     */
+	    oldsp = rsp;
+	    newgfp = (struct gf_marker *)(rsp + 1);
+	    newgfp->gf_gentype = G_Psusp;
+	    newgfp->gf_gfp = gfp;
+	    newgfp->gf_efp = efp;
+	    newgfp->gf_ipc = ipc;
+	    newgfp->gf_argp = glbl_argp;
+	    newgfp->gf_pfp = pfp;
+	    gfp = newgfp;
+	    rsp += Wsizeof(*gfp);
+
+	    /*
+	     * Region extends from first word after the marker for the
+	     *	generator or expression frame enclosing the call to the
+	     *	now-suspending procedure to Arg0 of the procedure.
+	     */
+	    if (pfp->pf_gfp != 0) {
+	       newgfp = (struct gf_marker *)(pfp->pf_gfp);
+	       if (newgfp->gf_gentype == G_Psusp)
+		  firstwd = (word *)pfp->pf_gfp + Wsizeof(*gfp);
+	       else
+		  firstwd = (word *)pfp->pf_gfp +
+		     Wsizeof(struct gf_smallmarker);
+	       }
+	    else
+	       firstwd = (word *)pfp->pf_efp + Wsizeof(*efp);
+	    lastwd = (word *)glbl_argp - 1;
+	       efp = efp->ef_efp;
+
+	    /*
+	     * Copy the portion of the stack with endpoints firstwd and lastwd
+	     *	(inclusive) to the top of the stack.
+	     */
+	    for (wd = firstwd; wd <= lastwd; wd++)
+	       *++rsp = *wd;
+	    PushVal(oldsp[-1]);
+	    PushVal(oldsp[0]);
+	    --k_level;
+	    if (k_trace) {
+               k_trace--;
+	       sproc = (struct b_proc *)BlkLoc(*glbl_argp);
+	       strace(&(sproc->pname), svalp);
+	       }
+
+	    /*
+	     * If the scanning environment for this procedure call is in
+	     *	a saved state, switch environments.
+	     */
+	    if (pfp->pf_scan != NULL) {
+
+#ifdef EventMon
+	       InterpEVValD(&k_subject, E_Ssusp);
+#endif					/* EventMon */
+
+	       tmp = k_subject;
+	       k_subject = *pfp->pf_scan;
+	       *pfp->pf_scan = tmp;
+
+	       tmp = *(pfp->pf_scan + 1);
+	       IntVal(*(pfp->pf_scan + 1)) = k_pos;
+	       k_pos = IntVal(tmp);
+	       }
+
+#ifdef MultiThread
+	    /*
+	     * If the program state changed for this procedure call,
+	     * change back.
+	     */
+	    ENTERPSTATE(pfp->pf_prog);
+#endif					/* MultiThread */
+
+	    efp = pfp->pf_efp;
+	    ipc = pfp->pf_ipc;
+	    glbl_argp = pfp->pf_argp;
+	    pfp = pfp->pf_pfp;
+	    break;
+	    }
+
+				/* ---Returns--- */
+
+	 case Op_Eret: {	/* return from expression */
+	    /*
+	     * Op_Eret removes the current expression frame, leaving the
+	     *	original top of stack value on top.
+	     */
+	    /*
+	     * Save current top of stack value in global temporary (no
+	     *	danger of reentry).
+	     */
+	    eret_tmp = *(dptr)&rsp[-1];
+	    gfp = efp->ef_gfp;
+Eret_uw:
+	    /*
+	     * Since an expression frame is being removed, inactive
+	     *	C generators contained therein are deactivated.
+	     */
+	    if (efp->ef_ilevel < ilevel) {
+	       --ilevel;
+	       ExInterp;
+
+#ifdef EventMon
+               EVVal(A_Eret_uw, E_Intret);
+               EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+
+	       return A_Eret_uw;
+	       }
+	    rsp = (word *)efp - 1;
+	    efp = efp->ef_efp;
+	    PushDesc(eret_tmp);
+	    break;
+	    }
+
+
+	 case Op_Pret: {	/* return from procedure */
+#ifdef EventMon
+	   struct descrip oldargp;
+	   static struct descrip unwinder;
+#endif					/* EventMon */
+
+	    /*
+	     * An Icon procedure is returning a value.	Determine if the
+	     *	value being returned should be dereferenced and if so,
+	     *	dereference it.  If tracing is on, rtrace is called to
+	     *	generate a message.  Inactive generators created after
+	     *	the activation of the procedure are deactivated.  Appropriate
+	     *	values are restored from the procedure frame.
+	     */
+	    struct b_proc *rproc;
+	    rproc = (struct b_proc *)BlkLoc(*glbl_argp);
+#ifdef EventMon
+            oldargp = *glbl_argp;
+	    ExInterp;
+            vanq_proc(efp, gfp);
+	    EntInterp;
+	    /* used to InterpEVValD(argp,E_Pret); here */
+#endif					/* EventMon */
+
+	    *glbl_argp = *(dptr)(rsp - 1);
+	    if (Var(*glbl_argp)) {
+               ExInterp;
+               retderef(glbl_argp, (word *)glbl_argp, sp);
+               EntInterp;
+               }
+
+	    --k_level;
+	    if (k_trace) {
+               k_trace--;
+	       rtrace(&(rproc->pname), glbl_argp);
+               }
+Pret_uw:
+	    if (pfp->pf_ilevel < ilevel) {
+	       --ilevel;
+	       ExInterp;
+
+#ifdef EventMon
+               EVVal(A_Pret_uw, E_Intret);
+               EVVal(DiffPtrs(sp, stack), E_Stack);
+	       unwinder = oldargp;
+#endif					/* EventMon */
+
+	       return A_Pret_uw;
+	       }
+
+#ifdef EventMon
+	   if (!is:proc(oldargp) && is:proc(unwinder))
+	      oldargp = unwinder;
+#endif					/* EventMon */
+	    rsp = (word *)glbl_argp + 1;
+	    efp = pfp->pf_efp;
+	    gfp = pfp->pf_gfp;
+	    ipc = pfp->pf_ipc;
+	    glbl_argp = pfp->pf_argp;
+	    pfp = pfp->pf_pfp;
+
+#ifdef MultiThread
+	    if (pfp)
+	       ENTERPSTATE(pfp->pf_prog);
+#ifdef EventMon
+            value_tmp = *(dptr)(rsp - 1);	/* argument */
+            Deref(value_tmp);
+            InterpEVValD(&value_tmp, E_Pret);
+#endif					/* EventMon */
+#endif					/* MultiThread */
+	    break;
+	    }
+
+				/* ---Failures--- */
+
+	 case Op_Efail:
+efail:
+#ifdef EventMon
+            InterpEVVal((word)-1, E_Efail);
+#endif					/* EventMon */
+efail_noev:
+	    /*
+	     * Failure has occurred in the current expression frame.
+	     */
+	    if (gfp == 0) {
+	       /*
+		* There are no suspended generators to resume.
+		*  Remove the current expression frame, restoring
+		*  values.
+		*
+		* If the failure ipc is 0, propagate failure to the
+		*  enclosing frame by branching back to efail.
+		*  This happens, for example, in looping control
+		*  structures that fail when complete.
+		*/
+
+#ifdef MultiThread
+	      if (efp == 0) {
+		 break;
+	         }
+#endif					/* MultiThread */
+
+	       ipc = efp->ef_failure;
+	       gfp = efp->ef_gfp;
+	       rsp = (word *)efp - 1;
+	       efp = efp->ef_efp;
+
+	       if (ipc.op == 0)
+		  goto efail;
+	       break;
+	       }
+
+	    else {
+	       /*
+		* There is a generator that can be resumed.  Make
+		*  the stack adjustments and then switch on the
+		*  type of the generator frame marker.
+		*/
+	       struct descrip tmp;
+	       register struct gf_marker *resgfp = gfp;
+
+	       type = (int)resgfp->gf_gentype;
+
+	       if (type == G_Psusp) {
+		  glbl_argp = resgfp->gf_argp;
+		  if (k_trace) {	/* procedure tracing */
+                     k_trace--;
+		     ExInterp;
+		     atrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname));
+		     EntInterp;
+		     }
+		  }
+	       ipc = resgfp->gf_ipc;
+	       efp = resgfp->gf_efp;
+	       gfp = resgfp->gf_gfp;
+	       rsp = (word *)resgfp - 1;
+	       if (type == G_Psusp) {
+		  pfp = resgfp->gf_pfp;
+
+		  /*
+		   * If the scanning environment for this procedure call is
+		   *  supposed to be in a saved state, switch environments.
+		   */
+		  if (pfp->pf_scan != NULL) {
+		     tmp = k_subject;
+		     k_subject = *pfp->pf_scan;
+		     *pfp->pf_scan = tmp;
+
+		     tmp = *(pfp->pf_scan + 1);
+		     IntVal(*(pfp->pf_scan + 1)) = k_pos;
+		     k_pos = IntVal(tmp);
+
+#ifdef EventMon
+		     InterpEVValD(&k_subject, E_Sresum);
+#endif					/* EventMon */
+		     }
+
+#ifdef MultiThread
+		  /*
+		   * Enter the program state of the resumed frame
+		   */
+		  ENTERPSTATE(pfp->pf_prog);
+#endif					/* MultiThread */
+
+		  ++k_level;		/* adjust procedure level */
+		  }
+
+	       switch (type) {
+
+#ifdef EventMon
+		  case G_Fsusp:
+                     InterpEVVal((word)0, E_Fresum);
+		     --ilevel;
+		     ExInterp;
+                     EVVal(A_Resume, E_Intret);
+                     EVVal(DiffPtrs(sp, stack), E_Stack);
+		     return A_Resume;
+
+		  case G_Osusp:
+                     InterpEVVal((word)0, E_Oresum);
+		     --ilevel;
+		     ExInterp;
+                     EVVal(A_Resume, E_Intret);
+                     EVVal(DiffPtrs(sp, stack), E_Stack);
+		     return A_Resume;
+#endif					/* EventMon */
+
+		  case G_Csusp:
+                     InterpEVVal((word)0, E_Eresum);
+		     --ilevel;
+		     ExInterp;
+#ifdef EventMon
+                     EVVal(A_Resume, E_Intret);
+                     EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+		     return A_Resume;
+
+		  case G_Esusp:
+                     InterpEVVal((word)0, E_Eresum);
+		     goto efail_noev;
+
+		  case G_Psusp:		/* resuming a procedure */
+                     InterpEVValD(glbl_argp, E_Presum);
+		     break;
+		  }
+
+	       break;
+	       }
+
+	 case Op_Pfail: {	/* fail from procedure */
+
+#ifdef EventMon
+	    ExInterp;
+            vanq_proc(efp, gfp);
+            EVValD(glbl_argp, E_Pfail);
+	    EntInterp;
+#endif					/* EventMon */
+
+	    /*
+	     * An Icon procedure is failing.  Generate tracing message if
+	     *	tracing is on.	Deactivate inactive C generators created
+	     *	after activation of the procedure.  Appropriate values
+	     *	are restored from the procedure frame.
+	     */
+
+	    --k_level;
+	    if (k_trace) {
+               k_trace--;
+	       failtrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname));
+               }
+Pfail_uw:
+
+	    if (pfp->pf_ilevel < ilevel) {
+	       --ilevel;
+	       ExInterp;
+#ifdef EventMon
+               EVVal(A_Pfail_uw, E_Intret);
+               EVVal(DiffPtrs(sp, stack), E_Stack);
+#endif					/* EventMon */
+	       return A_Pfail_uw;
+	       }
+	    efp = pfp->pf_efp;
+	    gfp = pfp->pf_gfp;
+	    ipc = pfp->pf_ipc;
+	    glbl_argp = pfp->pf_argp;
+	    pfp = pfp->pf_pfp;
+
+#ifdef MultiThread
+	    /*
+	     * Enter the program state of the procedure being reentered.
+	     * A NULL pfp indicates the program is complete.
+	     */
+	    if (pfp) {
+	       ENTERPSTATE(pfp->pf_prog);
+	       }
+#endif					/* MultiThread */
+
+	    goto efail_noev;
+	    }
+				/* ---Odds and Ends--- */
+
+	 case Op_Ccase:		/* case clause */
+	    PushNull;
+	    PushVal(((word *)efp)[-2]);
+	    PushVal(((word *)efp)[-1]);
+	    break;
+
+	 case Op_Chfail:	/* change failure ipc */
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+	    efp->ef_failure.opnd = (word *)opnd;
+	    break;
+
+	 case Op_Dup:		/* duplicate descriptor */
+	    PushNull;
+	    rsp[1] = rsp[-3];
+	    rsp[2] = rsp[-2];
+	    rsp += 2;
+	    break;
+
+	 case Op_Field:		/* e1.e2 */
+	    PushVal(D_Integer);
+	    PushVal(GetWord);
+	    Setup_Arg(2);
+
+	    signal = Ofield(2,rargp);
+
+	    goto C_rtn_term;
+
+	 case Op_Goto:		/* goto */
+	    PutOp(Op_Agoto);
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+	    PutWord(opnd);
+	    ipc.opnd = (word *)opnd;
+	    break;
+
+	 case Op_Agoto:		/* goto absolute address */
+	    opnd = GetWord;
+	    ipc.opnd = (word *)opnd;
+	    break;
+
+	 case Op_Init:		/* initial */
+	    *--ipc.op = Op_Goto;
+	    opnd = sizeof(*ipc.op) + sizeof(*rsp);
+	    opnd += (word)ipc.opnd;
+	    ipc.opnd = (word *)opnd;
+	    break;
+
+	 case Op_Limit:		/* limit */
+	    Setup_Arg(0);
+
+	    if (Olimit(0,rargp) == A_Resume) {
+
+	       /*
+		* limit has failed here; could generate an event for it,
+		*  but not an Ofail since limit is not an operator and
+		*  no Ocall was ever generated for it.
+		*/
+	       goto efail_noev;
+	       }
+	    else {
+	       /*
+		* limit has returned here; could generate an event for it,
+		*  but not an Oret since limit is not an operator and
+		*  no Ocall was ever generated for it.
+		*/
+	       rsp = (word *) rargp + 1;
+	       }
+	    goto mark0;
+
+#ifdef TallyOpt
+	 case Op_Tally:		/* tally */
+	    tallybin[GetWord]++;
+	    break;
+#endif					/* TallyOpt */
+
+	 case Op_Pnull:		/* push null descriptor */
+	    PushNull;
+	    break;
+
+	 case Op_Pop:		/* pop descriptor */
+	    rsp -= 2;
+	    break;
+
+	 case Op_Push1:		/* push integer 1 */
+	    PushVal(D_Integer);
+	    PushVal(1);
+	    break;
+
+	 case Op_Pushn1:	/* push integer -1 */
+	    PushVal(D_Integer);
+	    PushVal(-1);
+	    break;
+
+	 case Op_Sdup:		/* duplicate descriptor */
+	    rsp += 2;
+	    rsp[-1] = rsp[-3];
+	    rsp[0] = rsp[-2];
+	    break;
+
+					/* ---Co-expressions--- */
+
+	 case Op_Create:	/* create */
+
+#ifdef Coexpr
+	    PushNull;
+	    Setup_Arg(0);
+	    opnd = GetWord;
+	    opnd += (word)ipc.opnd;
+
+	    signal = Ocreate((word *)opnd, rargp);
+
+	    goto C_rtn_term;
+#else					/* Coexpr */
+	    err_msg(401, NULL);
+	    goto efail;
+#endif					/* Coexpr */
+
+	 case Op_Coact: {	/* @e */
+
+#ifndef Coexpr
+            err_msg(401, NULL);
+            goto efail;
+#else					/* Coexpr */
+            struct b_coexpr *ncp;
+            dptr dp;
+
+            ExInterp;
+            dp = (dptr)(sp - 1);
+            xargp = dp - 2;
+
+            Deref(*dp);
+            if (dp->dword != D_Coexpr) {
+               err_msg(118, dp);
+               goto efail;
+               }
+
+            ncp = (struct b_coexpr *)BlkLoc(*dp);
+
+            signal = activate((dptr)(sp - 3), ncp, (dptr)(sp - 3));
+            EntInterp;
+            if (signal == A_Resume)
+               goto efail_noev;
+            else
+               rsp -= 2;
+#endif					/* Coexpr */
+            break;
+	    }
+
+	 case Op_Coret: {	/* return from co-expression */
+
+#ifndef Coexpr
+            syserr("co-expression return, but co-expressions not implemented");
+#else					/* Coexpr */
+            struct b_coexpr *ncp;
+
+            ExInterp;
+            ncp = popact((struct b_coexpr *)BlkLoc(k_current));
+
+            ++BlkLoc(k_current)->coexpr.size;
+            co_chng(ncp, (dptr)&sp[-1], NULL, A_Coret, 1);
+            EntInterp;
+#endif					/* Coexpr */
+            break;
+
+	    }
+
+	 case Op_Cofail: {	/* fail from co-expression */
+
+#ifndef Coexpr
+            syserr("co-expression failure, but co-expressions not implemented");
+#else					/* Coexpr */
+            struct b_coexpr *ncp;
+
+            ExInterp;
+            ncp = popact((struct b_coexpr *)BlkLoc(k_current));
+
+            co_chng(ncp, NULL, NULL, A_Cofail, 1);
+            EntInterp;
+#endif					/* Coexpr */
+            break;
+
+	    }
+         case Op_Quit:		/* quit */
+
+
+	    goto interp_quit;
+
+
+	 default: {
+	    char buf[50];
+
+	    sprintf(buf, "unimplemented opcode: %ld (0x%08x)\n",
+               (long)lastop, lastop);
+	    syserr(buf);
+	    }
+	 }
+	 continue;
+
+C_rtn_term:
+	 EntInterp;
+
+	 switch (signal) {
+
+	    case A_Resume:
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)-1,
+			      ((lastev == E_Function)? E_Ffail : E_Ofail));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto efail_noev;
+
+	    case A_Unmark_uw:		/* unwind for unmark */
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)0, ((lastev==E_Function) ? E_Frem:E_Orem));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto Unmark_uw;
+
+	    case A_Lsusp_uw:		/* unwind for lsusp */
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)0, ((lastev==E_Function) ? E_Frem:E_Orem));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto Lsusp_uw;
+
+	    case A_Eret_uw:		/* unwind for eret */
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)0, ((lastev==E_Function) ? E_Frem:E_Orem));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto Eret_uw;
+
+	    case A_Pret_uw:		/* unwind for pret */
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)0, ((lastev==E_Function) ? E_Frem:E_Orem));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto Pret_uw;
+
+	    case A_Pfail_uw:		/* unwind for pfail */
+#ifdef EventMon
+	       if ((lastev == E_Function) || (lastev == E_Operator)) {
+		  InterpEVVal((word)0, ((lastev==E_Function) ? E_Frem:E_Orem));
+		  lastev = E_Misc;
+		  }
+#endif					/* EventMon */
+	       goto Pfail_uw;
+	    }
+
+	 rsp = (word *)rargp + 1;	/* set rsp to result */
+
+#ifdef EventMon
+return_term:
+         value_tmp = *(dptr)(rsp - 1);	/* argument */
+         Deref(value_tmp);
+         if ((lastev == E_Function) || (lastev == E_Operator)) {
+	    InterpEVValD(&value_tmp, ((lastev == E_Function) ? E_Fret:E_Oret));
+	    lastev = E_Misc;
+	    }
+#endif					/* EventMon */
+
+	 continue;
+	 }
+
+interp_quit:
+   --ilevel;
+   if (ilevel != 0)
+      syserr("interp: termination with inactive generators.");
+   /*NOTREACHED*/
+   return 0;	/* avoid gcc warning */
+   }
+
+#ifdef EventMon
+/*
+ * vanq_proc - monitor the removal of suspended operations from within
+ *   a procedure.
+ */
+static void vanq_proc(efp_v, gfp_v)
+struct ef_marker *efp_v;
+struct gf_marker *gfp_v;
+   {
+
+   if (is:null(curpstate->eventmask))
+      return;
+
+   /*
+    * Go through all the bounded expression of the procedure.
+    */
+   while ((efp_v = vanq_bound(efp_v, gfp_v)) != NULL) {
+      gfp_v = efp_v->ef_gfp;
+      efp_v = efp_v->ef_efp;
+      }
+   }
+
+/*
+ * vanq_bound - monitor the removal of suspended operations from
+ *   the current bounded expression and return the expression frame
+ *   pointer for the bounded expression.
+ */
+static struct ef_marker *vanq_bound(efp_v, gfp_v)
+struct ef_marker *efp_v;
+struct gf_marker *gfp_v;
+   {
+
+   if (is:null(curpstate->eventmask))
+      return efp_v;
+
+   while (gfp_v != 0) {		/* note removal of suspended operations */
+      switch ((int)gfp_v->gf_gentype) {
+         case G_Psusp:
+            EVValD(gfp_v->gf_argp, E_Prem);
+            break;
+	 /* G_Fsusp and G_Osusp handled in-line during unwinding */
+         case G_Esusp:
+            EVVal((word)0, E_Erem);
+            break;
+         }
+
+      if (((int)gfp_v->gf_gentype) == G_Psusp) {
+         vanq_proc(gfp_v->gf_efp, gfp_v->gf_gfp);
+         efp_v = gfp_v->gf_pfp->pf_efp;           /* efp before the call */
+         gfp_v = gfp_v->gf_pfp->pf_gfp;           /* gfp before the call */
+         }
+      else {
+         efp_v = gfp_v->gf_efp;
+         gfp_v = gfp_v->gf_gfp;
+         }
+      }
+
+   return efp_v;
+   }
+#endif					/* EventMon */
+
+#ifdef MultiThread
+/*
+ * activate some other co-expression from an arbitrary point in
+ * the interpreter.
+ */
+int mt_activate(tvalp,rslt,ncp)
+dptr tvalp, rslt;
+register struct b_coexpr *ncp;
+{
+   register struct b_coexpr *ccp = (struct b_coexpr *)BlkLoc(k_current);
+   int first, rv;
+
+   dptr savedtvalloc = NULL;
+   /*
+    * Set activator in new co-expression.
+    */
+   if (ncp->es_actstk == NULL) {
+      Protect(ncp->es_actstk = alcactiv(), { err_msg(0, NULL); exit(1); });
+      /*
+       * If no one ever explicitly activates this co-expression, fail to
+       * the implicit activator.
+       */
+      ncp->es_actstk->arec[0].activator = ccp;
+      first = 0;
+      }
+   else
+      first = 1;
+
+   if(ccp->tvalloc) {
+     if (InRange(blkbase,ccp->tvalloc,blkfree)) {
+       fprintf(stderr,
+	       "Multiprogram garbage collection disaster in mt_activate()!\n");
+       fflush(stderr);
+       exit(1);
+     }
+     savedtvalloc = ccp->tvalloc;
+   }
+
+   rv = co_chng(ncp, tvalp, rslt, A_MTEvent, first);
+
+   if ((savedtvalloc != NULL) && (savedtvalloc != ccp->tvalloc)) {
+      fprintf(stderr,"averted co-expression disaster in activate\n");
+      ccp->tvalloc = savedtvalloc;
+      }
+
+   return rv;
+}
+
+
+/*
+ * activate the "&parent" co-expression from anywhere, if there is one
+ */
+void actparent(event)
+int event;
+   {
+   struct progstate *parent = curpstate->parent;
+
+   StrLen(parent->eventcode) = 1;
+   StrLoc(parent->eventcode) = (char *)&allchars[event & 0xFF];
+   mt_activate(&(parent->eventcode), NULL,
+	       (struct b_coexpr *)curpstate->parent->Mainhead);
+   }
+#endif					/* MultiThread */
+#endif					/* !COMPILER */
diff --git a/src/runtime/invoke.r b/src/runtime/invoke.r
new file mode 100644
index 0000000..87b9fd1
--- /dev/null
+++ b/src/runtime/invoke.r
@@ -0,0 +1,377 @@
+/*
+ * invoke.r - contains invoke, apply
+ */
+
+#if COMPILER
+
+/*
+ * invoke - perform general invocation on a value.
+ */
+int invoke(nargs, args, rslt, succ_cont)
+int nargs;
+dptr args;
+dptr rslt;
+continuation succ_cont;
+   {
+   tended struct descrip callee;
+   struct b_proc *proc;
+   C_integer n;
+
+   /*
+    * remove the operation being called from the argument list.
+    */
+   deref(&args[0], &callee);
+   ++args;
+   nargs -= 1;
+
+   if (is:proc(callee))
+      return (*((struct b_proc *)BlkLoc(callee))->ccode)(nargs, args, rslt,
+         succ_cont);
+   else if (cnv:C_integer(callee, n)) {
+      if (n <= 0)
+         n += nargs + 1;
+      if (n <= 0 || n > nargs)
+         return A_Resume;
+      *rslt = args[n - 1];
+      return A_Continue;
+      }
+   else if (cnv:string(callee, callee)) {
+      proc = strprc(&callee, (C_integer)nargs);
+      if (proc == NULL)
+         RunErr(106, &callee);
+      return (*(proc)->ccode)(nargs, args, rslt, succ_cont);
+      }
+   else
+      RunErr(106, &callee);
+   }
+
+
+/*
+ * apply - implement binary bang. Construct an argument list for
+ *   invoke() from the callee and the list it is applied to.
+ */
+int apply(callee, strct, rslt, succ_cont)
+dptr callee;
+dptr strct;
+dptr rslt;
+continuation succ_cont;
+   {
+   tended struct descrip dstrct;
+   struct tend_desc *tnd_args;  /* place to tend arguments to invoke() */
+   union block *ep;
+   int nargs;
+   word i, j;
+   word indx;
+   int signal;
+
+   deref(strct, &dstrct);
+
+   switch (Type(dstrct)) {
+
+      case T_List: {
+         /*
+          * Copy the arguments from the list into an tended array of descriptors.
+          */
+         nargs = BlkLoc(dstrct)->list.size + 1;
+         tnd_args = malloc(sizeof(struct tend_desc)
+            + (nargs - 1) * sizeof(struct descrip));
+         if (tnd_args == NULL)
+            RunErr(305, NULL);
+
+         tnd_args->d[0] = *callee;
+         indx = 1;
+         for (ep = BlkLoc(dstrct)->list.listhead;
+#ifdef ListFix
+	      BlkType(ep) == T_Lelem;
+#else					/* ListFix */
+	      ep != NULL;
+#endif					/* ListFix */
+	      ep = ep->lelem.listnext) {
+            for (i = 0; i < ep->lelem.nused; i++) {
+               j = ep->lelem.first + i;
+               if (j >= ep->lelem.nslots)
+                  j -= ep->lelem.nslots;
+               tnd_args->d[indx++] = ep->lelem.lslots[j];
+               }
+            }
+         tnd_args->num = nargs;
+         tnd_args->previous = tend;
+         tend = tnd_args;
+
+         signal = invoke(indx, tnd_args->d, rslt, succ_cont);
+
+         tend = tnd_args->previous;
+         free(tnd_args);
+         return signal;
+         }
+      case T_Record: {
+         /*
+          * Copy the arguments from the record into an tended array
+          * of descriptors.
+          */
+         nargs = BlkLoc(dstrct)->record.recdesc->proc.nfields;
+         tnd_args = malloc(sizeof(struct tend_desc)
+            + (nargs - 1) * sizeof(struct descrip));
+         if (tnd_args == NULL)
+            RunErr(305, NULL);
+
+         tnd_args->d[0] = *callee;
+         indx = 1;
+         ep = BlkLoc(dstrct);
+         for (i = 0; i < nargs; i++)
+            tnd_args->d[indx++] = ep->record.fields[i];
+         tnd_args->num = nargs;
+         tnd_args->previous = tend;
+         tend = tnd_args;
+
+         signal = invoke(indx, tnd_args->d, rslt, succ_cont);
+
+         tend = tnd_args->previous;
+         free(tnd_args);
+         return signal;
+         }
+      default: {
+         RunErr(126, &dstrct);
+         }
+      }
+   }
+
+#else					/* COMPILER */
+
+#ifdef EventMon
+#include "../h/opdefs.h"
+#endif					/* EventMon */
+
+
+/*
+ * invoke -- Perform setup for invocation.
+ */
+int invoke(nargs,cargp,n)
+dptr *cargp;
+int nargs, *n;
+{
+   register struct pf_marker *newpfp;
+   register dptr newargp;
+   register word *newsp = sp;
+   tended struct descrip arg_sv;
+   register word i;
+   struct b_proc *proc;
+   int nparam;
+
+   /*
+    * Point newargp at Arg0 and dereference it.
+    */
+   newargp = (dptr )(sp - 1) - nargs;
+
+   xnargs = nargs;
+   xargp = newargp;
+
+   Deref(newargp[0]);
+
+   /*
+    * See what course the invocation is to take.
+    */
+   if (newargp->dword != D_Proc) {
+      C_integer tmp;
+      /*
+       * Arg0 is not a procedure.
+       */
+
+      if (cnv:C_integer(newargp[0], tmp)) {
+         MakeInt(tmp,&newargp[0]);
+
+         /*
+	  * Arg0 is an integer, select result.
+	  */
+         i = cvpos(IntVal(newargp[0]), (word)nargs);
+         if (i == CvtFail || i > nargs)
+            return I_Fail;
+         newargp[0] = newargp[i];
+         sp = (word *)newargp + 1;
+         return I_Continue;
+         }
+      else {
+         struct b_proc *tmp;
+         /*
+	  * See if Arg0 can be converted to a string that names a procedure
+	  *  or operator.  If not, generate run-time error 106.
+	  */
+	 if (!cnv:tmp_string(newargp[0],newargp[0]) ||
+	     ((tmp = strprc(newargp, (C_integer)nargs)) == NULL)) {
+            err_msg(106, newargp);
+            return I_Fail;
+            }
+	 BlkLoc(newargp[0]) = (union block *)tmp;
+	 newargp[0].dword = D_Proc;
+	 }
+      }
+
+   /*
+    * newargp[0] is now a descriptor suitable for invocation.  Dereference
+    *  the supplied arguments.
+    */
+
+   proc = (struct b_proc *)BlkLoc(newargp[0]);
+   if (proc->nstatic >= 0)	/* if negative, don't reference arguments */
+      for (i = 1; i <= nargs; i++)
+         Deref(newargp[i]);
+
+   /*
+    * Adjust the argument list to conform to what the routine being invoked
+    *  expects (proc->nparam).  If nparam is less than 0, the number of
+    *  arguments is variable. For functions (ndynam = -1) with a
+    *  variable number of arguments, nothing need be done.  For Icon procedures
+    *  with a variable number of arguments, arguments beyond abs(nparam) are
+    *  put in a list which becomes the last argument.  For fix argument
+    *  routines, if too many arguments were supplied, adjusting the stack
+    *  pointer is all that is necessary. If too few arguments were supplied,
+    *  null descriptors are pushed for each missing argument.
+    */
+
+   proc = (struct b_proc *)BlkLoc(newargp[0]);
+   nparam = (int)proc->nparam;
+   if (nparam >= 0) {
+      if (nargs > nparam)
+         newsp -= (nargs - nparam) * 2;
+      else if (nargs < nparam) {
+         i = nparam - nargs;
+         while (i--) {
+            *++newsp = D_Null;
+            *++newsp = 0;
+            }
+         }
+      nargs = nparam;
+
+      xnargs = nargs;
+
+      }
+   else {
+      if (proc->ndynam >= 0) { /* this is a procedure */
+         int lelems;
+	 dptr llargp;
+
+         if (nargs < abs(nparam) - 1) {
+            i = abs(nparam) - 1 - nargs;
+            while (i--) {
+               *++newsp = D_Null;
+               *++newsp = 0;
+               }
+            nargs = abs(nparam) - 1;
+            }
+
+	 lelems = nargs - (abs(nparam) - 1);
+         llargp = &newargp[abs(nparam)];
+         arg_sv = llargp[-1];
+
+	 Ollist(lelems, &llargp[-1]);
+
+	 llargp[0] = llargp[-1];
+	 llargp[-1] = arg_sv;
+         /*
+          *  Reload proc pointer in case Ollist triggered a garbage collection.
+          */
+         proc = (struct b_proc *)BlkLoc(newargp[0]);
+	 newsp = (word *)llargp + 1;
+	 nargs = abs(nparam);
+	 }
+      }
+
+   if (proc->ndynam < 0) {
+      /*
+       * A function is being invoked, so nothing else here needs to be done.
+       */
+
+      if (nargs < abs(nparam) - 1) {
+         i = abs(nparam) - 1 - nargs;
+         while (i--) {
+            *++newsp = D_Null;
+            *++newsp = 0;
+            }
+         nargs = abs(nparam) - 1;
+         }
+
+      *n = nargs;
+      *cargp = newargp;
+      sp = newsp;
+
+      EVVal((word)Op_Invoke,E_Ecall);
+
+      if ((nparam < 0) || (proc->ndynam == -2))
+         return I_Vararg;
+      else
+         return I_Builtin;
+      }
+
+#ifndef MultiThread
+   /*
+    * Make a stab at catching interpreter stack overflow.  This does
+    * nothing for invocation in a co-expression other than &main.
+    */
+   if (BlkLoc(k_current) == BlkLoc(k_main) &&
+      ((char *)sp + PerilDelta) > (char *)stackend)
+         fatalerr(301, NULL);
+#endif					/* MultiThread */
+
+   /*
+    * Build the procedure frame.
+    */
+   newpfp = (struct pf_marker *)(newsp + 1);
+   newpfp->pf_nargs = nargs;
+   newpfp->pf_argp = glbl_argp;
+   newpfp->pf_pfp = pfp;
+   newpfp->pf_ilevel = ilevel;
+   newpfp->pf_scan = NULL;
+
+   newpfp->pf_ipc = ipc;
+   newpfp->pf_gfp = gfp;
+   newpfp->pf_efp = efp;
+
+#ifdef MultiThread
+   newpfp->pf_prog = curpstate;
+#endif					/* MultiThread */
+
+   glbl_argp = newargp;
+   pfp = newpfp;
+   newsp += Vwsizeof(*pfp);
+
+   /*
+    * If tracing is on, use ctrace to generate a message.
+    */
+   if (k_trace) {
+      k_trace--;
+      ctrace(&(proc->pname), nargs, &newargp[1]);
+      }
+
+   /*
+    * Point ipc at the icode entry point of the procedure being invoked.
+    */
+   ipc.opnd = (word *)proc->entryp.icode;
+
+#ifdef MultiThread
+   /*
+    * Enter the program state of the procedure being invoked.
+    */
+   if (!InRange(code, ipc.opnd, ecode)) {
+      syserr("interprogram procedure calls temporarily prohibited\n");
+      }
+#endif					/* MultiThread */
+
+   efp = 0;
+   gfp = 0;
+
+   /*
+    * Push a null descriptor on the stack for each dynamic local.
+    */
+   for (i = proc->ndynam; i > 0; i--) {
+      *++newsp = D_Null;
+      *++newsp = 0;
+      }
+   sp = newsp;
+   k_level++;
+
+   EVValD(newargp, E_Pcall);
+
+   return I_Continue;
+}
+
+#endif					/* COMPILER */
diff --git a/src/runtime/keyword.r b/src/runtime/keyword.r
new file mode 100644
index 0000000..e6eb462
--- /dev/null
+++ b/src/runtime/keyword.r
@@ -0,0 +1,752 @@
+/*
+ * File: keyword.r
+ *  Contents: all keywords
+ *
+ *  After adding keywords, be sure to rerun ../icont/mkkwd.
+ */
+
+#define KDef(p,n) int Cat(K,p) (dptr cargp);
+#include "../h/kdefs.h"
+#undef KDef
+
+"&allocated - the space used in the storage regions:"
+" total, static, string, and block"
+keyword{4} allocated
+   abstract {
+      return integer
+      }
+   inline {
+      suspend C_integer stattotal + strtotal + blktotal;
+      suspend C_integer stattotal;
+      suspend C_integer strtotal;
+      return  C_integer blktotal;
+      }
+end
+
+"&clock - a string consisting of the current time of day"
+keyword{1} clock
+   abstract {
+      return string
+      }
+   inline {
+      time_t t;
+      struct tm *ct;
+      char sbuf[9], *tmp;
+
+      time(&t);
+      ct = localtime(&t);
+      sprintf(sbuf,"%02d:%02d:%02d", ct->tm_hour, ct->tm_min, ct->tm_sec);
+      Protect(tmp = alcstr(sbuf,(word)8), runerr(0));
+      return string(8, tmp);
+      }
+end
+
+"&collections - the number of collections: total, triggered by static requests"
+" triggered by string requests, and triggered by block requests"
+keyword{4} collections
+   abstract {
+      return integer
+      }
+   inline {
+      suspend C_integer coll_tot;
+      suspend C_integer coll_stat;
+      suspend C_integer coll_str;
+      return  C_integer coll_blk;
+      }
+end
+
+#if !COMPILER
+"&column - source column number of current execution point"
+keyword{1} column
+   abstract {
+      return integer;
+      }
+   inline {
+#ifdef MultiThread
+#ifdef EventMon
+      return C_integer findcol(ipc.opnd);
+#else					/* EventMon */
+      fail;
+#endif					/* EventMon */
+#else
+      fail;
+#endif					/* MultiThread */
+      }
+end
+#endif					/* !COMPILER */
+
+"&current - the currently active co-expression"
+keyword{1} current
+   abstract {
+      return coexpr
+      }
+   inline {
+      return k_current;
+      }
+end
+
+"&date - the current date"
+keyword{1} date
+   abstract {
+      return string
+      }
+   inline {
+      time_t t;
+      struct tm *ct;
+      char sbuf[11], *tmp;
+
+      time(&t);
+      ct = localtime(&t);
+      sprintf(sbuf, "%04d/%02d/%02d",
+         1900 + ct->tm_year, ct->tm_mon + 1, ct->tm_mday);
+      Protect(tmp = alcstr(sbuf,(word)10), runerr(0));
+      return string(10, tmp);
+      }
+end
+
+"&dateline - current date and time"
+keyword{1} dateline
+   abstract {
+      return string
+      }
+   body {
+      static char *day[] = {
+         "Sunday", "Monday", "Tuesday", "Wednesday",
+         "Thursday", "Friday", "Saturday"
+         };
+      static char *month[] = {
+         "January", "February", "March", "April", "May", "June",
+         "July", "August", "September", "October", "November", "December"
+         };
+      time_t t;
+      struct tm *ct;
+      char sbuf[MaxCvtLen];
+      int hour;
+      char *merid, *tmp;
+      int i;
+
+      time(&t);
+      ct = localtime(&t);
+      if ((hour = ct->tm_hour) >= 12) {
+         merid = "pm";
+         if (hour > 12)
+            hour -= 12;
+         }
+      else {
+         merid = "am";
+         if (hour < 1)
+            hour += 12;
+         }
+      sprintf(sbuf, "%s, %s %d, %d  %d:%02d %s", day[ct->tm_wday],
+         month[ct->tm_mon], ct->tm_mday, 1900 + ct->tm_year, hour,
+	 ct->tm_min, merid);
+       i = strlen(sbuf);
+       Protect(tmp = alcstr(sbuf, i), runerr(0));
+       return string(i, tmp);
+       }
+end
+
+"&digits - a cset consisting of the 10 decimal digits"
+keyword{1} digits
+   constant '0123456789'
+end
+
+"&e - the base of the natural logarithms"
+keyword{1} e
+   constant 2.71828182845904523536028747135266249775724709369996
+end
+
+"&error - enable/disable error conversion"
+keyword{1} error
+   abstract {
+      return kywdint
+      }
+   inline {
+      return kywdint(&kywd_err);
+      }
+end
+
+"&errornumber - error number of last error converted to failure"
+keyword{0,1} errornumber
+   abstract {
+      return integer
+      }
+   inline {
+      if (k_errornumber == 0)
+         fail;
+      return C_integer k_errornumber;
+      }
+end
+
+"&errortext - error message of last error converted to failure"
+keyword{0,1} errortext
+   abstract {
+      return string
+      }
+   inline {
+      if (k_errornumber == 0)
+         fail;
+      return C_string k_errortext;
+      }
+end
+
+"&errorvalue - erroneous value of last error converted to failure"
+keyword{0,1} errorvalue
+   abstract {
+      return any_value
+      }
+   inline {
+      if (have_errval)
+         return k_errorvalue;
+      else
+         fail;
+      }
+end
+
+"&errout - standard error output."
+keyword{1} errout
+    abstract {
+       return file
+       }
+    inline {
+       return file(&k_errout);
+       }
+end
+
+"&fail - just fail"
+keyword{0} fail
+   abstract {
+      return empty_type
+      }
+   inline {
+      fail;
+      }
+end
+
+"&eventcode - event in monitored program"
+keyword{0,1} eventcode
+   abstract {
+      return kywdevent
+      }
+   inline {
+      return kywdevent(&k_eventcode);
+      }
+end
+
+"&eventsource - source of events in monitoring program"
+keyword{0,1} eventsource
+   abstract {
+      return kywdevent
+      }
+   inline {
+      return kywdevent(&k_eventsource);
+      }
+end
+
+"&eventvalue - value from event in monitored program"
+keyword{0,1} eventvalue
+   abstract {
+      return kywdevent
+      }
+   inline {
+      return kywdevent(&k_eventvalue);
+      }
+end
+
+"&features - generate strings identifying features in this version of Icon"
+keyword{1,*} features
+   abstract {
+      return string
+      }
+   body {
+#if COMPILER
+#define Feature(guard,sym,kwval) if ((guard) && (kwval)) suspend C_string kwval;
+#else					/* COMPILER */
+#define Feature(guard,sym,kwval) if (kwval) suspend C_string kwval;
+#endif					/* COMPILER */
+#include "../h/features.h"
+      fail;
+      }
+end
+
+"&file - name of the source file for the current execution point"
+keyword{1} file
+   abstract {
+      return string
+      }
+   inline {
+#if COMPILER
+      if (line_info)
+         return C_string file_name;
+      else
+         runerr(402);
+#else					/* COMPILER */
+      char *s;
+      s = findfile(ipc.opnd);
+      if (!strcmp(s,"?")) fail;
+      return C_string s;
+#endif					/* COMPILER */
+      }
+end
+
+"&host - a string that identifies the host computer Icon is running on."
+keyword{1} host
+   abstract {
+     return string
+     }
+   inline {
+      char sbuf[MaxCvtLen], *tmp;
+      int i;
+
+      iconhost(sbuf);
+      i = strlen(sbuf);
+      Protect(tmp = alcstr(sbuf, i), runerr(0));
+      return string(i, tmp);
+      }
+end
+
+"&input - the standard input file"
+keyword{1} input
+   abstract {
+      return file
+      }
+   inline {
+      return file(&k_input);
+      }
+end
+
+"&lcase - a cset consisting of the 26 lower case letters"
+keyword{1} lcase
+   constant 'abcdefghijklmnopqrstuvwxyz'
+end
+
+"&letters - a cset consisting of the 52 letters"
+keyword{1} letters
+   constant 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+end
+
+"&level - level of procedure call."
+keyword{1} level
+   abstract {
+      return integer
+      }
+
+   inline {
+#if COMPILER
+      if (!debug_info)
+         runerr(402);
+#endif					/* COMPILER */
+      return C_integer k_level;
+      }
+end
+
+"&line - source line number of current execution point"
+keyword{1} line
+   abstract {
+      return integer;
+      }
+   inline {
+#if COMPILER
+      if (line_info)
+         return C_integer line_num;
+      else
+         runerr(402);
+#else					/* COMPILER */
+      return C_integer findline(ipc.opnd);
+#endif					/* COMPILER */
+      }
+end
+
+"&main - the main co-expression."
+keyword{1} main
+   abstract {
+      return coexpr
+      }
+   inline {
+      return k_main;
+      }
+end
+
+"&null - the null value."
+keyword{1} null
+   abstract {
+      return null
+      }
+   inline {
+      return nulldesc;
+      }
+end
+
+"&output - the standard output file."
+keyword{1} output
+   abstract {
+      return file
+      }
+   inline {
+      return file(&k_output);
+      }
+end
+
+"&phi - the golden ratio"
+keyword{1} phi
+   constant 1.618033988749894848204586834365638117720309180
+end
+
+"&pi - the ratio of circumference to diameter"
+keyword{1} pi
+   constant 3.14159265358979323846264338327950288419716939937511
+end
+
+"&pos - a variable containing the current focus in string scanning."
+keyword{1} pos
+   abstract {
+      return kywdpos
+      }
+    inline {
+      return kywdpos(&kywd_pos);
+      }
+end
+
+"&progname - a variable containing the program name."
+keyword{1} progname
+   abstract {
+      return kywdstr
+      }
+    inline {
+      return kywdstr(&kywd_prog);
+      }
+end
+
+"&random - a variable containing the current seed for random operations."
+keyword{1} random
+   abstract {
+      return kywdint
+      }
+   inline {
+      return kywdint(&kywd_ran);
+      }
+end
+
+"&regions - generates regions sizes"
+keyword{3} regions
+   abstract {
+      return integer
+      }
+   inline {
+      word allRegions = 0;
+      struct region *rp;
+
+      suspend C_integer 0;		/* static region */
+
+      allRegions = DiffPtrs(strend,strbase);
+      for (rp = curstring->next; rp; rp = rp->next)
+	 allRegions += DiffPtrs(rp->end,rp->base);
+      for (rp = curstring->prev; rp; rp = rp->prev)
+	 allRegions += DiffPtrs(rp->end,rp->base);
+      suspend C_integer allRegions;	/* string region */
+
+      allRegions = DiffPtrs(blkend,blkbase);
+      for (rp = curblock->next; rp; rp = rp->next)
+	 allRegions += DiffPtrs(rp->end,rp->base);
+      for (rp = curblock->prev; rp; rp = rp->prev)
+	 allRegions += DiffPtrs(rp->end,rp->base);
+      return C_integer allRegions;	/* block region */
+      }
+end
+
+"&source - the co-expression that invoked the current co-expression."
+keyword{1} source
+   abstract {
+       return coexpr
+       }
+   inline {
+#ifndef Coexpr
+         return k_main;
+#else					/* Coexpr */
+         return coexpr(topact((struct b_coexpr *)BlkLoc(k_current)));
+#endif					/* Coexpr */
+         }
+end
+
+"&storage - generate the amount of storage used for each region."
+keyword{3} storage
+   abstract {
+      return integer
+      }
+   inline {
+      word allRegions = 0;
+      struct region *rp;
+
+      suspend C_integer 0;		/* static region */
+
+      allRegions = DiffPtrs(strfree,strbase);
+      for (rp = curstring->next; rp; rp = rp->next)
+	 allRegions += DiffPtrs(rp->free,rp->base);
+      for (rp = curstring->prev; rp; rp = rp->prev)
+	 allRegions += DiffPtrs(rp->free,rp->base);
+      suspend C_integer allRegions;	/* string region */
+
+      allRegions = DiffPtrs(blkfree,blkbase);
+      for (rp = curblock->next; rp; rp = rp->next)
+	 allRegions += DiffPtrs(rp->free,rp->base);
+      for (rp = curblock->prev; rp; rp = rp->prev)
+	 allRegions += DiffPtrs(rp->free,rp->base);
+      return C_integer allRegions;	/* block region */
+      }
+end
+
+"&subject - variable containing the current subject of string scanning."
+keyword{1} subject
+   abstract {
+      return kywdsubj
+      }
+   inline {
+      return kywdsubj(&k_subject);
+      }
+end
+
+"&time - the elapsed execution time in milliseconds."
+keyword{1} time
+   abstract {
+      return integer
+      }
+   inline {
+      return C_integer millisec();
+      }
+end
+
+"&trace - variable that controls procedure tracing."
+keyword{1} trace
+   abstract {
+      return kywdint
+      }
+   inline {
+      return kywdint(&kywd_trc);
+      }
+end
+
+"&dump - variable that controls termination dump."
+keyword{1} dump
+   abstract {
+      return kywdint
+      }
+   inline {
+      return kywdint(&kywd_dmp);
+      }
+end
+
+"&ucase - a cset consisting of the 26 uppercase characters."
+keyword{1} ucase
+   constant 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+end
+
+"&version - a string indentifying this version of Icon."
+keyword{1} version
+   constant Version
+end
+
+#ifndef MultiThread
+struct descrip kywd_xwin[2] = {{D_Null}};
+#endif					/* MultiThread */
+
+"&window - variable containing the current graphics rendering context."
+#ifdef Graphics
+keyword{1} window
+   abstract {
+      return kywdwin
+      }
+   inline {
+      return kywdwin(kywd_xwin + XKey_Window);
+      }
+end
+#else					/* Graphics */
+keyword{0} window
+   abstract {
+      return empty_type
+      }
+   inline {
+      fail;
+      }
+end
+#endif					/* Graphics */
+
+#ifdef Graphics
+"&col - mouse horizontal position in text columns."
+keyword{1} col
+   abstract { return kywdint }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else return kywdint(&amperCol); }
+end
+
+"&row - mouse vertical position in text rows."
+keyword{1} row
+   abstract { return kywdint }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else return kywdint(&amperRow); }
+end
+
+"&x - mouse horizontal position."
+keyword{1} x
+   abstract { return kywdint }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else return kywdint(&amperX); }
+end
+
+"&y - mouse vertical position."
+keyword{1} y
+   abstract { return kywdint }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else return kywdint(&amperY); }
+end
+
+"&interval - milliseconds since previous event."
+keyword{1} interval
+   abstract { return kywdint }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else return kywdint(&amperInterval); }
+end
+
+"&control - null if control key was down on last X event, else failure"
+keyword{0,1} control
+   abstract { return null }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else if (xmod_control) return nulldesc; else fail; }
+end
+
+"&shift - null if shift key was down on last X event, else failure"
+keyword{0,1} shift
+   abstract { return null }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else if (xmod_shift) return nulldesc; else fail; }
+end
+
+"&meta - null if meta key was down on last X event, else failure"
+keyword{0,1} meta
+   abstract { return null }
+   inline { if (is:null(lastEventWin)) runerr(140, lastEventWin);
+	    else if (xmod_meta) return nulldesc; else fail; }
+end
+#else					/* Graphics */
+"&col - mouse horizontal position in text columns."
+keyword{0} col
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&row - mouse vertical position in text rows."
+keyword{0} row
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&x - mouse horizontal position."
+keyword{0} x
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&y - mouse vertical position."
+keyword{0} y
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&interval - milliseconds since previous event."
+keyword{0} interval
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&control - null if control key was down on last X event, else failure"
+keyword{0} control
+   abstract { return empty_type}
+   inline { fail; }
+end
+
+"&shift - null if shift key was down on last X event, else failure"
+keyword{0} shift
+   abstract { return empty_type }
+   inline { fail; }
+end
+
+"&meta - null if meta key was down on last X event, else failure"
+keyword{0} meta
+   abstract { return empty_type }
+   inline { fail; }
+end
+#endif					/* Graphics */
+
+"&lpress - left button press."
+keyword{1} lpress
+   abstract { return integer} inline { return C_integer MOUSELEFT; }
+end
+"&mpress - middle button press."
+keyword{1} mpress
+   abstract { return integer} inline { return C_integer MOUSEMID; }
+end
+"&rpress - right button press."
+keyword{1} rpress
+   abstract { return integer} inline { return C_integer MOUSERIGHT; }
+end
+"&lrelease - left button release."
+keyword{1} lrelease
+   abstract { return integer} inline { return C_integer MOUSELEFTUP; }
+end
+"&mrelease - middle button release."
+keyword{1} mrelease
+   abstract { return integer} inline { return C_integer MOUSEMIDUP; }
+end
+"&rrelease - right button release."
+keyword{1} rrelease
+   abstract { return integer} inline { return C_integer MOUSERIGHTUP; }
+end
+"&ldrag - left button drag."
+keyword{1} ldrag
+   abstract { return integer} inline { return C_integer MOUSELEFTDRAG; }
+end
+"&mdrag - middle button drag."
+keyword{1} mdrag
+   abstract { return integer} inline { return C_integer MOUSEMIDDRAG; }
+end
+"&rdrag - right button drag."
+keyword{1} rdrag
+   abstract { return integer} inline { return C_integer MOUSERIGHTDRAG; }
+end
+"&resize - window resize."
+keyword{1} resize
+   abstract { return integer} inline { return C_integer RESIZED; }
+end
+
+"&ascii - a cset consisting of the 128 ascii characters"
+keyword{1} ascii
+constant '\
+\000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\
+\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037\
+\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057\
+\060\061\062\063\064\065\066\067\070\071\072\073\074\075\076\077\
+\100\101\102\103\104\105\106\107\110\111\112\113\114\115\116\117\
+\120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137\
+\140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157\
+\160\161\162\163\164\165\166\167\170\171\172\173\174\175\176\177'
+end
+
+"&cset - a cset consisting of all the 256 characters."
+keyword{1} cset
+constant '\
+\0\1\2\3\4\5\6\7\10\11\12\13\14\15\16\17\
+\20\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37\
+\40\41\42\43\44\45\46\47\50\51\52\53\54\55\56\57\
+\60\61\62\63\64\65\66\67\70\71\72\73\74\75\76\77\
+\100\101\102\103\104\105\106\107\110\111\112\113\114\115\116\117\
+\120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137\
+\140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157\
+\160\161\162\163\164\165\166\167\170\171\172\173\174\175\176\177\
+\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\
+\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\
+\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\
+\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\
+\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\
+\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\
+\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\
+\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377'
+end
diff --git a/src/runtime/lmisc.r b/src/runtime/lmisc.r
new file mode 100644
index 0000000..11f29de
--- /dev/null
+++ b/src/runtime/lmisc.r
@@ -0,0 +1,176 @@
+/*
+ * file: lmisc.r
+ *   Contents: [O]create, activate
+ */
+
+/*
+ * create - return an entry block for a co-expression.
+ */
+#if COMPILER
+struct b_coexpr *create(fnc, cproc, ntemps, wrk_size)
+continuation fnc;
+struct b_proc *cproc;
+int ntemps;
+int wrk_size;
+#else					/* COMPILER */
+
+int Ocreate(entryp, cargp)
+word *entryp;
+register dptr cargp;
+#endif					/* COMPILER */
+   {
+
+#ifdef Coexpr
+   tended struct b_coexpr *sblkp;
+   register struct b_refresh *rblkp;
+   register dptr dp, ndp;
+   int na, nl, i;
+
+#if !COMPILER
+   struct b_proc *cproc;
+
+   /* cproc is the Icon procedure that create occurs in */
+   cproc = (struct b_proc *)BlkLoc(glbl_argp[0]);
+#endif					/* COMPILER */
+
+   /*
+    * Calculate number of arguments and number of local variables.
+    */
+#if COMPILER
+   na = abs((int)cproc->nparam);
+#else					/* COMPILER */
+   na = pfp->pf_nargs + 1;  /* includes Arg0 */
+#endif					/* COMPILER */
+   nl = (int)cproc->ndynam;
+
+   /*
+    * Get a new co-expression stack and initialize.
+    */
+
+#ifdef MultiThread
+   Protect(sblkp = alccoexp(0, 0), err_msg(0, NULL));
+#else					/* MultiThread */
+   Protect(sblkp = alccoexp(), err_msg(0, NULL));
+#endif					/* MultiThread */
+
+
+   if (!sblkp)
+#if COMPILER
+      return NULL;
+#else					/* COMPILER */
+      Fail;
+#endif					/* COMPILER */
+
+   /*
+    * Get a refresh block for the new co-expression.
+    */
+#if COMPILER
+   Protect(rblkp = alcrefresh(na, nl, ntemps, wrk_size), err_msg(0,NULL));
+#else					/* COMPILER */
+   Protect(rblkp = alcrefresh(entryp, na, nl),err_msg(0,NULL));
+#endif					/* COMPILER */
+   if (!rblkp)
+#if COMPILER
+      return NULL;
+#else					/* COMPILER */
+      Fail;
+#endif					/* COMPILER */
+
+   sblkp->freshblk.dword = D_Refresh;
+   BlkLoc(sblkp->freshblk) = (union block *) rblkp;
+
+#if !COMPILER
+   /*
+    * Copy current procedure frame marker into refresh block.
+    */
+   rblkp->pfmkr = *pfp;
+   rblkp->pfmkr.pf_pfp = 0;
+#endif					/* COMPILER */
+
+   /*
+    * Copy arguments into refresh block.
+    */
+   ndp = rblkp->elems;
+   dp = glbl_argp;
+   for (i = 1; i <= na; i++)
+      *ndp++ = *dp++;
+
+   /*
+    * Copy locals into the refresh block.
+    */
+#if COMPILER
+   dp = pfp->tend.d;
+#else					/* COMPILER */
+   dp = &(pfp->pf_locals)[0];
+#endif					/* COMPILER */
+   for (i = 1; i <= nl; i++)
+      *ndp++ = *dp++;
+
+   /*
+    * Use the refresh block to finish initializing the co-expression stack.
+    */
+   co_init(sblkp);
+
+#if COMPILER
+   sblkp->fnc = fnc;
+   if (line_info) {
+      if (debug_info)
+         PFDebug(sblkp->pf)->proc = cproc;
+      PFDebug(sblkp->pf)->old_fname = "";
+      PFDebug(sblkp->pf)->old_line = 0;
+      }
+
+   return sblkp;
+#else					/* COMPILER */
+   /*
+    * Return the new co-expression.
+    */
+   Arg0.dword = D_Coexpr;
+   BlkLoc(Arg0) = (union block *) sblkp;
+   Return;
+#endif					/* COMPILER */
+#else					/* Coexpr */
+   err_msg(401, NULL);
+#if COMPILER
+   return NULL;
+#else					/* COMPILER */
+   Fail;
+#endif					/* COMPILER */
+#endif					/* Coexpr */
+
+   }
+
+/*
+ * activate - activate a co-expression.
+ */
+int activate(val, ncp, result)
+dptr val;
+struct b_coexpr *ncp;
+dptr result;
+   {
+#ifdef Coexpr
+
+   int first;
+
+   /*
+    * Set activator in new co-expression.
+    */
+   if (ncp->es_actstk == NULL) {
+      Protect(ncp->es_actstk = alcactiv(),RunErr(0,NULL));
+      first = 0;
+      }
+   else
+      first = 1;
+
+   if (pushact(ncp, (struct b_coexpr *)BlkLoc(k_current)) == Error)
+      RunErr(0,NULL);
+
+   if (co_chng(ncp, val, result, A_Coact, first) == A_Cofail)
+      return A_Resume;
+   else
+      return A_Continue;
+
+#else					/* Coexpr */
+   RunErr(401,NULL);
+#endif					/* Coexpr */
+   }
diff --git a/src/runtime/oarith.r b/src/runtime/oarith.r
new file mode 100644
index 0000000..b3ca88c
--- /dev/null
+++ b/src/runtime/oarith.r
@@ -0,0 +1,502 @@
+/*
+ * File: oarith.r
+ *  Contents: arithmetic operators + - * / % ^.  Auxiliary routines
+ *   iipow, ripow.
+ *
+ * The arithmetic operators all follow a canonical conversion
+ * protocol encapsulated in the macro ArithOp.
+ */
+
+int over_flow = 0;
+
+#begdef ArithOp(icon_op, func_name, c_int_op, c_real_op)
+
+   operator{1} icon_op func_name(x, y)
+      declare {
+#ifdef LargeInts
+         tended struct descrip lx, ly;
+#endif					/* LargeInts */
+	 C_integer irslt;
+         }
+     arith_case (x, y) of {
+         C_integer: {
+            abstract {
+               return integer
+               }
+            inline {
+               extern int over_flow;
+               c_int_op(x,y);
+               }
+            }
+         integer: { /* large integers only */
+            abstract {
+               return integer
+               }
+            inline {
+               big_ ## c_int_op(x,y);
+               }
+            }
+         C_double: {
+            abstract {
+               return real
+               }
+            inline {
+               c_real_op(x, y);
+               }
+            }
+         }
+end
+
+#enddef
+
+/*
+ * x / y
+ */
+
+#begdef big_Divide(x,y)
+{
+   if ( ( Type ( y ) == T_Integer ) && ( IntVal ( y ) == 0 ) )
+      runerr(201);  /* Divide fix */
+
+   if (bigdiv(&x,&y,&result) == Error) /* alcbignum failed */
+      runerr(0);
+   return result;
+}
+#enddef
+#begdef Divide(x,y)
+{
+   if ( y == 0 )
+      runerr(201);  /* divide fix */
+
+   irslt = div3(x,y);
+   if (over_flow) {
+#ifdef LargeInts
+      MakeInt(x,&lx);
+      MakeInt(y,&ly);
+      if (bigdiv(&lx,&ly,&result) == Error) /* alcbignum failed */
+	 runerr(0);
+      return result;
+#else					/* LargeInts */
+      runerr(203);
+#endif					/* LargeInts */
+      }
+   else return C_integer irslt;
+}
+#enddef
+#begdef RealDivide(x,y)
+{
+   double z;
+
+   if (y == 0.0)
+      runerr(204);
+   z = x / y;
+   return C_double z;
+}
+#enddef
+
+
+ArithOp( / , divide , Divide , RealDivide)
+
+/*
+ * x - y
+ */
+
+#begdef big_Sub(x,y)
+{
+   if (bigsub(&x,&y,&result) == Error) /* alcbignum failed */
+      runerr(0);
+   return result;
+}
+#enddef
+
+#begdef Sub(x,y)
+   irslt = sub(x,y);
+   if (over_flow) {
+#ifdef LargeInts
+      MakeInt(x,&lx);
+      MakeInt(y,&ly);
+      if (bigsub(&lx,&ly,&result) == Error) /* alcbignum failed */
+         runerr(0);
+      return result;
+#else					/* LargeInts */
+      runerr(203);
+#endif					/* LargeInts */
+      }
+   else return C_integer irslt;
+#enddef
+
+#define RealSub(x,y) return C_double (x - y);
+
+ArithOp( - , minus , Sub , RealSub)
+
+
+/*
+ * x % y
+ */
+#define Abs(x) ((x) > 0 ? (x) : -(x))
+
+#begdef big_IntMod(x,y)
+{
+   if ( ( Type ( y ) == T_Integer ) && ( IntVal ( y ) == 0 ) ) {
+      irunerr(202,0);
+      errorfail;
+      }
+   if (bigmod(&x,&y,&result) == Error)
+      runerr(0);
+   return result;
+}
+#enddef
+
+#begdef IntMod(x,y)
+{
+   irslt = mod3(x,y);
+   if (over_flow) {
+      irunerr(202,y);
+      errorfail;
+      }
+   return C_integer irslt;
+}
+#enddef
+
+#begdef RealMod(x,y)
+{
+   double d;
+
+   if (y == 0.0)
+      runerr(204);
+
+   d = fmod(x, y);
+   /* d must have the same sign as x */
+   if (x < 0.0) {
+      if (d > 0.0) {
+         d -= Abs(y);
+         }
+      }
+   else if (d < 0.0) {
+      d += Abs(y);
+      }
+   return C_double d;
+}
+#enddef
+
+ArithOp( % , mod , IntMod , RealMod)
+
+/*
+ * x * y
+ */
+
+#begdef big_Mpy(x,y)
+{
+   if (bigmul(&x,&y,&result) == Error)
+      runerr(0);
+   return result;
+}
+#enddef
+
+#begdef Mpy(x,y)
+   irslt = mul(x,y);
+   if (over_flow) {
+#ifdef LargeInts
+      MakeInt(x,&lx);
+      MakeInt(y,&ly);
+      if (bigmul(&lx,&ly,&result) == Error) /* alcbignum failed */
+         runerr(0);
+      return result;
+#else					/* LargeInts */
+      runerr(203);
+#endif					/* LargeInts */
+      }
+   else return C_integer irslt;
+#enddef
+
+
+#define RealMpy(x,y) return C_double (x * y);
+
+ArithOp( * , mult , Mpy , RealMpy)
+
+
+"-x - negate x."
+
+operator{1} - neg(x)
+   if cnv:(exact)C_integer(x) then {
+      abstract {
+         return integer
+         }
+      inline {
+	    C_integer i;
+	    extern int over_flow;
+
+	    i = neg(x);
+	    if (over_flow) {
+#ifdef LargeInts
+	       struct descrip tmp;
+	       MakeInt(x,&tmp);
+	       if (bigneg(&tmp, &result) == Error)  /* alcbignum failed */
+	          runerr(0);
+               return result;
+#else					/* LargeInts */
+	       irunerr(203,x);
+               errorfail;
+#endif					/* LargeInts */
+               }
+         return C_integer i;
+         }
+      }
+#ifdef LargeInts
+   else if cnv:(exact) integer(x) then {
+      abstract {
+         return integer
+         }
+      inline {
+	 if (bigneg(&x, &result) == Error)  /* alcbignum failed */
+	    runerr(0);
+	 return result;
+         }
+      }
+#endif					/* LargeInts */
+   else {
+      if !cnv:C_double(x) then
+         runerr(102, x)
+      abstract {
+         return real
+         }
+      inline {
+         double drslt;
+	 drslt = -x;
+         return C_double drslt;
+         }
+      }
+end
+
+
+"+x - convert x to a number."
+/*
+ *  Operational definition: generate runerr if x is not numeric.
+ */
+operator{1} + number(x)
+   if cnv:(exact)C_integer(x) then {
+       abstract {
+          return integer
+          }
+       inline {
+          return C_integer x;
+          }
+      }
+#ifdef LargeInts
+   else if cnv:(exact) integer(x) then {
+       abstract {
+          return integer
+          }
+       inline {
+          return x;
+          }
+      }
+#endif					/* LargeInts */
+   else if cnv:C_double(x) then {
+       abstract {
+          return real
+          }
+       inline {
+          return C_double x;
+          }
+      }
+   else
+      runerr(102, x)
+end
+
+/*
+ * x + y
+ */
+
+#begdef big_Add(x,y)
+{
+   if (bigadd(&x,&y,&result) == Error)
+      runerr(0);
+   return result;
+}
+#enddef
+
+#begdef Add(x,y)
+   irslt = add(x,y);
+   if (over_flow) {
+#ifdef LargeInts
+      MakeInt(x,&lx);
+      MakeInt(y,&ly);
+      if (bigadd(&lx, &ly, &result) == Error)  /* alcbignum failed */
+	 runerr(0);
+      return result;
+#else					/* LargeInts */
+      runerr(203);
+#endif					/* LargeInts */
+      }
+   else return C_integer irslt;
+#enddef
+
+#define RealAdd(x,y) return C_double (x + y);
+
+ArithOp( + , plus , Add , RealAdd)
+
+
+"x ^ y - raise x to the y power."
+
+operator{1} ^ powr(x, y)
+   if cnv:(exact)C_integer(y) then {
+      if cnv:(exact)integer(x) then {
+	 abstract {
+	    return integer
+	    }
+	 inline {
+#ifdef LargeInts
+	    tended struct descrip ly;
+	    MakeInt ( y, &ly );
+	    if (bigpow(&x, &ly, &result) == Error)  /* alcbignum failed */
+	       runerr(0);
+	    return result;
+#else
+	    extern int over_flow;
+	    C_integer r = iipow(IntVal(x), y);
+	    if (over_flow)
+	       runerr(203);
+	    return C_integer r;
+#endif
+	   }
+	 }
+      else {
+	 if !cnv:C_double(x) then
+	    runerr(102, x)
+	 abstract {
+	    return real
+	    }
+	 inline {
+	    if (ripow( x, y, &result) ==  Error)
+	       runerr(0);
+	    return result;
+	    }
+	 }
+      }
+#ifdef LargeInts
+   else if cnv:(exact)integer(y) then {
+      if cnv:(exact)integer(x) then {
+	 abstract {
+	    return integer
+	    }
+	 inline {
+	    if (bigpow(&x, &y, &result) == Error)  /* alcbignum failed */
+	       runerr(0);
+	    return result;
+	    }
+	 }
+      else {
+	 if !cnv:C_double(x) then
+	    runerr(102, x)
+	 abstract {
+	    return real
+	    }
+	 inline {
+	    if ( bigpowri ( x, &y, &result ) == Error )
+	       runerr(0);
+	    return result;
+	    }
+	 }
+      }
+#endif					/* LargeInts */
+   else {
+      if !cnv:C_double(x) then
+	 runerr(102, x)
+      if !cnv:C_double(y) then
+	 runerr(102, y)
+      abstract {
+	 return real
+	 }
+      inline {
+	 if (x == 0.0 && y < 0.0)
+	     runerr(204);
+	 if (x < 0.0)
+	    runerr(206);
+	 return C_double pow(x,y);
+	 }
+      }
+end
+
+#if COMPILER || !(defined LargeInts)
+/*
+ * iipow - raise an integer to an integral power.
+ */
+C_integer iipow(n1, n2)
+C_integer n1, n2;
+   {
+   C_integer result;
+
+   /* Handle some special cases first */
+   over_flow = 0;
+   switch ( n1 ) {
+      case 1:
+	 return 1;
+      case -1:
+	 /* Result depends on whether n2 is even or odd */
+	 return ( n2 & 01 ) ? -1 : 1;
+      case 0:
+	 if ( n2 <= 0 )
+	    over_flow = 1;
+	 return 0;
+      default:
+	 if (n2 < 0)
+	    return 0;
+      }
+
+   result = 1L;
+   for ( ; ; ) {
+      if (n2 & 01L)
+	 {
+	 result = mul(result, n1);
+	 if (over_flow)
+	    return 0;
+	 }
+
+      if ( ( n2 >>= 1 ) == 0 ) break;
+      n1 = mul(n1, n1);
+      if (over_flow)
+	 return 0;
+      }
+   over_flow = 0;
+   return result;
+   }
+#endif					/* COMPILER || !(defined LargeInts) */
+
+
+/*
+ * ripow - raise a real number to an integral power.
+ */
+int ripow(r, n, drslt)
+double r;
+C_integer n;
+dptr drslt;
+   {
+   double retval;
+
+   if (r == 0.0 && n <= 0)
+      ReturnErrNum(204, Error);
+   if (n < 0) {
+      /*
+       * r ^ n = ( 1/r ) * ( ( 1/r ) ^ ( -1 - n ) )
+       *
+       * (-1) - n never overflows, even when n == MinLong.
+       */
+      n = (-1) - n;
+      r = 1.0 / r;
+      retval = r;
+      }
+   else
+      retval = 1.0;
+
+   /* multiply retval by r ^ n */
+   while (n > 0) {
+      if (n & 01L)
+	 retval *= r;
+      r *= r;
+      n >>= 1;
+      }
+   Protect(BlkLoc(*drslt) = (union block *)alcreal(retval), return Error);
+   drslt->dword = D_Real;
+   return Succeeded;
+   }
diff --git a/src/runtime/oasgn.r b/src/runtime/oasgn.r
new file mode 100644
index 0000000..b93d646
--- /dev/null
+++ b/src/runtime/oasgn.r
@@ -0,0 +1,522 @@
+/*
+ * File: oasgn.r
+ */
+
+/*
+ * Asgn - perform an assignment when the destination descriptor might
+ *  be within a block.
+ */
+#define Asgn(dest, src) *(dptr)((word *)VarLoc(dest) + Offset(dest)) = src;
+
+/*
+ * GeneralAsgn - perform the assignment x := y, where x is known to be
+ *  a variable and y is has been dereferenced.
+ */
+#begdef GeneralAsgn(x, y)
+
+#ifdef EventMon
+   body {
+      if (!is:null(curpstate->eventmask) &&
+         Testb((word)E_Assign, curpstate->eventmask)) {
+            EVAsgn(&x);
+	    }
+      }
+#endif					/* EventMon */
+
+   type_case x of {
+      tvsubs: {
+        abstract {
+           store[store[type(x).str_var]] = string
+           }
+        inline {
+           if (subs_asgn(&x, (const dptr)&y) == Error)
+              runerr(0);
+           }
+        }
+      tvtbl: {
+        abstract {
+           store[store[type(x).trpd_tbl].tbl_val] = type(y)
+           }
+        inline {
+           if (tvtbl_asgn(&x, (const dptr)&y) == Error)
+              runerr(0);
+           }
+         }
+      kywdevent:
+	 body {
+	    *VarLoc(x) = y;
+	    }
+      kywdwin:
+	 body {
+#ifdef Graphics
+	    if (is:null(y))
+	       *VarLoc(x) = y;
+	    else {
+	       if ((!is:file(y)) || !(BlkLoc(y)->file.status & Fs_Window))
+		  runerr(140,y);
+	       *VarLoc(x) = y;
+	       }
+#endif					/* Graphics */
+	    }
+      kywdint:
+	 {
+         /*
+          * No side effect in the type realm - keyword x is still an int.
+          */
+         body {
+            C_integer i;
+
+            if (!cnv:C_integer(y, i))
+               runerr(101, y);
+            IntVal(*VarLoc(x)) = i;
+
+#ifdef Graphics
+	    if (xyrowcol(&x) == -1)
+	       runerr(140,kywd_xwin[XKey_Window]);
+#endif					/* Graphics */
+	    }
+	}
+      kywdpos: {
+         /*
+          * No side effect in the type realm - &pos is still an int.
+          */
+         body {
+            C_integer i;
+
+            if (!cnv:C_integer(y, i))
+               runerr(101, y);
+
+#ifdef MultiThread
+	    i = cvpos((long)i, StrLen(*(VarLoc(x)+1)));
+#else					/* MultiThread */
+            i = cvpos((long)i, StrLen(k_subject));
+#endif					/* MultiThread */
+
+            if (i == CvtFail)
+               fail;
+	    IntVal(*VarLoc(x)) = i;
+
+            EVVal(k_pos, E_Spos);
+            }
+         }
+      kywdsubj: {
+         /*
+          * No side effect in the type realm - &subject is still a string
+          *  and &pos is still an int.
+          */
+         if !cnv:string(y, *VarLoc(x)) then
+            runerr(103, y);
+         inline {
+#ifdef MultiThread
+	    IntVal(*(VarLoc(x)-1)) = 1;
+#else					/* MultiThread */
+            k_pos = 1;
+#endif					/* MultiThread */
+            EVVal(k_pos, E_Spos);
+            }
+         }
+      kywdstr: {
+         /*
+          *  No side effect in the type realm.
+          */
+         if !cnv:string(y, *VarLoc(x)) then
+            runerr(103, y);
+         }
+      default: {
+         abstract {
+            store[type(x)] = type(y)
+            }
+         inline {
+            Asgn(x, y)
+            }
+         }
+      }
+
+#ifdef EventMon
+   body {
+      EVValD(&y, E_Value);
+      }
+#endif					/* EventMon */
+
+#enddef
+
+
+"x := y - assign y to x."
+
+operator{0,1} := asgn(underef x, y)
+
+   if !is:variable(x) then
+      runerr(111, x)
+
+   abstract {
+      return type(x)
+      }
+
+   GeneralAsgn(x, y)
+
+   inline {
+      /*
+       * The returned result is the variable to which assignment is being
+       *  made.
+       */
+      return x;
+      }
+end
+
+
+"x <- y - assign y to x."
+" Reverses assignment if resumed."
+
+operator{0,1+} <- rasgn(underef x -> saved_x, y)
+
+   if !is:variable(x) then
+      runerr(111, x)
+
+   abstract {
+      return type(x)
+      }
+
+   GeneralAsgn(x, y)
+
+   inline {
+      suspend x;
+      }
+
+   GeneralAsgn(x, saved_x)
+
+   inline {
+      fail;
+      }
+end
+
+
+"x <-> y - swap values of x and y."
+" Reverses swap if resumed."
+
+operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy)
+
+   declare {
+      tended union block *bp_x, *bp_y;
+      word adj1 = 0;
+      word adj2 = 0;
+      }
+
+   if !is:variable(x) then
+      runerr(111, x)
+   if !is:variable(y) then
+      runerr(111, y)
+
+   abstract {
+      return type(x)
+      }
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      body {
+         bp_x = BlkLoc(x);
+         bp_y = BlkLoc(y);
+         if (VarLoc(bp_x->tvsubs.ssvar) == VarLoc(bp_y->tvsubs.ssvar) &&
+	  Offset(bp_x->tvsubs.ssvar) == Offset(bp_y->tvsubs.ssvar)) {
+            /*
+             * x and y are both substrings of the same string, set
+             *  adj1 and adj2 for use in locating the substrings after
+             *  an assignment has been made.  If x is to the right of y,
+             *  set adj1 := *x - *y, otherwise if y is to the right of
+             *  x, set adj2 := *y - *x.  Note that the adjustment
+             *  values may be negative.
+             */
+            if (bp_x->tvsubs.sspos > bp_y->tvsubs.sspos)
+               adj1 = bp_x->tvsubs.sslen - bp_y->tvsubs.sslen;
+            else if (bp_y->tvsubs.sspos > bp_x->tvsubs.sspos)
+               adj2 = bp_y->tvsubs.sslen - bp_x->tvsubs.sslen;
+	    }
+         }
+
+   /*
+    * Do x := y
+    */
+   GeneralAsgn(x, dy)
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj2 != 0)
+            /*
+             * Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
+             *  shifted the position of Arg2.  Add adj2 to the position of Arg2
+             *  to account for the replacement of Arg1 by Arg2.
+             */
+            bp_y->tvsubs.sspos += adj2;
+         }
+
+   /*
+    * Do y := x
+    */
+   GeneralAsgn(y, dx)
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj1 != 0)
+            /*
+             * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1
+             *  has shifted the position of Arg1.  Add adj2 to the position
+             *  of Arg1 to account for the replacement of Arg2 by Arg1.
+             */
+            bp_x->tvsubs.sspos += adj1;
+         }
+
+   inline {
+      suspend x;
+      }
+   /*
+    * If resumed, the assignments are undone.  Note that the string position
+    *  adjustments are opposite those done earlier.
+    */
+   GeneralAsgn(x, dx)
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj2 != 0)
+           bp_y->tvsubs.sspos -= adj2;
+         }
+
+   GeneralAsgn(y, dy)
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj1 != 0)
+            bp_x->tvsubs.sspos -= adj1;
+         }
+
+   inline {
+      fail;
+      }
+end
+
+
+"x :=: y - swap values of x and y."
+
+operator{0,1} :=: swap(underef x -> dx, underef y -> dy)
+   declare {
+      tended union block *bp_x, *bp_y;
+      word adj1 = 0;
+      word adj2 = 0;
+      }
+
+   /*
+    * x and y must be variables.
+    */
+   if !is:variable(x) then
+      runerr(111, x)
+   if !is:variable(y) then
+      runerr(111, y)
+
+   abstract {
+      return type(x)
+      }
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      body {
+         bp_x = BlkLoc(x);
+         bp_y = BlkLoc(y);
+         if (VarLoc(bp_x->tvsubs.ssvar) == VarLoc(bp_y->tvsubs.ssvar) &&
+	  Offset(bp_x->tvsubs.ssvar) == Offset(bp_y->tvsubs.ssvar)) {
+            /*
+             * x and y are both substrings of the same string, set
+             *  adj1 and adj2 for use in locating the substrings after
+             *  an assignment has been made.  If x is to the right of y,
+             *  set adj1 := *x - *y, otherwise if y is to the right of
+             *  x, set adj2 := *y - *x.  Note that the adjustment
+             *  values may be negative.
+             */
+            if (bp_x->tvsubs.sspos > bp_y->tvsubs.sspos)
+               adj1 = bp_x->tvsubs.sslen - bp_y->tvsubs.sslen;
+            else if (bp_y->tvsubs.sspos > bp_x->tvsubs.sspos)
+               adj2 = bp_y->tvsubs.sslen - bp_x->tvsubs.sslen;
+	    }
+         }
+
+   /*
+    * Do x := y
+    */
+   GeneralAsgn(x, dy)
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj2 != 0)
+            /*
+             * Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
+             *  shifted the position of Arg2.  Add adj2 to the position of Arg2
+             *  to account for the replacement of Arg1 by Arg2.
+             */
+            bp_y->tvsubs.sspos += adj2;
+         }
+
+   /*
+    * Do y := x
+    */
+   GeneralAsgn(y, dx)
+
+   if is:tvsubs(x) && is:tvsubs(y) then
+      inline {
+         if (adj1 != 0)
+            /*
+             * Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1
+             *  has shifted the position of Arg1.  Add adj2 to the position
+             *  of Arg1 to account for the replacement of Arg2 by Arg1.
+             */
+            bp_x->tvsubs.sspos += adj1;
+         }
+
+   inline {
+      return x;
+      }
+end
+
+/*
+ * subs_asgn - perform assignment to a substring. Leave the updated substring
+ *  in dest in case it is needed as the result of the assignment.
+ */
+int subs_asgn(dest, src)
+dptr dest;
+const dptr src;
+   {
+   tended struct descrip deststr;
+   tended struct descrip srcstr;
+   tended struct descrip rsltstr;
+   tended struct b_tvsubs *tvsub;
+
+   char *s, *s2;
+   word i, len;
+   word prelen;   /* length of portion of string before substring */
+   word poststrt; /* start of portion of string following substring */
+   word postlen;  /* length of portion of string following substring */
+
+   if (!cnv:tmp_string(*src, srcstr))
+      ReturnErrVal(103, *src, Error);
+
+   /*
+    * Be sure that the variable in the trapped variable points
+    *  to a string and that the string is big enough to contain
+    *  the substring.
+    */
+   tvsub = (struct b_tvsubs *)BlkLoc(*dest);
+   deref(&tvsub->ssvar, &deststr);
+   if (!is:string(deststr))
+      ReturnErrVal(103, deststr, Error);
+   prelen = tvsub->sspos - 1;
+   poststrt = prelen + tvsub->sslen;
+   if (poststrt > StrLen(deststr))
+      ReturnErrNum(205, Error);
+
+   /*
+    * Form the result string.
+    *  Start by allocating space for the entire result.
+    */
+   len = prelen + StrLen(srcstr) + StrLen(deststr) - poststrt;
+   Protect(s = alcstr(NULL, len), return Error);
+   StrLoc(rsltstr) = s;
+   StrLen(rsltstr) = len;
+   /*
+    * First, copy the portion of the substring string to the left of
+    *  the substring into the string space.
+    */
+   s2 = StrLoc(deststr);
+   for (i = 0; i < prelen; i++)
+      *s++ = *s2++;
+   /*
+    * Copy the string to be assigned into the string space,
+    *  effectively concatenating it.
+    */
+   s2 = StrLoc(srcstr);
+   for (i = 0; i < StrLen(srcstr); i++)
+      *s++ = *s2++;
+   /*
+    * Copy the portion of the substring to the right of
+    *  the substring into the string space, completing the
+    *  result.
+    */
+   s2 = StrLoc(deststr) + poststrt;
+   postlen = StrLen(deststr) - poststrt;
+   for (i = 0; i < postlen; i++)
+      *s++ = *s2++;
+
+   /*
+    * Perform the assignment and update the trapped variable.
+    */
+   type_case tvsub->ssvar of {
+      kywdevent: {
+         *VarLoc(tvsub->ssvar) = rsltstr;
+         }
+      kywdstr: {
+         *VarLoc(tvsub->ssvar) = rsltstr;
+         }
+      kywdsubj: {
+         *VarLoc(tvsub->ssvar) = rsltstr;
+         k_pos = 1;
+         }
+      tvtbl: {
+         if (tvtbl_asgn(&tvsub->ssvar, (const dptr)&rsltstr) == Error)
+            return Error;
+         }
+      default: {
+         Asgn(tvsub->ssvar, rsltstr);
+         }
+      }
+   tvsub->sslen = StrLen(srcstr);
+
+   EVVal(tvsub->sslen, E_Ssasgn);
+   return Succeeded;
+   }
+
+/*
+ * tvtbl_asgn - perform an assignment to a table element trapped variable,
+ *  inserting the element in the table if needed.
+ */
+int tvtbl_asgn(dest, src)
+dptr dest;
+const dptr src;
+   {
+   tended struct b_tvtbl *bp;
+   tended struct descrip tval;
+   struct b_telem *te;
+   union block **slot;
+   struct b_table *tp;
+   int res;
+
+   /*
+    * Allocate te now (even if we may not need it)
+    * because slot cannot be tended.
+    */
+   bp = (struct b_tvtbl *) BlkLoc(*dest);	/* Save params to tended vars */
+   tval = *src;
+   Protect(te = alctelem(), return Error);
+
+   /*
+    * First see if reference is in the table; if it is, just update
+    *  the value.  Otherwise, allocate a new table entry.
+    */
+   slot = memb(bp->clink, &bp->tref, bp->hashnum, &res);
+
+   if (res == 1) {
+      /*
+       * Do not need new te, just update existing entry.
+       */
+      deallocate((union block *) te);
+      (*slot)->telem.tval = tval;
+      }
+   else {
+      /*
+       * Link te into table, fill in entry.
+       */
+      tp = (struct b_table *) bp->clink;
+      tp->size++;
+
+      te->clink = *slot;
+      *slot = (union block *) te;
+
+      te->hashnum = bp->hashnum;
+      te->tref = bp->tref;
+      te->tval = tval;
+
+      if (TooCrowded(tp))		/* grow hash table if now too full */
+         hgrow((union block *)tp);
+      }
+   return Succeeded;
+   }
diff --git a/src/runtime/ocat.r b/src/runtime/ocat.r
new file mode 100644
index 0000000..c778d6d
--- /dev/null
+++ b/src/runtime/ocat.r
@@ -0,0 +1,120 @@
+/*
+ * File: ocat.r -- caterr, lconcat
+ */
+"x || y - concatenate strings x and y."
+
+operator{1} || cater(x, y)
+
+   if !cnv:string(x) then
+      runerr(103, x)
+   if !cnv:string(y) then
+      runerr(103, y)
+
+   abstract {
+      return string
+      }
+
+   body {
+      char *s, *s2;
+      word len, i;
+
+      /*
+       *  Optimization 1:  The strings to be concatenated are already
+       *   adjacent in memory; no allocation is required.
+       */
+      if (StrLoc(x) + StrLen(x) == StrLoc(y)) {
+         StrLoc(result) = StrLoc(x);
+         StrLen(result) = StrLen(x) + StrLen(y);
+         return result;
+         }
+      else if ((StrLoc(x) + StrLen(x) == strfree)
+      && (DiffPtrs(strend,strfree) > StrLen(y))) {
+         /*
+          * Optimization 2: The end of x is at the end of the string space.
+          *  Hence, x was the last string allocated and need not be
+          *  re-allocated. y is appended to the string space and the
+          *  result is pointed to the start of x.
+          */
+	 result = x;
+	 /*
+	  * Append y to the end of the string space.
+	  */
+	 Protect(alcstr(StrLoc(y),StrLen(y)), runerr(0));
+	 /*
+	  *  Set the length of the result and return.
+	  */
+	 StrLen(result) = StrLen(x) + StrLen(y);
+	 return result;
+         }
+
+      /*
+       * Otherwise, allocate space for x and y, and copy them
+       *  to the end of the string space.
+       */
+      Protect(StrLoc(result) = alcstr(NULL, StrLen(x) + StrLen(y)), runerr(0));
+      s = StrLoc(result);
+      s2 = StrLoc(x);
+      len = StrLen(x);
+      for(i = 0; i < len; i++)
+	 *s++ = *s2++;
+      s2 = StrLoc(y);
+      len = StrLen(y);
+      for(i = 0; i < len; i++)
+	 *s++ = *s2++;
+
+      /*
+       *  Set the length of the result and return.
+       */
+      StrLen(result) = StrLen(x) + StrLen(y);
+      return result;
+      }
+end
+
+
+"x ||| y - concatenate lists x and y."
+
+operator{1} ||| lconcat(x, y)
+   /*
+    * x and y must be lists.
+    */
+   if !is:list(x) then
+      runerr(108, x)
+   if !is:list(y) then
+      runerr(108, y)
+
+   abstract {
+      return new list(store[(type(x) ++ type(y)).lst_elem])
+      }
+
+   body {
+      register struct b_list *bp1;
+      register struct b_lelem *lp1;
+      word size1, size2, size3;
+
+      /*
+       * Get the size of both lists.
+       */
+      size1 = BlkLoc(x)->list.size;
+      size2 = BlkLoc(y)->list.size;
+      size3 = size1 + size2;
+
+      Protect(bp1 = (struct b_list *)alclist(size3), runerr(0));
+      Protect(lp1 = (struct b_lelem *)alclstb(size3,(word)0,size3), runerr(0));
+      bp1->listhead = bp1->listtail = (union block *)lp1;
+#ifdef ListFix
+      lp1->listprev = lp1->listnext = (union block *)bp1;
+#endif					/* ListFix */
+
+      /*
+       * Make a copy of both lists in adjacent slots.
+       */
+      cpslots(&x, lp1->lslots, (word)1, size1 + 1);
+      cpslots(&y, lp1->lslots + size1, (word)1, size2 + 1);
+
+      BlkLoc(x) = (union block *)bp1;
+
+      EVValD(&x, E_Lcreate);
+
+      return x;
+      }
+end
diff --git a/src/runtime/ocomp.r b/src/runtime/ocomp.r
new file mode 100644
index 0000000..af1b1e0
--- /dev/null
+++ b/src/runtime/ocomp.r
@@ -0,0 +1,177 @@
+/*
+ * File: ocomp.r
+ *  Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge,
+ *		numgt, numle, numlt, numne, eqv, neqv
+ */
+
+/*
+ * NumComp is a macro that defines the form of a numeric comparisons.
+ */
+#begdef NumComp(icon_op, func_name, c_op, descript)
+"x " #icon_op " y - test if x is numerically " #descript " y."
+   operator{0,1} icon_op func_name(x,y)
+
+   arith_case (x, y) of {
+      C_integer: {
+         abstract {
+            return integer
+            }
+         inline {
+            if c_op(x, y)
+               return C_integer y;
+            fail;
+            }
+         }
+      integer: { /* large integers only */
+         abstract {
+            return integer
+            }
+         inline {
+            if (big_ ## c_op (x,y))
+               return y;
+            fail;
+            }
+         }
+      C_double: {
+         abstract {
+            return real
+            }
+         inline {
+            if c_op (x, y)
+               return C_double y;
+            fail;
+            }
+         }
+      }
+end
+
+#enddef
+
+/*
+ * x = y
+ */
+#define NumEq(x,y) (x == y)
+#define big_NumEq(x,y) (bigcmp(&x,&y) == 0)
+NumComp( = , numeq, NumEq, equal to)
+
+/*
+ * x >= y
+ */
+#define NumGe(x,y) (x >= y)
+#define big_NumGe(x,y) (bigcmp(&x,&y) >= 0)
+NumComp( >=, numge, NumGe, greater than or equal to)
+
+/*
+ * x > y
+ */
+#define NumGt(x,y) (x > y)
+#define big_NumGt(x,y) (bigcmp(&x,&y) > 0)
+NumComp( > , numgt, NumGt,  greater than)
+
+/*
+ * x <= y
+ */
+#define NumLe(x,y) (x <= y)
+#define big_NumLe(x,y) (bigcmp(&x,&y) <= 0)
+NumComp( <=, numle, NumLe, less than or equal to)
+
+/*
+ * x < y
+ */
+#define NumLt(x,y) (x < y)
+#define big_NumLt(x,y) (bigcmp(&x,&y) < 0)
+NumComp( < , numlt, NumLt,  less than)
+
+/*
+ * x ~= y
+ */
+#define NumNe(x,y) (x != y)
+#define big_NumNe(x,y) (bigcmp(&x,&y) != 0)
+NumComp( ~=, numne, NumNe, not equal to)
+
+/*
+ * StrComp is a macro that defines the form of a string comparisons.
+ */
+#begdef StrComp(icon_op, func_name, special_test, c_comp, comp_value, descript)
+"x " #icon_op " y - test if x is lexically " #descript " y."
+operator{0,1} icon_op func_name(x,y)
+   declare {
+      int temp_str = 0;
+      }
+   abstract {
+      return string
+      }
+   if !cnv:tmp_string(x) then
+      runerr(103,x)
+   if !is:string(y) then
+      if cnv:tmp_string(y) then
+          inline {
+             temp_str = 1;
+             }
+      else
+         runerr(103,y)
+
+   body {
+
+      /*
+       * lexcmp does the work.
+       */
+      if (special_test (lexcmp(&x, &y) c_comp comp_value)) {
+         /*
+          * Return y as the result of the comparison.  If y was converted to
+          *  a string, a copy of it is allocated.
+          */
+         result = y;
+         if (temp_str)
+            Protect(StrLoc(result) = alcstr(StrLoc(result), StrLen(result)), runerr(0));
+         return result;
+         }
+      else
+         fail;
+      }
+end
+#enddef
+
+StrComp(==,  lexeq, (StrLen(x) == StrLen(y)) &&, ==, Equal, equal to)
+StrComp(~==, lexne, (StrLen(x) != StrLen(y)) ||, !=, Equal, not equal to)
+
+StrComp(>>=, lexge, , !=, Less,    greater than or equal to)
+StrComp(>>,  lexgt, , ==, Greater, greater than)
+StrComp(<<=, lexle, , !=, Greater, less than or equal to)
+StrComp(<<,  lexlt, , ==, Less,    less than)
+
+
+"x === y - test equivalence of x and y."
+
+operator{0,1} === eqv(x,y)
+   abstract {
+      return type(y)
+      }
+   inline {
+      /*
+       * Let equiv do all the work, failing if equiv indicates non-equivalence.
+       */
+      if (equiv(&x, &y))
+         return y;
+      else
+         fail;
+   }
+end
+
+
+"x ~=== y - test inequivalence of x and y."
+
+operator{0,1} ~=== neqv(x,y)
+   abstract {
+      return type(y)
+      }
+   inline {
+      /*
+       * equiv does all the work.
+       */
+      if (!equiv(&x, &y))
+         return y;
+      else
+         fail;
+   }
+end
diff --git a/src/runtime/omisc.r b/src/runtime/omisc.r
new file mode 100644
index 0000000..96a3e1b
--- /dev/null
+++ b/src/runtime/omisc.r
@@ -0,0 +1,284 @@
+/*
+ * File: omisc.r
+ *  Contents: refresh, size, tabmat, toby, to, llist
+ */
+
+"^x - create a refreshed copy of a co-expression."
+#ifdef Coexpr
+/*
+ * ^x - return an entry block for co-expression x from the refresh block.
+ */
+operator{1} ^ refresh(x)
+   if !is:coexpr(x) then
+       runerr(118, x)
+   abstract {
+      return coexpr
+      }
+
+   body {
+      register struct b_coexpr *sblkp;
+
+      /*
+       * Get a new co-expression stack and initialize.
+       */
+#ifdef MultiThread
+      Protect(sblkp = alccoexp(0, 0), runerr(0));
+#else					/* MultiThread */
+      Protect(sblkp = alccoexp(), runerr(0));
+#endif					/* MultiThread */
+
+      sblkp->freshblk = BlkLoc(x)->coexpr.freshblk;
+      if (ChkNull(sblkp->freshblk))	/* &main cannot be refreshed */
+         runerr(215, x);
+
+      /*
+       * Use refresh block to finish initializing the new co-expression.
+       */
+      co_init(sblkp);
+
+#if COMPILER
+      sblkp->fnc = BlkLoc(x)->coexpr.fnc;
+      if (line_info) {
+         if (debug_info)
+            PFDebug(sblkp->pf)->proc = PFDebug(BlkLoc(x)->coexpr.pf)->proc;
+         PFDebug(sblkp->pf)->old_fname =
+            PFDebug(BlkLoc(x)->coexpr.pf)->old_fname;
+         PFDebug(sblkp->pf)->old_line =
+            PFDebug(BlkLoc(x)->coexpr.pf)->old_line;
+         }
+#endif					/* COMPILER */
+
+      return coexpr(sblkp);
+      }
+#else					/* Coexpr */
+operator{} ^ refresh(x)
+      runerr(401)
+#endif					/* Coexpr */
+
+end
+
+
+"*x - return size of string or object x."
+
+operator{1} * size(x)
+   abstract {
+      return integer
+      }
+   type_case x of {
+      string: inline {
+         return C_integer StrLen(x);
+         }
+      list: inline {
+         return C_integer BlkLoc(x)->list.size;
+         }
+      table: inline {
+         return C_integer BlkLoc(x)->table.size;
+         }
+      set: inline {
+         return C_integer BlkLoc(x)->set.size;
+         }
+      cset: inline {
+         register word i;
+
+         i = BlkLoc(x)->cset.size;
+	 if (i < 0)
+	    i = cssize(&x);
+         return C_integer i;
+         }
+      record: inline {
+         return C_integer BlkLoc(x)->record.recdesc->proc.nfields;
+         }
+      coexpr: inline {
+         return C_integer BlkLoc(x)->coexpr.size;
+         }
+      default: {
+         /*
+          * Try to convert it to a string.
+          */
+         if !cnv:tmp_string(x) then
+            runerr(112, x);	/* no notion of size */
+         inline {
+	    return C_integer StrLen(x);
+            }
+         }
+      }
+end
+
+
+"=x - tab(match(x)).  Reverses effects if resumed."
+
+operator{*} = tabmat(x)
+   /*
+    * x must be a string.
+    */
+   if !cnv:string(x) then
+      runerr(103, x)
+   abstract {
+      return string
+      }
+
+   body {
+      register word l;
+      register char *s1, *s2;
+      C_integer i, j;
+      /*
+       * Make a copy of &pos.
+       */
+      i = k_pos;
+
+      /*
+       * Fail if &subject[&pos:0] is not of sufficient length to contain x.
+       */
+      j = StrLen(k_subject) - i + 1;
+      if (j < StrLen(x))
+         fail;
+
+      /*
+       * Get pointers to x (s1) and &subject (s2).  Compare them on a byte-wise
+       *  basis and fail if s1 doesn't match s2 for *s1 characters.
+       */
+      s1 = StrLoc(x);
+      s2 = StrLoc(k_subject) + i - 1;
+      l = StrLen(x);
+      while (l-- > 0) {
+         if (*s1++ != *s2++)
+            fail;
+         }
+
+      /*
+       * Increment &pos to tab over the matched string and suspend the
+       *  matched string.
+       */
+      l = StrLen(x);
+      k_pos += l;
+
+      EVVal(k_pos, E_Spos);
+
+      suspend x;
+
+      /*
+       * tabmat has been resumed, restore &pos and fail.
+       */
+      if (i > StrLen(k_subject) + 1)
+         runerr(205, kywd_pos);
+      else {
+         k_pos = i;
+         EVVal(k_pos, E_Spos);
+         }
+      fail;
+      }
+end
+
+
+"i to j by k - generate successive values."
+
+operator{*} ... toby(from, to, by)
+   /*
+    * arguments must be integers.
+    */
+   if !cnv:C_integer(from) then
+      runerr(101, from)
+   if !cnv:C_integer(to) then
+      runerr(101, to)
+   if !cnv:C_integer(by) then
+      runerr(101, by)
+
+   abstract {
+      return integer
+      }
+
+   inline {
+      /*
+       * by must not be zero.
+       */
+      if (by == 0) {
+         irunerr(211, by);
+         errorfail;
+         }
+
+      /*
+       * Count up or down (depending on relationship of from and to) and
+       *  suspend each value in sequence, failing when the limit has been
+       *  exceeded.
+       */
+      if (by > 0)
+         for ( ; from <= to; from += by) {
+            suspend C_integer from;
+            }
+      else
+         for ( ; from >= to; from += by) {
+            suspend C_integer from;
+            }
+      fail;
+      }
+end
+
+
+"i to j - generate successive values."
+
+operator{*} ... to(from, to)
+   /*
+    * arguments must be integers.
+    */
+   if !cnv:C_integer(from) then
+      runerr(101, from)
+   if !cnv:C_integer(to) then
+      runerr(101, to)
+
+   abstract {
+      return integer
+      }
+
+   inline {
+      for ( ; from <= to; ++from) {
+         suspend C_integer from;
+         }
+      fail;
+      }
+end
+
+
+" [x1, x2, ... ] - create an explicitly specified list."
+
+operator{1} [...] llist(elems[n])
+   abstract {
+      return new list(type(elems))
+      }
+   body {
+      tended struct b_list *hp;
+      register word i;
+      register struct b_lelem *bp;  /* need not be tended */
+      word nslots;
+
+      nslots = n;
+      if (nslots == 0)
+         nslots = MinListSlots;
+
+      /*
+       * Allocate the list and a list block.
+       */
+      Protect(hp = alclist(n), runerr(0));
+      Protect(bp = alclstb(nslots, (word)0, n), runerr(0));
+
+      /*
+       * Make the list block just allocated into the first and last blocks
+       *  for the list.
+       */
+      hp->listhead = hp->listtail = (union block *)bp;
+#ifdef ListFix
+      bp->listprev = bp->listnext = (union block *)hp;
+#endif					/* ListFix */
+
+      /*
+       * Assign each argument to a list element.
+       */
+      for (i = 0; i < n; i++)
+         bp->lslots[i] = elems[i];
+
+/*  Not quite right -- should be after list() returns in case it fails */
+      Desc_EVValD(hp, E_Lcreate, D_List);
+
+      return list(hp);
+      }
+end
+
diff --git a/src/runtime/oref.r b/src/runtime/oref.r
new file mode 100644
index 0000000..3ac86bc
--- /dev/null
+++ b/src/runtime/oref.r
@@ -0,0 +1,881 @@
+/*
+ * File: oref.r
+ *  Contents: bang, random, sect, subsc
+ */
+
+"!x - generate successive values from object x."
+
+operator{*} ! bang(underef x -> dx)
+   declare {
+      register C_integer i, j;
+      tended union block *ep;
+      struct hgstate state;
+      char ch;
+      }
+
+   if is:variable(x) && is:string(dx) then {
+      abstract {
+         return new tvsubs(type(x))
+         }
+      inline {
+         /*
+          * A nonconverted string from a variable is being banged.
+          *  Loop through the string suspending one-character substring
+          *  trapped variables.
+          */
+         for (i = 1; i <= StrLen(dx); i++) {
+            suspend tvsubs(&x, i, (word)1);
+            deref(&x, &dx);
+            if (!is:string(dx))
+               runerr(103, dx);
+            }
+         }
+      }
+   else type_case dx of {
+
+      list: {
+         abstract {
+            return type(dx).lst_elem
+	    }
+         inline {
+
+#ifdef EventMon
+            word xi = 0;
+
+            EVValD(&dx, E_Lbang);
+#endif					/* EventMon */
+
+            /*
+             * x is a list.  Chain through each list element block and for
+             * each one, suspend with a variable pointing to each
+             * element contained in the block.
+             */
+            for (ep = BlkLoc(dx)->list.listhead;
+#ifdef ListFix
+		 BlkType(ep) == T_Lelem;
+#else					/* ListFix */
+		 ep != NULL;
+#endif					/* ListFix */
+                 ep = ep->lelem.listnext){
+               for (i = 0; i < ep->lelem.nused; i++) {
+                  j = ep->lelem.first + i;
+                  if (j >= ep->lelem.nslots)
+                     j -= ep->lelem.nslots;
+
+#ifdef EventMon
+                  MakeInt(++xi, &eventdesc);
+                  EVValD(&eventdesc, E_Lsub);
+#endif					/* EventMon */
+
+                  suspend struct_var(&ep->lelem.lslots[j], ep);
+                  }
+               }
+            }
+         }
+
+      file: {
+         abstract {
+            return string
+	       }
+         body {
+            FILE *fd;
+            char sbuf[MaxCvtLen];
+            register char *sp;
+            register C_integer slen, rlen;
+            word status;
+
+            /*
+             * x is a file.  Read the next line into the string space
+             *	and suspend the newly allocated string.
+             */
+            fd = BlkLoc(dx)->file.fd;
+
+            status = BlkLoc(dx)->file.status;
+            if ((status & Fs_Read) == 0)
+               runerr(212, dx);
+
+#ifdef ReadDirectory
+            if ((status & Fs_Directory) != 0) {
+               for (;;) {
+                  struct dirent *de = readdir((DIR*) fd);
+                  if (de == NULL)
+                     fail;
+                  slen = strlen(de->d_name);
+                  Protect(sp = alcstr(de->d_name, slen), runerr(0));
+                  suspend string(slen, sp);
+                  }
+               }
+#endif					/* ReadDirectory */
+
+            if (status & Fs_Writing) {
+               fseek(fd, 0L, SEEK_CUR);
+               BlkLoc(dx)->file.status &= ~Fs_Writing;
+               }
+            BlkLoc(dx)->file.status |= Fs_Reading;
+            status = BlkLoc(dx)->file.status;
+
+            for (;;) {
+               StrLen(result) = 0;
+               do {
+
+#ifdef Graphics
+                  pollctr >>= 1; pollctr++;
+                  if (status & Fs_Window) {
+                     slen = wgetstrg(sbuf,MaxCvtLen,fd);
+		     if (slen == -1)
+			runerr(141);
+		     else if (slen < -1)
+			runerr(143);
+                     }
+                  else
+#endif					/* Graphics */
+
+                  if ((slen = getstrg(sbuf,MaxCvtLen,&BlkLoc(dx)->file)) == -1)
+                     fail;
+                  rlen = slen < 0 ? (word)MaxCvtLen : slen;
+
+		  Protect(reserve(Strings, rlen), runerr(0));
+		  if (!InRange(strbase,StrLoc(result),strfree)) {
+		     Protect(reserve(Strings, StrLen(result)+rlen), runerr(0));
+		     Protect((StrLoc(result) = alcstr(StrLoc(result),
+                        StrLen(result))), runerr(0));
+		     }
+
+                  Protect(sp = alcstr(sbuf,rlen), runerr(0));
+                  if (StrLen(result) == 0)
+                     StrLoc(result) = sp;
+                  StrLen(result) += rlen;
+                  } while (slen < 0);
+               suspend result;
+               }
+            }
+         }
+
+      table: {
+         abstract {
+            return type(dx).tbl_val
+	       }
+         inline {
+            struct b_tvtbl *tp;
+
+            EVValD(&dx, E_Tbang);
+
+            /*
+             * x is a table.  Chain down the element list in each bucket
+             * and suspend a variable pointing to each element in turn.
+             */
+	    for (ep = hgfirst(BlkLoc(dx), &state); ep != 0;
+	       ep = hgnext(BlkLoc(dx), &state, ep)) {
+
+                  EVValD(&ep->telem.tval, E_Tval);
+
+		  Protect(tp = alctvtbl(&dx, &ep->telem.tref, ep->telem.hashnum), runerr(0));
+		  suspend tvtbl(tp);
+                  }
+            }
+         }
+
+      set: {
+         abstract {
+            return store[type(dx).set_elem]
+            }
+         inline {
+            EVValD(&dx, E_Sbang);
+            /*
+             *  This is similar to the method for tables except that a
+             *  value is returned instead of a variable.
+             */
+	    for (ep = hgfirst(BlkLoc(dx), &state); ep != 0;
+	       ep = hgnext(BlkLoc(dx), &state, ep)) {
+                  EVValD(&ep->selem.setmem, E_Sval);
+                  suspend ep->selem.setmem;
+                  }
+	    }
+         }
+
+      record: {
+         abstract {
+            return type(dx).all_fields
+	       }
+         inline {
+            /*
+             * x is a record.  Loop through the fields and suspend
+             * a variable pointing to each one.
+             */
+
+#ifdef EventMon
+            word xi = 0;
+
+            EVValD(&dx, E_Rbang);
+#endif					/* EventMon */
+
+            j = BlkLoc(dx)->record.recdesc->proc.nfields;
+            for (i = 0; i < j; i++) {
+
+#ifdef EventMon
+                  MakeInt(++xi, &eventdesc);
+                  EVValD(&eventdesc, E_Rsub);
+#endif					/* EventMon */
+
+               suspend struct_var(&BlkLoc(dx)->record.fields[i],
+                  (struct b_record *)BlkLoc(dx));
+               }
+            }
+         }
+
+      default:
+         if cnv:tmp_string(dx) then {
+            abstract {
+               return string
+               }
+            inline {
+               /*
+                * A (converted or non-variable) string is being banged.
+                * Loop through the string suspending simple one character
+                *  substrings.
+                */
+               for (i = 1; i <= StrLen(dx); i++) {
+                  ch = *(StrLoc(dx) + i - 1);
+                  suspend string(1, (char *)&allchars[ch & 0xFF]);
+                  }
+               }
+            }
+         else
+            runerr(116, dx);
+      }
+
+   inline {
+      fail;
+      }
+end
+
+
+#define RandVal (RanScale*(k_random=(RandA*k_random+RandC)&0x7FFFFFFFL))
+
+"?x - produce a randomly selected element of x."
+
+operator{0,1} ? random(underef x -> dx)
+
+#ifndef LargeInts
+   declare {
+      C_integer v = 0;
+      }
+#endif					/* LargeInts */
+
+   if is:variable(x) && is:string(dx) then {
+      abstract {
+         return new tvsubs(type(x))
+         }
+      body {
+         C_integer val;
+         double rval;
+
+         /*
+          * A string from a variable is being banged. Produce a one
+          *  character substring trapped variable.
+          */
+         if ((val = StrLen(dx)) <= 0)
+            fail;
+         rval = RandVal;	/* This form is used to get around */
+         rval *= val;		/* a bug in a certain C compiler */
+         return tvsubs(&x, (word)rval + 1, (word)1);
+         }
+      }
+   else type_case dx of {
+      string: {
+         /*
+          * x is a string, but it is not a variable. Produce a
+          *   random character in it as the result; a substring
+          *   trapped variable is not needed.
+          */
+         abstract {
+            return string
+            }
+         body {
+            C_integer val;
+            double rval;
+
+            if ((val = StrLen(dx)) <= 0)
+               fail;
+            rval = RandVal;
+            rval *= val;
+            return string(1, StrLoc(dx)+(word)rval);
+            }
+         }
+
+      cset: {
+         /*
+          * x is a cset.  Convert it to a string, select a random character
+          *  of that string and return it. A substring trapped variable is
+          *  not needed.
+          */
+         if !cnv:tmp_string(dx) then
+            { /* cannot fail */ }
+         abstract {
+            return string
+            }
+         body {
+            C_integer val;
+            double rval;
+	    char ch;
+
+            if ((val = StrLen(dx)) <= 0)
+               fail;
+            rval = RandVal;
+            rval *= val;
+            ch = *(StrLoc(dx) + (word)rval);
+            return string(1, (char *)&allchars[ch & 0xFF]);
+            }
+         }
+
+      list: {
+         abstract {
+            return type(dx).lst_elem
+            }
+         /*
+          * x is a list.  Set i to a random number in the range [1,*x],
+          *  failing if the list is empty.
+          */
+         body {
+            C_integer val;
+            double rval;
+            register C_integer i, j;
+            union block *bp;     /* doesn't need to be tended */
+            val = BlkLoc(dx)->list.size;
+            if (val <= 0)
+               fail;
+            rval = RandVal;
+            rval *= val;
+            i = (word)rval + 1;
+
+#ifdef EventMon
+            EVValD(&dx, E_Lrand);
+            MakeInt(i, &eventdesc);
+            EVValD(&eventdesc, E_Lsub);
+#endif					/* EventMon */
+
+            j = 1;
+            /*
+             * Work down chain list of list blocks and find the block that
+             *  contains the selected element.
+             */
+            bp = BlkLoc(dx)->list.listhead;
+            while (i >= j + bp->lelem.nused) {
+               j += bp->lelem.nused;
+               bp = bp->lelem.listnext;
+#ifdef ListFix
+               if (BlkType(bp) == T_List)
+#else					/* ListFix */
+	       if (bp == NULL)
+#endif					/* ListFix */
+                  syserr("list reference out of bounds in random");
+               }
+            /*
+             * Locate the appropriate element and return a variable
+             * that points to it.
+             */
+            i += bp->lelem.first - j;
+            if (i >= bp->lelem.nslots)
+               i -= bp->lelem.nslots;
+            return struct_var(&bp->lelem.lslots[i], bp);
+            }
+         }
+
+      table: {
+         abstract {
+            return type(dx).tbl_val
+            }
+          /*
+           * x is a table.  Set n to a random number in the range [1,*x],
+           *  failing if the table is empty.
+           */
+         body {
+            C_integer val;
+            double rval;
+            register C_integer i, j, n;
+            union block *ep, *bp;   /* doesn't need to be tended */
+	    struct b_slots *seg;
+	    struct b_tvtbl *tp;
+
+            bp = BlkLoc(dx);
+            val = bp->table.size;
+            if (val <= 0)
+               fail;
+            rval = RandVal;
+            rval *= val;
+            n = (word)rval + 1;
+
+#ifdef EventMon
+            EVValD(&dx, E_Trand);
+            MakeInt(n, &eventdesc);
+            EVValD(&eventdesc, E_Tsub);
+#endif					/* EventMon */
+
+
+            /*
+             * Walk down the hash chains to find and return the nth element
+	     *  as a variable.
+             */
+            for (i = 0; i < HSegs && (seg = bp->table.hdir[i]) != NULL; i++)
+               for (j = segsize[i] - 1; j >= 0; j--)
+                  for (ep = seg->hslots[j];
+#ifdef TableFix
+		       BlkType(ep) == T_Telem;
+#else					/* TableFix */
+		       ep != NULL;
+#endif					/* TableFix */
+		       ep = ep->telem.clink)
+                     if (--n <= 0) {
+			Protect(tp = alctvtbl(&dx, &ep->telem.tref, ep->telem.hashnum), runerr(0));
+			return tvtbl(tp);
+			}
+            syserr("table reference out of bounds in random");
+            }
+         }
+
+      set: {
+         abstract {
+            return store[type(dx).set_elem]
+            }
+         /*
+          * x is a set.  Set n to a random number in the range [1,*x],
+          *  failing if the set is empty.
+          */
+         body {
+            C_integer val;
+            double rval;
+            register C_integer i, j, n;
+            union block *bp, *ep;  /* doesn't need to be tended */
+	    struct b_slots *seg;
+
+            bp = BlkLoc(dx);
+            val = bp->set.size;
+            if (val <= 0)
+               fail;
+            rval = RandVal;
+            rval *= val;
+            n = (word)rval + 1;
+
+#ifdef EventMon
+            EVValD(&dx, E_Srand);
+            MakeInt(n, &eventdesc);
+#endif					/* EventMon */
+
+            /*
+             * Walk down the hash chains to find and return the nth element.
+             */
+            for (i = 0; i < HSegs && (seg = bp->table.hdir[i]) != NULL; i++)
+               for (j = segsize[i] - 1; j >= 0; j--)
+                  for (ep = seg->hslots[j]; ep != NULL; ep = ep->telem.clink)
+                     if (--n <= 0)
+                        return ep->selem.setmem;
+            syserr("set reference out of bounds in random");
+            }
+         }
+
+      record: {
+         abstract {
+            return type(dx).all_fields
+            }
+         /*
+          * x is a record.  Set val to a random number in the range
+          *  [1,*x] (*x is the number of fields), failing if the
+          *  record has no fields.
+          */
+         body {
+            C_integer val;
+            double rval;
+            struct b_record *rec;  /* doesn't need to be tended */
+
+            rec = (struct b_record *)BlkLoc(dx);
+            val = rec->recdesc->proc.nfields;
+            if (val <= 0)
+               fail;
+            /*
+             * Locate the selected element and return a variable
+             * that points to it
+             */
+            rval = RandVal;
+            rval *= val;
+
+#ifdef EventMon
+            EVValD(&dx, E_Rrand);
+            MakeInt(rval + 1, &eventdesc);
+            EVValD(&eventdesc, E_Rsub);
+#endif					/* EventMon */
+
+            return struct_var(&rec->fields[(word)rval], rec);
+            }
+         }
+
+      default: {
+
+#ifdef LargeInts
+         if !cnv:integer(dx) then
+            runerr(113, dx)
+#else					/* LargeInts */
+         if !cnv:C_integer(dx,v) then
+            runerr(113, dx)
+#endif					/* LargeInts */
+
+         abstract {
+            return integer ++ real
+            }
+         body {
+            double rval;
+
+#ifdef LargeInts
+            C_integer v;
+            if (Type(dx) == T_Lrgint) {
+	       if (bigrand(&dx, &result) == Error)  /* alcbignum failed */
+	          runerr(0);
+	       return result;
+	       }
+
+            v = IntVal(dx);
+#endif					/* LargeInts */
+            /*
+             * x is an integer, be sure that it's non-negative.
+             */
+            if (v < 0)
+               runerr(205, dx);
+
+            /*
+             * val contains the integer value of x. If val is 0, return
+             *	a real in the range [0,1), else return an integer in the
+             *	range [1,val].
+             */
+            if (v == 0) {
+               rval = RandVal;
+               return C_double rval;
+               }
+            else {
+               rval = RandVal;
+               rval *= v;
+               return C_integer (long)rval + 1;
+               }
+            }
+         }
+      }
+end
+
+"x[i:j] - form a substring or list section of x."
+
+operator{0,1} [:] sect(underef x -> dx, i, j)
+   declare {
+      int use_trap = 0;
+      }
+
+   if is:list(dx) then {
+      abstract {
+         return type(dx)
+         }
+      /*
+       * If it isn't a C integer, but is a large integer, fail on
+       * the out-of-range index.
+       */
+      if !cnv:C_integer(i) then {
+	 if cnv : integer(i) then inline { fail; }
+	 runerr(101, i)
+	 }
+      if !cnv:C_integer(j) then {
+         if cnv : integer(j) then inline { fail; }
+	 runerr(101, j)
+         }
+
+      body {
+         C_integer t;
+
+         i = cvpos((long)i, (long)BlkLoc(dx)->list.size);
+         if (i == CvtFail)
+            fail;
+         j = cvpos((long)j, (long)BlkLoc(dx)->list.size);
+         if (j == CvtFail)
+            fail;
+         if (i > j) {
+            t = i;
+            i = j;
+            j = t;
+            }
+         if (cplist(&dx, &result, i, j) == Error)
+	    runerr(0);
+         return result;
+         }
+      }
+   else {
+
+      /*
+       * x should be a string. If x is a variable, we must create a
+       *  substring trapped variable.
+       */
+      if is:variable(x) && is:string(dx) then {
+         abstract {
+            return new tvsubs(type(x))
+            }
+         inline {
+            use_trap = 1;
+            }
+         }
+      else if cnv:string(dx) then
+         abstract {
+            return string
+            }
+      else
+         runerr(110, dx)
+
+      /*
+       * If it isn't a C integer, but is a large integer, fail on
+       * the out-of-range index.
+       */
+      if !cnv:C_integer(i) then {
+	 if cnv : integer(i) then inline { fail; }
+	 runerr(101, i)
+	 }
+      if !cnv:C_integer(j) then {
+         if cnv : integer(j) then inline { fail; }
+	 runerr(101, j)
+         }
+
+      body {
+         C_integer t;
+
+         i = cvpos((long)i, (long)StrLen(dx));
+         if (i == CvtFail)
+            fail;
+         j = cvpos((long)j, (long)StrLen(dx));
+         if (j == CvtFail)
+            fail;
+         if (i > j) {			/* convert section to substring */
+            t = i;
+            i = j;
+            j = t - j;
+            }
+         else
+            j = j - i;
+
+         if (use_trap) {
+            return tvsubs(&x, i, j);
+            }
+         else
+            return string(j, StrLoc(dx)+i-1);
+         }
+      }
+end
+
+"x[y] - access yth character or element of x."
+
+operator{0,1} [] subsc(underef x -> dx,y)
+   declare {
+      int use_trap = 0;
+      }
+
+   type_case dx of {
+      list: {
+         abstract {
+            return type(dx).lst_elem
+            }
+         /*
+          * Make sure that y is a C integer.
+          */
+         if !cnv:C_integer(y) then {
+	    /*
+	     * If it isn't a C integer, but is a large integer, fail on
+	     * the out-of-range index.
+	     */
+	    if cnv : integer(y) then inline { fail; }
+	    runerr(101, y)
+	    }
+         body {
+            word i, j;
+            register union block *bp; /* doesn't need to be tended */
+            struct b_list *lp;        /* doesn't need to be tended */
+
+#ifdef EventMon
+            EVValD(&dx, E_Lref);
+            MakeInt(y, &eventdesc);
+            EVValD(&eventdesc, E_Lsub);
+#endif					/* EventMon */
+
+	    /*
+	     * Make sure that subscript y is in range.
+	     */
+            lp = (struct b_list *)BlkLoc(dx);
+            i = cvpos((long)y, (long)lp->size);
+            if (i == CvtFail || i > lp->size)
+               fail;
+            /*
+             * Locate the list-element block containing the desired
+             *  element.
+             */
+            bp = lp->listhead;
+            j = 1;
+	    /*
+	     * y is in range, so bp can never be null here. if it was, a memory
+	     * violation would occur in the code that follows, anyhow, so
+	     * exiting the loop on a NULL bp makes no sense.
+	     */
+            while (i >= j + bp->lelem.nused) {
+               j += bp->lelem.nused;
+               bp = bp->lelem.listnext;
+               }
+
+            /*
+             * Locate the desired element and return a pointer to it.
+             */
+            i += bp->lelem.first - j;
+            if (i >= bp->lelem.nslots)
+               i -= bp->lelem.nslots;
+            return struct_var(&bp->lelem.lslots[i], bp);
+            }
+         }
+
+      table: {
+         abstract {
+            store[type(dx).tbl_key] = type(y) /* the key might be added */
+            return type(dx).tbl_val ++ new tvtbl(type(dx))
+            }
+         /*
+          * x is a table.  Return a table element trapped variable
+	  *  representing the result; defer actual lookup until later.
+          */
+         body {
+            uword hn;
+	    struct b_tvtbl *tp;
+
+            EVValD(&dx, E_Tref);
+            EVValD(&y, E_Tsub);
+
+	    hn = hash(&y);
+            Protect(tp = alctvtbl(&dx, &y, hn), runerr(0));
+            return tvtbl(tp);
+            }
+         }
+
+      record: {
+         abstract {
+            return type(dx).all_fields
+            }
+         /*
+          * x is a record.  Convert y to an integer and be sure that it
+          *  it is in range as a field number.
+          */
+	 if !cnv:C_integer(y) then body {
+	    if (!cnv:tmp_string(y,y))
+	       runerr(101,y);
+	    else {
+	       register union block *bp;  /* doesn't need to be tended */
+	       register union block *bp2; /* doesn't need to be tended */
+	       register word i;
+	       register int len;
+	       char *loc;
+	       int nf;
+	       bp = BlkLoc(dx);
+	       bp2 = BlkLoc(dx)->record.recdesc;
+	       nf = bp2->proc.nfields;
+	       loc = StrLoc(y);
+	       len = StrLen(y);
+	       for(i=0; i<nf; i++) {
+		  if (len == StrLen(bp2->proc.lnames[i]) &&
+		      !strncmp(loc, StrLoc(bp2->proc.lnames[i]), len)) {
+
+#ifdef EventMon
+		     EVValD(&dx, E_Rref);
+		     MakeInt(i+1, &eventdesc);
+		     EVValD(&eventdesc, E_Rsub);
+#endif					/* EventMon */
+
+		     /*
+		      * Found the field, return a pointer to it.
+		      */
+		     return struct_var(&bp->record.fields[i], bp);
+		     }
+		  }
+	       fail;
+               }
+	    }
+	 else
+         body {
+            word i;
+            register union block *bp; /* doesn't need to be tended */
+
+            bp = BlkLoc(dx);
+            i = cvpos(y, (word)(bp->record.recdesc->proc.nfields));
+            if (i == CvtFail || i > bp->record.recdesc->proc.nfields)
+               fail;
+
+#ifdef EventMon
+            EVValD(&dx, E_Rref);
+            MakeInt(i, &eventdesc);
+            EVValD(&eventdesc, E_Rsub);
+#endif					/* EventMon */
+
+            /*
+             * Locate the appropriate field and return a pointer to it.
+             */
+            return struct_var(&bp->record.fields[i-1], bp);
+            }
+         }
+
+      default: {
+         /*
+          * dx must either be a string or be convertible to one. Decide
+          *  whether a substring trapped variable can be created.
+          */
+         if is:variable(x) && is:string(dx) then {
+            abstract {
+               return new tvsubs(type(x))
+               }
+            inline {
+               use_trap = 1;
+               }
+            }
+         else if cnv:tmp_string(dx) then
+            abstract {
+               return string
+               }
+         else
+            runerr(114, dx)
+
+         /*
+          * Make sure that y is a C integer.
+          */
+         if !cnv:C_integer(y) then {
+	    /*
+	     * If it isn't a C integer, but is a large integer, fail on
+	     * the out-of-range index.
+	     */
+	    if cnv : integer(y) then inline { fail; }
+	    runerr(101, y)
+	    }
+
+         body {
+            char ch;
+            word i;
+
+            /*
+             * Convert y to a position in x and fail if the position
+             *  is out of bounds.
+             */
+            i = cvpos(y, StrLen(dx));
+            if (i == CvtFail || i > StrLen(dx))
+               fail;
+            if (use_trap) {
+               /*
+                * x is a string, make a substring trapped variable for the
+                * one character substring selected and return it.
+                */
+               return tvsubs(&x, i, (word)1);
+               }
+            else {
+               /*
+                * x was converted to a string, so it cannot be assigned
+                * back into. Just return a string containing the selected
+                * character.
+                */
+               ch = *(StrLoc(dx)+i-1);
+               return string(1, (char *)&allchars[ch & 0xFF]);
+               }
+            }
+         }
+      }
+end
diff --git a/src/runtime/oset.r b/src/runtime/oset.r
new file mode 100644
index 0000000..7808e80
--- /dev/null
+++ b/src/runtime/oset.r
@@ -0,0 +1,299 @@
+/*
+ * File: oset.r
+ *  Contents: compl, diff, inter, union
+ */
+
+"~x - complement cset x."
+
+operator{1} ~ compl(x)
+   /*
+    * x must be a cset.
+    */
+   if !cnv:tmp_cset(x) then
+      runerr(104, x)
+
+   abstract {
+      return cset
+      }
+   body {
+      register int i;
+      struct b_cset *cp, *cpx;
+
+      /*
+       * Allocate a new cset and then copy each cset word from x
+       *  into the new cset words, complementing each bit.
+       */
+      Protect(cp = alccset(), runerr(0));
+      cpx = (struct b_cset *)BlkLoc(x);      /* must come after alccset() */
+      for (i = 0; i < CsetSize; i++)
+          cp->bits[i] = ~cpx->bits[i];
+      return cset(cp);
+      }
+end
+
+
+"x -- y - difference of csets x and y or of sets x and y."
+
+operator{1} -- diff(x,y)
+   if is:set(x) && is:set(y) then {
+      abstract {
+         return type(x)
+         }
+      body {
+	 int res;
+         register int i;
+         register word slotnum;
+         tended union block *srcp, *tstp, *dstp;
+         tended struct b_slots *seg;
+         tended struct b_selem *ep;
+         struct b_selem *np;
+         union block **hook;
+
+         /*
+          * Make a new set based on the size of x.
+          */
+         dstp = hmake(T_Set, (word)0, BlkLoc(x)->set.size);
+         if (dstp == NULL)
+            runerr(0);
+         /*
+          * For each element in set x if it is not in set y
+          *  copy it directly into the result set.
+	  *
+	  * np always has a new element ready for use.  We get one in advance,
+	  *  and stay one ahead, because hook can't be tended.
+          */
+         srcp = BlkLoc(x);
+         tstp = BlkLoc(y);
+         Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+
+         for (i = 0; i < HSegs && (seg = srcp->set.hdir[i]) != NULL; i++)
+            for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--) {
+               ep = (struct b_selem *)seg->hslots[slotnum];
+               while (ep != NULL) {
+                  memb(tstp, &ep->setmem, ep->hashnum, &res);
+                  if (res == 0) {
+                     hook = memb(dstp, &ep->setmem, ep->hashnum, &res);
+		     np->setmem = ep->setmem;
+		     np->hashnum = ep->hashnum;
+                     addmem(&dstp->set, np, hook);
+                     Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+                     }
+                  ep = (struct b_selem *)ep->clink;
+                  }
+               }
+	 deallocate((union block *)np);
+         if (TooSparse(dstp))
+            hshrink(dstp);
+         Desc_EVValD(dstp, E_Screate, D_Set);
+         return set(dstp);
+         }
+      }
+   else {
+      if !cnv:tmp_cset(x) then
+         runerr(120, x)
+      if !cnv:tmp_cset(y) then
+         runerr(120, y)
+      abstract {
+         return cset
+         }
+      /*
+       * Allocate a new cset and in each word of it, compute the value
+       *  of the bitwise difference of the corresponding words in the
+       *  Arg1 and Arg2 csets.
+       */
+      body {
+         struct b_cset *cp, *cpx, *cpy;
+         register int i;
+
+         Protect(cp = alccset(), runerr(0));
+         cpx = (struct b_cset *)BlkLoc(x);  /* must come after alccset() */
+         cpy = (struct b_cset *)BlkLoc(y);  /* must come after alccset() */
+         for (i = 0; i < CsetSize; i++)
+            cp->bits[i] = cpx->bits[i] & ~cpy->bits[i];
+         return cset(cp);
+         }
+      }
+end
+
+
+"x ** y - intersection of csets x and y or of sets x and y."
+
+operator{1} ** inter(x,y)
+   if is:set(x) && is:set(y) then {
+      abstract {
+         return new set(store[type(x).set_elem] ** store[type(y).set_elem])
+         }
+      body {
+	 int res;
+         register int i;
+         register word slotnum;
+         tended union block *srcp, *tstp, *dstp;
+         tended struct b_slots *seg;
+         tended struct b_selem *ep;
+         struct b_selem *np;
+         union block **hook;
+
+         /*
+          * Make a new set the size of the smaller argument set.
+          */
+         dstp = hmake(T_Set, (word)0,
+            Min(BlkLoc(x)->set.size, BlkLoc(y)->set.size));
+         if (dstp == NULL)
+            runerr(0);
+         /*
+          * Using the smaller of the two sets as the source
+          *  copy directly into the result each of its elements
+          *  that are also members of the other set.
+	  *
+	  * np always has a new element ready for use.  We get one in advance,
+	  *  and stay one ahead, because hook can't be tended.
+          */
+         if (BlkLoc(x)->set.size <= BlkLoc(y)->set.size) {
+            srcp = BlkLoc(x);
+            tstp = BlkLoc(y);
+            }
+         else {
+            srcp = BlkLoc(y);
+            tstp = BlkLoc(x);
+            }
+         Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+         for (i = 0; i < HSegs && (seg = srcp->set.hdir[i]) != NULL; i++)
+            for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--) {
+               ep = (struct b_selem *)seg->hslots[slotnum];
+               while (ep != NULL) {
+                  memb(tstp, &ep->setmem, ep->hashnum, &res);
+                  if (res != 0) {
+                     hook = memb(dstp, &ep->setmem, ep->hashnum, &res);
+		     np->setmem = ep->setmem;
+		     np->hashnum = ep->hashnum;
+                     addmem(&dstp->set, np, hook);
+                     Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+                     }
+                  ep = (struct b_selem *)ep->clink;
+                  }
+               }
+	 deallocate((union block *)np);
+         if (TooSparse(dstp))
+            hshrink(dstp);
+         Desc_EVValD(dstp, E_Screate, D_Set);
+         return set(dstp);
+         }
+      }
+   else {
+
+      if !cnv:tmp_cset(x) then
+         runerr(120, x)
+      if !cnv:tmp_cset(y) then
+         runerr(120, y)
+      abstract {
+         return cset
+         }
+
+      /*
+       * Allocate a new cset and in each word of it, compute the value
+       *  of the bitwise intersection of the corresponding words in the
+       *  x and y csets.
+       */
+      body {
+         struct b_cset *cp, *cpx, *cpy;
+         register int i;
+
+         Protect(cp = alccset(), runerr(0));
+         cpx = (struct b_cset *)BlkLoc(x);  /* must come after alccset() */
+         cpy = (struct b_cset *)BlkLoc(y);  /* must come after alccset() */
+         for (i = 0; i < CsetSize; i++) {
+            cp->bits[i] = cpx->bits[i] & cpy->bits[i];
+            }
+         return cset(cp);
+         }
+      }
+end
+
+
+"x ++ y - union of csets x and y or of sets x and y."
+
+operator{1} ++ union(x,y)
+   if is:set(x) && is:set(y) then {
+      abstract {
+         return new set(store[type(x).set_elem] ++ store[type(y).set_elem])
+         }
+      body {
+	 int res;
+	 register int i;
+	 register word slotnum;
+         struct descrip d;
+         tended union block *dstp;
+         tended struct b_slots *seg;
+         tended struct b_selem *ep;
+         struct b_selem *np;
+         union block **hook;
+
+         /*
+          * Ensure that x is the larger set; if not, swap.
+          */
+         if (BlkLoc(y)->set.size > BlkLoc(x)->set.size) {
+	    d = x;
+	    x = y;
+	    y = d;
+	    }
+         /*
+          * Copy x and ensure there's room for *x + *y elements.
+          */
+         if (cpset(&x, &result, BlkLoc(x)->set.size + BlkLoc(y)->set.size)
+            == Error)
+            runerr(0);
+         /*
+          * Copy each element from y into the result, if not already there.
+	  *
+	  * np always has a new element ready for use.  We get one in advance,
+	  *  and stay one ahead, because hook can't be tended.
+          */
+         dstp = BlkLoc(result);
+         Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+         for (i = 0; i < HSegs && (seg = BlkLoc(y)->set.hdir[i]) != NULL; i++)
+            for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--) {
+               ep = (struct b_selem *)seg->hslots[slotnum];
+               while (ep != NULL) {
+                  hook = memb(dstp, &ep->setmem, ep->hashnum, &res);
+                  if (res == 0) {
+		     np->setmem = ep->setmem;
+		     np->hashnum = ep->hashnum;
+                     addmem(&dstp->set, np, hook);
+                     Protect(np = alcselem(&nulldesc, (uword)0), runerr(0));
+                     }
+                  ep = (struct b_selem *)ep->clink;
+                  }
+               }
+	 deallocate((union block *)np);
+         if (TooCrowded(dstp))		/* if the union got too big, enlarge */
+            hgrow(dstp);
+         return result;
+	 }
+      }
+   else {
+      if !cnv:tmp_cset(x) then
+         runerr(120, x)
+      if !cnv:tmp_cset(y) then
+         runerr(120, y)
+      abstract {
+         return cset
+         }
+
+      /*
+       * Allocate a new cset and in each word of it, compute the value
+       *  of the bitwise union of the corresponding words in the
+       *  x and y csets.
+       */
+      body {
+         struct b_cset *cp, *cpx, *cpy;
+         register int i;
+
+         Protect(cp = alccset(), runerr(0));
+         cpx = (struct b_cset *)BlkLoc(x);  /* must come after alccset() */
+         cpy = (struct b_cset *)BlkLoc(y);  /* must come after alccset() */
+         for (i = 0; i < CsetSize; i++)
+            cp->bits[i] = cpx->bits[i] | cpy->bits[i];
+         return cset(cp);
+         }
+      }
+end
diff --git a/src/runtime/ovalue.r b/src/runtime/ovalue.r
new file mode 100644
index 0000000..e428868
--- /dev/null
+++ b/src/runtime/ovalue.r
@@ -0,0 +1,72 @@
+/*
+ * File: ovalue.r
+ *  Contents: nonnull, null, value, conj
+ */
+
+"\\x - test x for nonnull value."
+
+operator{0,1} \ nonnull(underef x -> dx)
+   abstract {
+      return type(x)
+      }
+   /*
+    * If the dereferenced value dx is not null, the pre-dereferenced
+    *  x is returned, otherwise, the function fails.
+    */
+   if is:null(dx) then
+      inline {
+         fail;
+         }
+   else {
+      inline {
+         return x;
+         }
+      }
+end
+
+
+
+"/x - test x for null value."
+
+operator{0,1} / null(underef x -> dx)
+   abstract {
+      return type(x)
+      }
+   /*
+    * If the dereferenced value dx is null, the pre-derefereneced value
+    *  x is returned, otherwise, the function fails.
+    */
+   if is:null(dx) then {
+      inline {
+         return x;
+         }
+      }
+   else
+      inline {
+         fail;
+      }
+end
+
+
+".x - produce value of x."
+
+operator{1} . value(x)
+  abstract {
+     return type(x)
+     }
+  inline {
+     return x;
+     }
+end
+
+
+"x & y - produce value of y."
+
+operator{1} & conj(underef x, underef y)
+   abstract {
+      return type(y)
+      }
+   inline {
+      return y;
+      }
+end
diff --git a/src/runtime/ralc.r b/src/runtime/ralc.r
new file mode 100644
index 0000000..9f55671
--- /dev/null
+++ b/src/runtime/ralc.r
@@ -0,0 +1,784 @@
+/*
+ * File: ralc.r
+ *  Contents: allocation routines
+ */
+
+/*
+ * Prototypes.
+ */
+static struct region *findgap	(struct region *curr, word nbytes);
+static struct region *newregion	(word nbytes, word stdsize);
+
+extern word alcnum;
+
+#ifndef MultiThread
+word coexp_ser = 2;	/* serial numbers for co-expressions; &main is 1 */
+word list_ser = 1;	/* serial numbers for lists */
+word set_ser = 1;	/* serial numbers for sets */
+word table_ser = 1;	/* serial numbers for tables */
+#endif					/* MultiThread */
+
+
+/*
+ * AlcBlk - allocate a block.
+ */
+#begdef AlcBlk(var, struct_nm, t_code, nbytes)
+{
+#ifdef MultiThread
+   EVVal((word)nbytes, typech[t_code]);
+#endif					/* MultiThread */
+
+   /*
+    * Ensure that there is enough room in the block region.
+    */
+   if (DiffPtrs(blkend,blkfree) < nbytes && !reserve(Blocks, nbytes))
+      return NULL;
+
+   /*
+    * If monitoring, show the allocation.
+    */
+#ifndef MultiThread
+   EVVal((word)nbytes, typech[t_code]);
+#endif
+
+   /*
+    * Decrement the free space in the block region by the number of bytes
+    *  allocated and return the address of the first byte of the allocated
+    *  block.
+    */
+   blktotal += nbytes;
+   var = (struct struct_nm *)blkfree;
+   blkfree += nbytes;
+   var->title = t_code;
+}
+#enddef
+
+/*
+ * AlcFixBlk - allocate a fixed length block.
+ */
+#define AlcFixBlk(var, struct_nm, t_code)\
+   AlcBlk(var, struct_nm, t_code, sizeof(struct struct_nm))
+
+/*
+ * AlcVarBlk - allocate a variable-length block.
+ */
+#begdef AlcVarBlk(var, struct_nm, t_code, n_desc)
+   {
+#ifdef EventMon
+   uword size;
+#else					/* EventMon */
+   register uword size;
+#endif					/* EventMon */
+
+   /*
+    * Variable size blocks are declared with one descriptor, thus
+    *  we need add in only n_desc - 1 descriptors.
+    */
+   size = sizeof(struct struct_nm) + (n_desc - 1) * sizeof(struct descrip);
+   AlcBlk(var, struct_nm, t_code, size)
+   var->blksize = size;
+   }
+#enddef
+
+/*
+ * alcactiv - allocate a co-expression activation block.
+ */
+
+struct astkblk *alcactiv()
+   {
+   struct astkblk *abp;
+
+   abp = (struct astkblk *)malloc(sizeof(struct astkblk));
+
+   /*
+    * If malloc failed, attempt to free some co-expression blocks and retry.
+    */
+   if (abp == NULL) {
+      collect(Static);
+      abp = (struct astkblk *)malloc(sizeof(struct astkblk));
+      }
+
+   if (abp == NULL)
+      ReturnErrNum(305, NULL);
+   abp->nactivators = 0;
+   abp->astk_nxt = NULL;
+   return abp;
+   }
+
+#ifdef LargeInts
+/*
+ * alcbignum - allocate an n-digit bignum in the block region
+ */
+
+struct b_bignum *alcbignum(n)
+word n;
+   {
+   register struct b_bignum *blk;
+   register uword size;
+
+   size = sizeof(struct b_bignum) + ((n - 1) * sizeof(DIGIT));
+   /* ensure whole number of words allocated */
+   size = (size + WordSize - 1) & -WordSize;
+   AlcBlk(blk, b_bignum, T_Lrgint, size);
+   blk->blksize = size;
+   blk->msd = blk->sign = 0;
+   blk->lsd = n - 1;
+   return blk;
+   }
+#endif					/* LargeInts */
+
+/*
+ * alccoexp - allocate a co-expression stack block.
+ */
+
+#if COMPILER
+struct b_coexpr *alccoexp()
+   {
+   struct b_coexpr *ep;
+   static int serial = 2; /* main co-expression is allocated elsewhere */
+   ep = (struct b_coexpr *)malloc(stksize);
+
+   /*
+    * If malloc failed or if there have been too many co-expression allocations
+    * since a collection, attempt to free some co-expression blocks and retry.
+    */
+
+   if (ep == NULL || alcnum > AlcMax) {
+      collect(Static);
+      ep = (struct b_coexpr *)malloc(stksize);
+      }
+
+   if (ep == NULL)
+      ReturnErrNum(305, NULL);
+
+   alcnum++;                    /* increment allocation count since last g.c. */
+
+   ep->title = T_Coexpr;
+   ep->size = 0;
+   ep->id = serial++;
+   ep->nextstk = stklist;
+   ep->es_tend = NULL;
+   ep->file_name = "";
+   ep->line_num = 0;
+   ep->freshblk = nulldesc;
+   ep->es_actstk = NULL;
+   ep->cstate[0] = 0;		/* zero the first two cstate words as a flag */
+   ep->cstate[1] = 0;
+   stklist = ep;
+   return ep;
+   }
+#else					/* COMPILER */
+#ifdef MultiThread
+/*
+ * If this is a new program being loaded, an icodesize>0 gives the
+ * hdr.hsize and a stacksize to use; allocate
+ * sizeof(progstate) + icodesize + mstksize
+ * Otherwise (icodesize==0), allocate a normal stksize...
+ */
+struct b_coexpr *alccoexp(icodesize, stacksize)
+long icodesize, stacksize;
+#else					/* MultiThread */
+struct b_coexpr *alccoexp()
+#endif					/* MultiThread */
+
+   {
+   struct b_coexpr *ep;
+
+#ifdef MultiThread
+   if (icodesize > 0) {
+      ep = (struct b_coexpr *)
+	calloc(1, stacksize+
+		       icodesize+
+		       sizeof(struct progstate)+
+		       sizeof(struct b_coexpr));
+      }
+   else
+#endif					/* MultiThread */
+
+   ep = (struct b_coexpr *)malloc(stksize);
+
+   /*
+    * If malloc failed or if there have been too many co-expression allocations
+    * since a collection, attempt to free some co-expression blocks and retry.
+    */
+
+   if (ep == NULL || alcnum > AlcMax) {
+
+      collect(Static);
+
+#ifdef MultiThread
+      if (icodesize>0) {
+         ep = (struct b_coexpr *)
+	    malloc(mstksize+icodesize+sizeof(struct progstate));
+         }
+      else
+#endif					/* MultiThread */
+
+         ep = (struct b_coexpr *)malloc(stksize);
+      }
+      if (ep == NULL)
+         ReturnErrNum(305, NULL);
+
+   alcnum++;		/* increment allocation count since last g.c. */
+
+   ep->title = T_Coexpr;
+   ep->es_actstk = NULL;
+   ep->size = 0;
+#ifdef MultiThread
+   ep->es_pfp = NULL;
+   ep->es_gfp = NULL;
+   ep->es_argp = NULL;
+   ep->tvalloc = NULL;
+
+   if (icodesize > 0)
+      ep->id = 1;
+   else
+#endif					/* MultiThread */
+   ep->id = coexp_ser++;
+   ep->nextstk = stklist;
+   ep->es_tend = NULL;
+   ep->cstate[0] = 0;		/* zero the first two cstate words as a flag */
+   ep->cstate[1] = 0;
+
+#ifdef MultiThread
+   /*
+    * Initialize program state to self for &main; curpstate for others.
+    */
+   if(icodesize>0) ep->program = (struct progstate *)(ep+1);
+   else ep->program = curpstate;
+#endif					/* MultiThread */
+
+   stklist = ep;
+   return ep;
+   }
+#endif					/* COMPILER */
+
+/*
+ * alccset - allocate a cset in the block region.
+ */
+
+struct b_cset *alccset()
+   {
+   register struct b_cset *blk;
+   register int i;
+
+   AlcFixBlk(blk, b_cset, T_Cset)
+   blk->size = -1;              /* flag size as not yet computed */
+
+   /*
+    * Zero the bit array.
+    */
+   for (i = 0; i < CsetSize; i++)
+     blk->bits[i] = 0;
+   return blk;
+   }
+
+/*
+ * alcfile - allocate a file block in the block region.
+ */
+
+struct b_file *alcfile(fd, status, name)
+FILE *fd;
+int status;
+dptr name;
+   {
+   tended struct descrip tname = *name;
+   register struct b_file *blk;
+
+   AlcFixBlk(blk, b_file, T_File)
+   blk->fd = fd;
+   blk->status = status;
+   blk->fname = tname;
+   return blk;
+   }
+
+/*
+ * alchash - allocate a hashed structure (set or table header) in the block
+ *  region.
+ */
+union block *alchash(tcode)
+int tcode;
+   {
+   register int i;
+   register struct b_set *ps;
+   register struct b_table *pt;
+
+   if (tcode == T_Table) {
+      AlcFixBlk(pt, b_table, T_Table);
+      ps = (struct b_set *)pt;
+      ps->id = table_ser++;
+      }
+   else {	/* tcode == T_Set */
+      AlcFixBlk(ps, b_set, T_Set);
+      ps->id = set_ser++;
+      }
+   ps->size = 0;
+   ps->mask = 0;
+   for (i = 0; i < HSegs; i++)
+      ps->hdir[i] = NULL;
+   return (union block *)ps;
+   }
+
+/*
+ * alcsegment - allocate a slot block in the block region.
+ */
+
+struct b_slots *alcsegment(nslots)
+word nslots;
+   {
+   uword size;
+   register struct b_slots *blk;
+
+   size = sizeof(struct b_slots) + WordSize * (nslots - HSlots);
+   AlcBlk(blk, b_slots, T_Slots, size);
+   blk->blksize = size;
+   while (--nslots >= 0)
+      blk->hslots[nslots] = NULL;
+   return blk;
+   }
+
+/*
+ * alclist - allocate a list header block in the block region.
+ *
+ *  Forces a g.c. if there's not enough room for the whole list.
+ */
+
+struct b_list *alclist(size)
+uword size;
+   {
+   register struct b_list *blk;
+
+   if (!reserve(Blocks, (word)(sizeof(struct b_list) + sizeof (struct b_lelem)
+      + (size - 1) * sizeof(struct descrip)))) return NULL;
+   AlcFixBlk(blk, b_list, T_List)
+   blk->size = size;
+   blk->id = list_ser++;
+   blk->listhead = NULL;
+   blk->listtail = NULL;
+   return blk;
+   }
+
+/*
+ * alclstb - allocate a list element block in the block region.
+ */
+
+struct b_lelem *alclstb(nslots, first, nused)
+uword nslots, first, nused;
+   {
+   register struct b_lelem *blk;
+   register word i;
+
+   AlcVarBlk(blk, b_lelem, T_Lelem, nslots)
+   blk->nslots = nslots;
+   blk->first = first;
+   blk->nused = nused;
+   blk->listprev = NULL;
+   blk->listnext = NULL;
+   /*
+    * Set all elements to &null.
+    */
+   for (i = 0; i < nslots; i++)
+      blk->lslots[i] = nulldesc;
+   return blk;
+   }
+
+/*
+ * alcreal - allocate a real value in the block region.
+ */
+
+struct b_real *alcreal(val)
+double val;
+   {
+   register struct b_real *blk;
+
+   AlcFixBlk(blk, b_real, T_Real)
+
+#ifdef Double
+/* access real values one word at a time */
+   { int *rp, *rq;
+     rp = (int *) &(blk->realval);
+     rq = (int *) &val;
+     *rp++ = *rq++;
+     *rp   = *rq;
+   }
+#else					/* Double */
+   blk->realval = val;
+#endif					/* Double */
+
+   return blk;
+   }
+
+/*
+ * alcrecd - allocate record with nflds fields in the block region.
+ */
+
+struct b_record *alcrecd(nflds, recptr)
+int nflds;
+union block *recptr;
+   {
+   tended union block *trecptr = recptr;
+   register struct b_record *blk;
+
+   AlcVarBlk(blk, b_record, T_Record, nflds)
+   blk->recdesc = trecptr;
+   blk->id = (((struct b_proc *)recptr)->recid)++;
+   return blk;
+   }
+
+/*
+ * alcrefresh - allocate a co-expression refresh block.
+ */
+
+#if COMPILER
+struct b_refresh *alcrefresh(na, nl, nt, wrk_sz)
+int na;
+int nl;
+int nt;
+int wrk_sz;
+   {
+   struct b_refresh *blk;
+
+   AlcVarBlk(blk, b_refresh, T_Refresh, na + nl)
+   blk->nlocals = nl;
+   blk->nargs = na;
+   blk->ntemps = nt;
+   blk->wrk_size = wrk_sz;
+   return blk;
+   }
+#else					/* COMPILER */
+struct b_refresh *alcrefresh(entryx, na, nl)
+word *entryx;
+int na, nl;
+   {
+   struct b_refresh *blk;
+
+   AlcVarBlk(blk, b_refresh, T_Refresh, na + nl);
+   blk->ep = entryx;
+   blk->numlocals = nl;
+   return blk;
+   }
+#endif					/* COMPILER */
+
+/*
+ * alcselem - allocate a set element block.
+ */
+
+struct b_selem *alcselem(mbr,hn)
+uword hn;
+dptr mbr;
+
+   {
+   tended struct descrip tmbr = *mbr;
+   register struct b_selem *blk;
+
+   AlcFixBlk(blk, b_selem, T_Selem)
+   blk->clink = NULL;
+   blk->setmem = tmbr;
+   blk->hashnum = hn;
+   return blk;
+   }
+
+/*
+ * alcstr - allocate a string in the string space.
+ */
+
+char *alcstr(s, slen)
+register char *s;
+register word slen;
+   {
+   tended struct descrip ts;
+   register char *d;
+   char *ofree;
+
+#ifdef MultiThread
+   StrLen(ts) = slen;
+   StrLoc(ts) = s;
+#ifdef EventMon
+   if (!noMTevents)
+#endif					/* EventMon */
+      EVVal(slen, E_String);
+   s = StrLoc(ts);
+#endif					/* MultiThread */
+
+   /*
+    * Make sure there is enough room in the string space.
+    */
+   if (DiffPtrs(strend,strfree) < slen) {
+      StrLen(ts) = slen;
+      StrLoc(ts) = s;
+      if (!reserve(Strings, slen))
+         return NULL;
+      s = StrLoc(ts);
+      }
+
+   strtotal += slen;
+
+   /*
+    * Copy the string into the string space, saving a pointer to its
+    *  beginning.  Note that s may be null, in which case the space
+    *  is still to be allocated but nothing is to be copied into it.
+    */
+   ofree = d = strfree;
+   if (s) {
+      while (slen-- > 0)
+         *d++ = *s++;
+      }
+   else
+      d += slen;
+
+   strfree = d;
+   return ofree;
+   }
+
+/*
+ * alcsubs - allocate a substring trapped variable in the block region.
+ */
+
+struct b_tvsubs *alcsubs(len, pos, var)
+word len, pos;
+dptr var;
+   {
+   tended struct descrip tvar = *var;
+   register struct b_tvsubs *blk;
+
+   AlcFixBlk(blk, b_tvsubs, T_Tvsubs)
+   blk->sslen = len;
+   blk->sspos = pos;
+   blk->ssvar = tvar;
+   return blk;
+   }
+
+/*
+ * alctelem - allocate a table element block in the block region.
+ */
+
+struct b_telem *alctelem()
+   {
+   register struct b_telem *blk;
+
+   AlcFixBlk(blk, b_telem, T_Telem)
+   blk->hashnum = 0;
+   blk->clink = NULL;
+   blk->tref = nulldesc;
+   return blk;
+   }
+
+/*
+ * alctvtbl - allocate a table element trapped variable block in the block
+ *  region.
+ */
+
+struct b_tvtbl *alctvtbl(tbl, ref, hashnum)
+register dptr tbl, ref;
+uword hashnum;
+   {
+   tended struct descrip ttbl = *tbl;
+   tended struct descrip tref = *ref;
+   register struct b_tvtbl *blk;
+
+   AlcFixBlk(blk, b_tvtbl, T_Tvtbl)
+   blk->hashnum = hashnum;
+   blk->clink = BlkLoc(ttbl);
+   blk->tref = tref;
+   return blk;
+   }
+
+/*
+ * deallocate - return a block to the heap.
+ *
+ *  The block must be the one that is at the very end of a block region.
+ */
+void deallocate (bp)
+union block *bp;
+{
+   word nbytes;
+   struct region *rp;
+
+   nbytes = BlkSize(bp);
+   for (rp = curblock; rp; rp = rp->next)
+      if ((char *)bp + nbytes == rp->free)
+         break;
+   if (!rp)
+      for (rp = curblock->prev; rp; rp = rp->prev)
+	 if ((char *)bp + nbytes == rp->free)
+            break;
+   if (!rp)
+      syserr ("deallocation botch");
+   rp->free = (char *)bp;
+   blktotal -= nbytes;
+   EVVal(nbytes, E_BlkDeAlc);
+}
+
+/*
+ * reserve -- ensure space in either string or block region.
+ *
+ *   1. check for space in current region.
+ *   2. check for space in older regions.
+ *   3. check for space in newer regions.
+ *   4. set goal of 10% of size of newest region.
+ *   5. collect regions, newest to oldest, until goal met.
+ *   6. allocate new region at 200% the size of newest existing.
+ *   7. reset goal back to original request.
+ *   8. collect regions that were too small to bother with before.
+ *   9. search regions, newest to oldest.
+ *  10. give up and signal error.
+ */
+
+char *reserve(region, nbytes)
+int region;
+word nbytes;
+{
+   struct region **pcurr, *curr, *rp;
+   word want, newsize;
+   extern int qualfail;
+
+   if (region == Strings)
+      pcurr = &curstring;
+   else
+      pcurr = &curblock;
+   curr = *pcurr;
+
+   /*
+    * Check for space available now.
+    */
+   if (DiffPtrs(curr->end, curr->free) >= nbytes)
+      return curr->free;		/* quick return: current region is OK */
+
+   if ((rp = findgap(curr, nbytes)) != 0) {    /* check all regions on chain */
+      *pcurr = rp;			/* switch regions */
+      return rp->free;
+      }
+
+   /*
+    * Set "curr" to point to newest region.
+    */
+   while (curr->next)
+      curr = curr->next;
+
+   /*
+    * Need to collect garbage.  To reduce thrashing, set a minimum requirement
+    *  of 10% of the size of the newest region, and collect regions until that
+    *  amount of free space appears in one of them.
+    */
+   want = (curr->size / 100) * memcushion;
+   if (want < nbytes)
+      want = nbytes;
+
+   for (rp = curr; rp; rp = rp->prev)
+      if (rp->size >= want) {	/* if large enough to possibly succeed */
+         *pcurr = rp;
+         collect(region);
+         if (DiffPtrs(rp->end,rp->free) >= want)
+            return rp->free;
+         }
+
+   /*
+    * That didn't work.  Allocate a new region with a size based on the
+    * newest previous region.
+    */
+   newsize = (curr->size / 100) * memgrowth;
+   if (newsize < nbytes)
+      newsize = nbytes;
+   if (newsize < MinAbrSize)
+      newsize = MinAbrSize;
+
+   if ((rp = newregion(nbytes, newsize)) != 0) {
+      rp->prev = curr;
+      rp->next = NULL;
+      curr->next = rp;
+      rp->Gnext = curr;
+      rp->Gprev = curr->Gprev;
+      if (curr->Gprev) curr->Gprev->Gnext = rp;
+      curr->Gprev = rp;
+      *pcurr = rp;
+#ifdef EventMon
+      if (!noMTevents) {
+         if (region == Strings) {
+            EVVal(rp->size, E_TenureString);
+            }
+         else {
+            EVVal(rp->size, E_TenureBlock);
+            }
+         }
+#endif					/* EventMon */
+      return rp->free;
+      }
+
+   /*
+    * Allocation failed.  Try to continue, probably thrashing all the way.
+    *  Collect the regions that weren't collected before and see if any
+    *  region has enough to satisfy the original request.
+    */
+   for (rp = curr; rp; rp = rp->prev)
+      if (rp->size < want) {		/* if not collected earlier */
+         *pcurr = rp;
+         collect(region);
+         if (DiffPtrs(rp->end,rp->free) >= want)
+            return rp->free;
+         }
+   if ((rp = findgap(curr, nbytes)) != 0) {
+      *pcurr = rp;
+      return rp->free;
+      }
+
+   /*
+    * All attempts failed.
+    */
+   if (region == Blocks)
+      ReturnErrNum(307, 0);
+   else if (qualfail)
+      ReturnErrNum(304, 0);
+   else
+      ReturnErrNum(306, 0);
+}
+
+/*
+ * findgap - search region chain for a region having at least nbytes available
+ */
+static struct region *findgap(curr, nbytes)
+struct region *curr;
+word nbytes;
+   {
+   struct region *rp;
+
+   for (rp = curr; rp; rp = rp->prev)
+      if (DiffPtrs(rp->end, rp->free) >= nbytes)
+         return rp;
+   for (rp = curr->next; rp; rp = rp->next)
+      if (DiffPtrs(rp->end, rp->free) >= nbytes)
+         return rp;
+   return NULL;
+   }
+
+/*
+ * newregion - try to malloc a new region and tenure the old one,
+ *  backing off if the requested size fails.
+ */
+static struct region *newregion(nbytes,stdsize)
+word nbytes,stdsize;
+{
+   uword minSize = MinAbrSize;
+   struct region *rp;
+
+   if ((uword)nbytes > minSize)
+      minSize = (uword)nbytes;
+   rp = (struct region *)malloc(sizeof(struct region));
+   if (rp) {
+      rp->size = stdsize;
+      if (rp->size < nbytes)
+         rp->size = Max(nbytes+stdsize, nbytes);
+      do {
+         rp->free = rp->base = (char *)AllocReg(rp->size);
+         if (rp->free != NULL) {
+            rp->end = rp->base + rp->size;
+            return rp;
+            }
+         else {
+            }
+         rp->size = (rp->size + nbytes)/2 - 1;
+         }
+      while (rp->size >= minSize);
+      free((char *)rp);
+      }
+   return NULL;
+}
diff --git a/src/runtime/rcoexpr.r b/src/runtime/rcoexpr.r
new file mode 100644
index 0000000..4036ef6
--- /dev/null
+++ b/src/runtime/rcoexpr.r
@@ -0,0 +1,315 @@
+/*
+ * File: rcoexpr.r -- co_init, co_chng
+ */
+
+#if COMPILER
+static continuation coexpr_fnc;  /* function to call after switching stacks */
+#endif					/* COMPILER */
+
+/*
+ * co_init - use the contents of the refresh block to initialize the
+ *  co-expression.
+ */
+void co_init(sblkp)
+struct b_coexpr *sblkp;
+{
+#ifndef Coexpr
+   syserr("co_init() called, but co-expressions not implemented");
+#else					/* Coexpr */
+   register word *newsp;
+   register struct b_refresh *rblkp;
+   register dptr dp, dsp;
+   int frame_size;
+   word stack_strt;
+   int na, nl, nt, i;
+
+   /*
+    * Get pointer to refresh block.
+    */
+   rblkp = (struct b_refresh *)BlkLoc(sblkp->freshblk);
+
+#if COMPILER
+   na = rblkp->nargs;                /* number of arguments */
+   nl = rblkp->nlocals;              /* number of locals */
+   nt = rblkp->ntemps;               /* number of temporaries */
+
+   /*
+    * The C stack must be aligned on the correct boundary. For up-growing
+    *  stacks, the C stack starts after the initial procedure frame of
+    *  the co-expression block. For down-growing stacks, the C stack starts
+    *  at the last word of the co-expression block.
+    */
+#ifdef UpStack
+   frame_size = sizeof(struct p_frame) + sizeof(struct descrip) * (nl + na +
+      nt - 1) + rblkp->wrk_size;
+   stack_strt = (word)((char *)&sblkp->pf + frame_size + StackAlign*WordSize);
+#else					/* UpStack */
+   stack_strt = (word)((char *)sblkp + stksize - WordSize);
+#endif					/* UpStack */
+   sblkp->cstate[0] = stack_strt & ~(WordSize * StackAlign - 1);
+
+   sblkp->es_argp = &sblkp->pf.tend.d[nl + nt];   /* args follow temporaries */
+
+#else					/* COMPILER */
+
+   na = (rblkp->pfmkr).pf_nargs + 1; /* number of arguments */
+   nl = (int)rblkp->numlocals;       /* number of locals */
+
+   /*
+    * The interpreter stack starts at word after co-expression stack block.
+    *  C stack starts at end of stack region on machines with down-growing C
+    *  stacks and somewhere in the middle of the region.
+    *
+    * The C stack is aligned on a doubleword boundary.	For up-growing
+    *  stacks, the C stack starts in the middle of the stack portion
+    *  of the static block.  For down-growing stacks, the C stack starts
+    *  at the last word of the static block.
+    */
+
+   newsp = (word *)((char *)sblkp + sizeof(struct b_coexpr));
+
+#ifdef UpStack
+   sblkp->cstate[0] =
+      ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2)
+         &~((word)WordSize*StackAlign-1));
+#else					/* UpStack */
+   sblkp->cstate[0] =
+	((word)((char *)sblkp + stksize - WordSize)
+           &~((word)WordSize*StackAlign-1));
+#endif					/* UpStack */
+
+   sblkp->es_argp = (dptr)newsp;  /* args are first thing on stack */
+
+#endif					/* COMPILER */
+
+   /*
+    * Copy arguments onto new stack.
+    */
+   dsp = sblkp->es_argp;
+   dp = rblkp->elems;
+   for (i = 1; i <=  na; i++)
+      *dsp++ = *dp++;
+
+   /*
+    * Set up state variables and initialize procedure frame.
+    */
+#if COMPILER
+   sblkp->es_pfp = &sblkp->pf;
+   sblkp->es_tend = &sblkp->pf.tend;
+   sblkp->pf.old_pfp = NULL;
+   sblkp->pf.rslt = NULL;
+   sblkp->pf.succ_cont = NULL;
+   sblkp->pf.tend.previous = NULL;
+   sblkp->pf.tend.num = nl + na + nt;
+   sblkp->es_actstk = NULL;
+#else					/* COMPILER */
+   *((struct pf_marker *)dsp) = rblkp->pfmkr;
+   sblkp->es_pfp = (struct pf_marker *)dsp;
+   sblkp->es_tend = NULL;
+   dsp = (dptr)((word *)dsp + Vwsizeof(*pfp));
+   sblkp->es_ipc.opnd = rblkp->ep;
+   sblkp->es_gfp = 0;
+   sblkp->es_efp = 0;
+   sblkp->es_ilevel = 0;
+#endif					/* COMPILER */
+   sblkp->tvalloc = NULL;
+
+   /*
+    * Copy locals into the co-expression.
+    */
+#if COMPILER
+   dsp = sblkp->pf.tend.d;
+#endif					/* COMPILER */
+   for (i = 1; i <= nl; i++)
+      *dsp++ = *dp++;
+
+#if COMPILER
+   /*
+    * Initialize temporary variables.
+    */
+   for (i = 1; i <= nt; i++)
+      *dsp++ = nulldesc;
+#else					/* COMPILER */
+   /*
+    * Push two null descriptors on the stack.
+    */
+   *dsp++ = nulldesc;
+   *dsp++ = nulldesc;
+
+   sblkp->es_sp = (word *)dsp - 1;
+#endif					/* COMPILER */
+
+#endif					/* Coexpr */
+   }
+
+/*
+ * co_chng - high-level co-expression context switch.
+ */
+int co_chng(ncp, valloc, rsltloc, swtch_typ, first)
+struct b_coexpr *ncp;
+struct descrip *valloc; /* location of value being transmitted */
+struct descrip *rsltloc;/* location to put result */
+int swtch_typ;          /* A_Coact, A_Coret, A_Cofail, or A_MTEvent */
+int first;
+{
+#ifndef Coexpr
+   syserr("co_chng() called, but co-expressions not implemented");
+#else					/* Coexpr */
+   register struct b_coexpr *ccp;
+   static int coexp_act;     /* used to pass signal across activations */
+                             /* back to whomever activates, if they care */
+
+   ccp = (struct b_coexpr *)BlkLoc(k_current);
+
+#if !COMPILER
+#ifdef EventMon
+   switch(swtch_typ) {
+      /*
+       * A_MTEvent does not generate an event.
+       */
+      case A_MTEvent:
+	 break;
+      case A_Coact:
+         EVValX(ncp,E_Coact);
+	 if (!is:null(curpstate->eventmask)) {
+	    curpstate->parent->eventsource.dword = D_Coexpr;
+	    BlkLoc(curpstate->parent->eventsource) = (union block *)ncp;
+	    }
+	 break;
+      case A_Coret:
+         EVValX(ncp,E_Coret);
+	 if (!is:null(curpstate->eventmask)) {
+	    curpstate->parent->eventsource.dword = D_Coexpr;
+	    BlkLoc(curpstate->parent->eventsource) = (union block *)ncp;
+	    }
+	 break;
+      case A_Cofail:
+         EVValX(ncp,E_Cofail);
+	 if (!is:null(curpstate->eventmask) && ncp->program == curpstate) {
+	    curpstate->parent->eventsource.dword = D_Coexpr;
+	    BlkLoc(curpstate->parent->eventsource) = (union block *)ncp;
+	    }
+	 break;
+      }
+#endif					/* EventMon */
+#endif					/* COMPILER */
+
+   /*
+    * Determine if we need to transmit a value.
+    */
+   if (valloc != NULL) {
+
+#if !COMPILER
+      /*
+       * Determine if we need to dereference the transmitted value.
+       */
+      if (Var(*valloc))
+         retderef(valloc, (word *)glbl_argp, sp);
+#endif					/* COMPILER */
+
+      if (ncp->tvalloc != NULL)
+         *ncp->tvalloc = *valloc;
+      }
+   ncp->tvalloc = NULL;
+   ccp->tvalloc = rsltloc;
+
+   /*
+    * Save state of current co-expression.
+    */
+   ccp->es_pfp = pfp;
+   ccp->es_argp = glbl_argp;
+   ccp->es_tend = tend;
+
+#if !COMPILER
+   ccp->es_efp = efp;
+   ccp->es_gfp = gfp;
+   ccp->es_ipc = ipc;
+   ccp->es_sp = sp;
+   ccp->es_ilevel = ilevel;
+#endif					/* COMPILER */
+
+#if COMPILER
+   if (line_info) {
+      ccp->file_name = file_name;
+      ccp->line_num = line_num;
+      file_name = ncp->file_name;
+      line_num = ncp->line_num;
+      }
+#endif					/* COMPILER */
+
+#if COMPILER
+   if (debug_info)
+#endif					/* COMPILER */
+      if (k_trace)
+#ifdef EventMon
+	 if (swtch_typ != A_MTEvent)
+#endif					/* EventMon */
+         cotrace(ccp, ncp, swtch_typ, valloc);
+
+   /*
+    * Establish state for new co-expression.
+    */
+   pfp = ncp->es_pfp;
+   tend = ncp->es_tend;
+
+#if !COMPILER
+   efp = ncp->es_efp;
+   gfp = ncp->es_gfp;
+   ipc = ncp->es_ipc;
+   sp = ncp->es_sp;
+   ilevel = (int)ncp->es_ilevel;
+#endif					/* COMPILER */
+
+#if !COMPILER
+#ifdef MultiThread
+   /*
+    * Enter the program state of the co-expression being activated
+    */
+   ENTERPSTATE(ncp->program);
+#endif					/* MultiThread */
+#endif					/* COMPILER */
+
+   glbl_argp = ncp->es_argp;
+   BlkLoc(k_current) = (union block *)ncp;
+
+#if COMPILER
+   coexpr_fnc = ncp->fnc;
+#endif					/* COMPILER */
+
+#ifdef EventMon
+   /*
+    * From here on out, A_MTEvent looks like a A_Coact.
+    */
+   if (swtch_typ == A_MTEvent)
+      swtch_typ = A_Coact;
+#endif					/* EventMon */
+
+   coexp_act = swtch_typ;
+   coswitch(ccp->cstate, ncp->cstate,first);
+   return coexp_act;
+#endif					/* Coexpr */
+   }
+
+#ifdef Coexpr
+/*
+ * new_context - determine what function to call to execute the new
+ *  co-expression; this completes the context switch.
+ */
+void new_context(fsig,cargp)
+int fsig;
+dptr cargp;
+   {
+#if COMPILER
+   (*coexpr_fnc)();
+#else					/* COMPILER */
+   interp(fsig, cargp);
+#endif					/* COMPILER */
+   }
+#else					/* Coexpr */
+/* dummy new_context if co-expressions aren't supported */
+void new_context(fsig,cargp)
+int fsig;
+dptr cargp;
+   {
+   }
+#endif					/* Coexpr */
diff --git a/src/runtime/rcolor.r b/src/runtime/rcolor.r
new file mode 100644
index 0000000..a3ac813
--- /dev/null
+++ b/src/runtime/rcolor.r
@@ -0,0 +1,722 @@
+/*
+ * File: rcolor.r
+ *  graphics tables and functions related to color
+ */
+
+#ifdef Graphics
+
+static	int	colorphrase	(char *buf, long *r, long *g, long *b);
+static	double	rgbval		(double n1, double n2, double hue);
+
+/*
+ * Structures and tables used for color parsing.
+ *  Tables must be kept lexically sorted.
+ */
+
+typedef struct {	/* color name entry */
+   char name[8];	/* basic color name */
+   char ish[12];	/* -ish form */
+   short hue;		/* hue, in degrees */
+   char lgt;		/* lightness, as percentage */
+   char sat;		/* saturation, as percentage */
+} colrname;
+
+typedef struct {	/* arbitrary lookup entry */
+   char word[10];	/* word */
+   char val;		/* value, as percentage */
+} colrmod;
+
+static colrname colortable[] = {		/* known colors */
+   /* color       ish-form     hue  lgt  sat */
+   { "black",    "blackish",     0,   0,   0 },
+   { "blue",     "bluish",     240,  50, 100 },
+   { "brown",    "brownish",    30,  25, 100 },
+   { "cyan",     "cyanish",    180,  50, 100 },
+   { "gray",     "grayish",      0,  50,   0 },
+   { "green",    "greenish",   120,  50, 100 },
+   { "grey",     "greyish",      0,  50,   0 },
+   { "magenta",  "magentaish", 300,  50, 100 },
+   { "orange",   "orangish",    15,  50, 100 },
+   { "pink",     "pinkish",    345,  75, 100 },
+   { "purple",   "purplish",   270,  50, 100 },
+   { "red",      "reddish",      0,  50, 100 },
+   { "violet",   "violetish",  270,  75, 100 },
+   { "white",    "whitish",      0, 100,   0 },
+   { "yellow",   "yellowish",   60,  50, 100 },
+   };
+
+static colrmod lighttable[] = {			/* lightness modifiers */
+   { "dark",       0 },
+   { "deep",       0 },		/* = very dark (see code) */
+   { "light",    100 },
+   { "medium",    50 },
+   { "pale",     100 },		/* = very light (see code) */
+   };
+
+static colrmod sattable[] = {			/* saturation levels */
+   { "moderate",  50 },
+   { "strong",    75 },
+   { "vivid",    100 },
+   { "weak",      25 },
+   };
+
+/*
+ *  parsecolor(w, s, &r, &g, &b) - parse a color specification
+ *
+ *  parsecolor interprets a color specification and produces r/g/b values
+ *  scaled linearly from 0 to 65535.  parsecolor returns Succeeded or Failed.
+ *
+ *  An Icon color specification can be any of the forms
+ *
+ *     #rgb			(hexadecimal digits)
+ *     #rrggbb
+ *     #rrrgggbbb
+ *     #rrrrggggbbbb
+ *     nnnnn,nnnnn,nnnnn	(integers 0 - 65535)
+ *     <Icon color phrase>
+ *     <native color spec>
+ */
+
+int parsecolor(w, buf, r, g, b)
+wbp w;
+char *buf;
+long *r, *g, *b;
+   {
+   int len, mul;
+   char *fmt, c;
+   double dr, dg, db;
+
+   *r = *g = *b = 0L;
+
+   /* trim leading spaces */
+   while (isspace(*buf))
+      buf++;
+
+   /* try interpreting as three comma-separated integers */
+   if (sscanf(buf, "%lf,%lf,%lf%c", &dr, &dg, &db, &c) == 3) {
+      *r = dr;
+      *g = dg;
+      *b = db;
+      if (*r>=0 && *r<=65535 && *g>=0 && *g<=65535 && *b>=0 && *b<=65535)
+         return Succeeded;
+      else
+         return Failed;
+      }
+
+   /* try interpreting as a hexadecimal value */
+   if (*buf == '#') {
+      buf++;
+      for (len = 0; isalnum(buf[len]); len++);
+      switch (len) {
+         case  3:  fmt = "%1x%1x%1x%c";  mul = 0x1111;  break;
+         case  6:  fmt = "%2x%2x%2x%c";  mul = 0x0101;  break;
+         case  9:  fmt = "%3x%3x%3x%c";  mul = 0x0010;  break;
+         case 12:  fmt = "%4x%4x%4x%c";  mul = 0x0001;  break;
+         default:  return Failed;
+      }
+      if (sscanf(buf, fmt, r, g, b, &c) != 3)
+         return Failed;
+      *r *= mul;
+      *g *= mul;
+      *b *= mul;
+      return Succeeded;
+      }
+
+   /* try interpreting as a color phrase or as a native color spec */
+   if (colorphrase(buf, r, g, b) || nativecolor(w, buf, r, g, b))
+      return Succeeded;
+   else
+      return Failed;
+   }
+
+/*
+ *  colorphrase(s, &r, &g, &b) -- parse Icon color phrase.
+ *
+ *  An Icon color phrase matches the pattern
+ *
+ *                               weak
+ *                  pale         moderate
+ *                  light        strong
+ *          [[very] medium ]   [ vivid    ]   [color[ish]]   color
+ *                  dark
+ *                  deep
+ *
+ *  where "color" is any of:
+ *
+ *          black gray grey white pink violet brown
+ *          red orange yellow green cyan blue purple magenta
+ *
+ *  A single space or hyphen separates each word from its neighbor.  The
+ *  default lightness is "medium", and the default saturation is "vivid".
+ *
+ *  "pale" means "very light"; "deep" means "very dark".
+ *
+ *  This naming scheme is based loosely on
+ *	A New Color-Naming System for Graphics Languages
+ *	Toby Berk, Lee Brownston, and Arie Kaufman
+ *	IEEE Computer Graphics & Applications, May 1982
+ */
+
+static int colorphrase(buf, r, g, b)
+char *buf;
+long *r, *g, *b;
+   {
+   int len, very;
+   char c, *p, *ebuf, cbuffer[MAXCOLORNAME];
+   float lgt, sat, blend, bl2, m1, m2;
+   float h1, l1, s1, h2, l2, s2, r2, g2, b2;
+
+   lgt = -1.0;				/* default no lightness mod */
+   sat =  1.0;				/* default vivid saturation */
+   len = strlen(buf);
+   while (isspace(buf[len-1]))
+      len--;				/* trim trailing spaces */
+
+   if (len >= sizeof(cbuffer))
+      return 0;				/* if too long for valid Icon spec */
+
+   /*
+    * copy spec, lowering case and replacing spaces and hyphens with NULs
+    */
+   for(p = cbuffer; (c = *buf) != 0; p++, buf++) {
+      if (isupper(c)) *p = tolower(c);
+      else if (c == ' ' || c == '-') *p = '\0';
+      else *p = c;
+      }
+   *p = '\0';
+
+   buf = cbuffer;
+   ebuf = buf + len;
+   /* check for "very" */
+   if (strcmp(buf, "very") == 0) {
+      very = 1;
+      buf += strlen(buf) + 1;
+      if (buf >= ebuf)
+         return 0;
+      }
+   else
+      very = 0;
+
+   /* check for lightness adjective */
+   p = qsearch(buf, (char *)lighttable,
+      ElemCount(lighttable), ElemSize(lighttable), strcmp);
+   if (p) {
+      /* set the "very" flag for "pale" or "deep" */
+      if (strcmp(buf, "pale") == 0)
+         very = 1;			/* pale = very light */
+      else if (strcmp(buf, "deep") == 0)
+         very = 1;			/* deep = very dark */
+      /* skip past word */
+      buf += strlen(buf) + 1;
+      if (buf >= ebuf)
+         return 0;
+      /* save lightness value, but ignore "medium" */
+      if ((((colrmod *)p) -> val) != 50)
+         lgt = ((colrmod *)p) -> val / 100.0;
+      }
+   else if (very)
+      return 0;
+
+   /* check for saturation adjective */
+   p = qsearch(buf, (char *)sattable,
+      ElemCount(sattable), ElemSize(sattable), strcmp);
+   if (p) {
+      sat = ((colrmod *)p) -> val / 100.0;
+      buf += strlen(buf) + 1;
+      if (buf >= ebuf)
+         return 0;
+      }
+
+   if (buf + strlen(buf) >= ebuf)
+      blend = h1 = l1 = s1 = 0.0;	/* only one word left */
+   else {
+      /* we have two (or more) name words; get the first */
+      if ((p = qsearch(buf, colortable[0].name,
+            ElemCount(colortable), ElemSize(colortable), strcmp)) != NULL) {
+         blend = 0.5;
+         }
+      else if ((p = qsearch(buf, colortable[0].ish,
+            ElemCount(colortable), ElemSize(colortable), strcmp)) != NULL) {
+         p -= sizeof(colortable[0].name);
+         blend = 0.25;
+         }
+      else
+         return 0;
+
+      h1 = ((colrname *)p) -> hue;
+      l1 = ((colrname *)p) -> lgt / 100.0;
+      s1 = ((colrname *)p) -> sat / 100.0;
+      buf += strlen(buf) + 1;
+      }
+
+   /* process second (or only) name word */
+   p = qsearch(buf, colortable[0].name,
+      ElemCount(colortable), ElemSize(colortable), strcmp);
+   if (!p || buf + strlen(buf) < ebuf)
+      return 0;
+   h2 = ((colrname *)p) -> hue;
+   l2 = ((colrname *)p) -> lgt / 100.0;
+   s2 = ((colrname *)p) -> sat / 100.0;
+
+   /* at this point we know we have a valid spec */
+
+   /* interpolate hls specs */
+   if (blend > 0) {
+      bl2 = 1.0 - blend;
+
+      if (s1 == 0.0)
+         ; /* use h2 unchanged */
+      else if (s2 == 0.0)
+         h2 = h1;
+      else if (h2 - h1 > 180)
+         h2 = blend * h1 + bl2 * (h2 - 360);
+      else if (h1 - h2 > 180)
+         h2 = blend * (h1 - 360) + bl2 * h2;
+      else
+         h2 = blend * h1 + bl2 * h2;
+      if (h2 < 0)
+         h2 += 360;
+
+      l2 = blend * l1 + bl2 * l2;
+      s2 = blend * s1 + bl2 * s2;
+      }
+
+   /* apply saturation and lightness modifiers */
+   if (lgt >= 0.0) {
+      if (very)
+         l2 = (2 * lgt + l2) / 3.0;
+      else
+         l2 = (lgt + 2 * l2) / 3.0;
+      }
+   s2 *= sat;
+
+   /* convert h2,l2,s2 to r2,g2,b2 */
+   /* from Foley & Van Dam, 1st edition, p. 619 */
+   /* beware of dangerous typos in 2nd edition */
+   if (s2 == 0)
+      r2 = g2 = b2 = l2;
+   else {
+      if (l2 < 0.5)
+         m2 = l2 * (1 + s2);
+      else
+         m2 = l2 + s2 - l2 * s2;
+      m1 = 2 * l2 - m2;
+      r2 = rgbval(m1, m2, h2 + 120);
+      g2 = rgbval(m1, m2, h2);
+      b2 = rgbval(m1, m2, h2 - 120);
+      }
+
+   /* scale and convert the calculated result */
+   *r = 65535 * r2;
+   *g = 65535 * g2;
+   *b = 65535 * b2;
+
+   return 1;
+   }
+
+/*
+ * rgbval(n1, n2, hue) - helper function for HLS to RGB conversion
+ */
+static double rgbval(n1, n2, hue)
+double n1, n2, hue;
+   {
+   if (hue > 360)
+      hue -= 360;
+   else if (hue < 0)
+      hue += 360;
+
+   if (hue < 60)
+      return n1 + (n2 - n1) * hue / 60.0;
+   else if (hue < 180)
+      return n2;
+   else if (hue < 240)
+      return n1 + (n2 - n1) * (240 - hue) / 60.0;
+   else
+      return n1;
+   }
+
+/*
+ * Static data for XDrawImage and XPalette functions
+ */
+
+/*
+ * c<n>list - the characters of the palettes that are not contiguous ASCII
+ */
+char c1list[] = "0123456789?!nNAa#@oOBb$%pPCc&|\
+qQDd,.rREe;:sSFf+-tTGg*/uUHh`'vVIi<>wWJj()xXKk[]yYLl{}zZMm^=";
+char c2list[] = "kbgcrmywx";
+char c3list[] = "@ABCDEFGHIJKLMNOPQRSTUVWXYZabcd";
+char c4list[] =
+   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz{}$%&*+-/?@";
+
+/*
+ * cgrays -- lists of grayscales contained within color palettes
+ */
+static char *cgrays[] = { "0123456", "kxw", "@abMcdZ", "0$%&L*+-g/?@}",
+"\0}~\177\200\37\201\202\203\204>\205\206\207\210]\211\212\213\214|",
+"\0\330\331\332\333\334+\335\336\337\340\341V\342\343\344\345\346\201\
+\347\350\351\352\353\254\354\355\356\357\360\327" };
+
+/*
+ * c1cube - a precomputed mapping from a color cube to chars in c1 palette
+ *
+ * This is 10x10x10 cube (A Thousand Points of Light).
+ */
+#define C1Side 10			/* length of one side of C1 cube */
+static char c1cube[] = {
+   '0', '0', 'w', 'w', 'w', 'W', 'W', 'W', 'J', 'J', '0', '0', 'v', 'v', 'v',
+   'W', 'W', 'W', 'J', 'J', 's', 't', 't', 'v', 'v', 'V', 'V', 'V', 'V', 'J',
+   's', 't', 't', 'u', 'u', 'V', 'V', 'V', 'V', 'I', 's', 't', 't', 'u', 'u',
+   'V', 'V', 'V', 'I', 'I', 'S', 'S', 'T', 'T', 'T', 'U', 'U', 'U', 'I', 'I',
+   'S', 'S', 'T', 'T', 'T', 'U', 'U', 'U', 'U', 'I', 'S', 'S', 'T', 'T', 'T',
+   'U', 'U', 'U', 'U', 'H', 'F', 'F', 'T', 'T', 'G', 'G', 'U', 'U', 'H', 'H',
+   'F', 'F', 'F', 'G', 'G', 'G', 'G', 'H', 'H', 'H', '0', '0', 'x', 'x', 'x',
+   'W', 'W', 'W', 'J', 'J', '!', '1', '1', 'v', 'v', 'W', 'W', 'W', 'J', 'J',
+   'r', '1', '1', 'v', 'v', 'V', 'V', 'V', 'j', 'j', 'r', 'r', 't', 'u', 'u',
+   'V', 'V', 'V', 'j', 'j', 'r', 'r', 't', 'u', 'u', 'V', 'V', 'V', 'I', 'I',
+   'S', 'S', 'T', 'T', 'T', 'U', 'U', 'U', 'I', 'I', 'S', 'S', 'T', 'T', 'T',
+   'U', 'U', 'U', 'i', 'i', 'S', 'S', 'T', 'T', 'T', 'U', 'U', 'U', 'i', 'i',
+   'F', 'F', 'f', 'f', 'G', 'G', 'g', 'g', 'H', 'H', 'F', 'F', 'f', 'f', 'G',
+   'G', 'g', 'g', 'H', 'H', 'n', 'z', 'x', 'x', 'x', 'X', 'X', 'X', 'X', 'J',
+   '!', '1', '1', 'x', 'x', 'X', 'X', 'X', 'j', 'j', 'p', '1', '1', '2', '2',
+   ')', 'V', 'j', 'j', 'j', 'r', 'r', '2', '2', '2', ')', 'V', 'j', 'j', 'j',
+   'r', 'r', '2', '2', '2', '>', '>', '>', 'j', 'j', 'R', 'R', '-', '-', '/',
+   '/', '>', '>', 'i', 'i', 'R', 'R', 'R', 'T', '/', '/', '\'','i', 'i', 'i',
+   'R', 'R', 'f', 'f', '/', '/', 'g', 'g', 'i', 'i', 'R', 'f', 'f', 'f', 'f',
+   'g', 'g', 'g', 'h', 'h', 'F', 'f', 'f', 'f', 'f', 'g', 'g', 'g', 'h', 'h',
+   'n', 'z', 'z', 'y', 'y', 'X', 'X', 'X', 'X', 'K', 'o', 'o', 'z', 'y', 'y',
+   'X', 'X', 'X', 'j', 'j', 'p', 'p', '2', '2', '2', ')', 'X', 'j', 'j', 'j',
+   'q', 'q', '2', '2', '2', ')', ')', 'j', 'j', 'j', 'q', 'q', '2', '2', '2',
+   '>', '>', '>', 'j', 'j', 'R', 'R', '-', '-', '/', '/', '>', '>', 'i', 'i',
+   'R', 'R', 'R', '-', '/', '/', '\'','\'','i', 'i', 'R', 'R', 'f', 'f', '/',
+   '/', '\'','g', 'i', 'i', 'R', 'f', 'f', 'f', 'f', 'g', 'g', 'g', 'h', 'h',
+   'E', 'f', 'f', 'f', 'f', 'g', 'g', 'g', 'h', 'h', 'n', 'z', 'z', 'y', 'y',
+   'X', 'X', 'X', 'K', 'K', 'o', 'o', 'z', 'y', 'y', 'X', 'X', 'X', 'K', 'K',
+   '?', '?', '?', '2', '2', ']', ']', ']', 'j', 'j', 'q', 'q', '2', '2', '2',
+   ']', ']', ']', 'j', 'j', 'q', 'q', '2', '2', '3', '3', '>', '>', 'j', 'j',
+   'R', 'R', ':', ':', '3', '3', '>', '>', 'i', 'i', 'R', 'R', ':', ':', ':',
+   '/', '\'','\'','i', 'i', 'R', 'R', ':', ':', ':', '/', '\'','\'','i', 'i',
+   'E', 'E', 'f', 'f', 'f', 'g', 'g', 'g', 'h', 'h', 'E', 'E', 'f', 'f', 'f',
+   'g', 'g', 'g', 'h', 'h', 'N', 'N', 'Z', 'Z', 'Z', 'Y', 'Y', 'Y', 'K', 'K',
+   'O', 'O', 'Z', 'Z', 'Z', 'Y', 'Y', 'Y', 'K', 'K', '?', '?', '?', '@', '=',
+   ']', ']', ']', 'k', 'k', 'P', 'P', '@', '@', '=', ']', ']', ']', 'k', 'k',
+   'P', 'P', '%', '%', '%', '3', ']', ']', 'k', 'k', 'Q', 'Q', '|', '|', '3',
+   '3', '4', '4', '(', '(', 'Q', 'Q', ':', ':', ':', '4', '4', '4', '(', '(',
+   'Q', 'Q', ':', ':', ':', '4', '4', '4', '<', '<', 'E', 'E', 'e', 'e', 'e',
+   '+', '+', '*', '*', '<', 'E', 'E', 'e', 'e', 'e', '+', '+', '*', '*', '`',
+   'N', 'N', 'Z', 'Z', 'Z', 'Y', 'Y', 'Y', 'Y', 'K', 'O', 'O', 'Z', 'Z', 'Z',
+   'Y', 'Y', 'Y', 'k', 'k', 'O', 'O', 'O', 'Z', '=', '=', '}', 'k', 'k', 'k',
+   'P', 'P', 'P', '@', '=', '=', '}', '}', 'k', 'k', 'P', 'P', '%', '%', '%',
+   '=', '}', '}', 'k', 'k', 'Q', 'Q', '|', '|', '|', '4', '4', '4', '(', '(',
+   'Q', 'Q', '.', '.', '.', '4', '4', '4', '(', '(', 'Q', 'Q', 'e', '.', '.',
+   '4', '4', '4', '<', '<', 'Q', 'e', 'e', 'e', 'e', '+', '+', '*', '*', '<',
+   'E', 'e', 'e', 'e', 'e', '+', '+', '*', '*', '`', 'N', 'N', 'Z', 'Z', 'Z',
+   'Y', 'Y', 'Y', 'Y', 'L', 'O', 'O', 'Z', 'Z', 'Z', 'Y', 'Y', 'Y', 'k', 'k',
+   'O', 'O', 'O', 'a', '=', '=', 'm', 'k', 'k', 'k', 'P', 'P', 'a', 'a', '=',
+   '=', '}', 'k', 'k', 'k', 'P', 'P', '%', '%', '%', '=', '}', '8', '8', '8',
+   'Q', 'Q', '|', '|', '|', '4', '4', '8', '8', '8', 'Q', 'Q', 'c', '.', '.',
+   '4', '4', '4', '[', '[', 'Q', 'Q', 'c', 'c', '9', '9', '4', '5', '5', '<',
+   'Q', 'e', 'e', 'e', 'e', ';', ';', '5', '5', '<', 'D', 'e', 'e', 'e', 'e',
+   ';', ';', ';', '*', '`', 'A', 'A', 'Z', 'Z', 'M', 'M', 'Y', 'Y', 'L', 'L',
+   'A', 'A', 'a', 'a', 'M', 'M', 'm', 'm', 'L', 'L', 'B', 'B', 'a', 'a', 'a',
+   'm', 'm', 'm', 'l', 'l', 'B', 'B', 'a', 'a', 'a', 'm', 'm', 'm', 'l', 'l',
+   'C', 'C', 'b', 'b', 'b', '7', '7', '7', '8', '8', 'C', 'C', 'b', 'b', 'b',
+   '7', '7', '^', '[', '[', 'Q', 'c', 'c', 'c', 'c', '#', '#', '^', '[', '[',
+   'Q', 'c', 'c', 'c', '9', '9', '$', '5', '5', '[', 'D', 'D', 'd', 'd', '9',
+   '&', '&', '5', '5', '6', 'D', 'D', 'd', 'd', 'd', ';', ';', ';', '6', '6',
+   'A', 'A', 'A', 'M', 'M', 'M', 'M', 'L', 'L', 'L', 'A', 'A', 'a', 'a', 'M',
+   'M', 'm', 'm', 'L', 'L', 'B', 'B', 'a', 'a', 'a', 'm', 'm', 'm', 'l', 'l',
+   'B', 'B', 'a', 'a', 'a', 'm', 'm', 'm', 'l', 'l', 'C', 'C', 'b', 'b', 'b',
+   '7', '7', '7', 'l', 'l', 'C', 'C', 'b', 'b', 'b', '7', '7', '^', '^', '{',
+   'C', 'c', 'c', 'c', 'c', '#', '#', '^', '^', '{', 'D', 'c', 'c', 'c', '9',
+   '9', '$', '$', '^', '{', 'D', 'D', 'd', 'd', '9', '&', '&', '&', '6', '6',
+   'D', 'D', 'd', 'd', 'd', ',', ',', ',', '6', '6'
+};
+
+/*
+ * c1rgb - RGB values for c1 palette entries
+ *
+ * Entry order corresponds to c1list (above).
+ * Each entry gives r,g,b in linear range 0 to 48.
+ */
+static unsigned char c1rgb[] = {
+   0, 0, 0,		/*  0             black		*/
+   8, 8, 8,		/*  1   very dark gray		*/
+   16, 16, 16,		/*  2        dark gray		*/
+   24, 24, 24,		/*  3             gray		*/
+   32, 32, 32,		/*  4       light gray		*/
+   40, 40, 40,		/*  5  very light gray		*/
+   48, 48, 48,		/*  6             white		*/
+   48, 24, 30,		/*  7             pink		*/
+   36, 24, 48,		/*  8             violet	*/
+   48, 36, 24,		/*  9  very light brown		*/
+   24, 12, 0,		/*  ?             brown		*/
+   8, 4, 0,		/*  !   very dark brown		*/
+   16, 0, 0,		/*  n   very dark red		*/
+   32, 0, 0,		/*  N        dark red		*/
+   48, 0, 0,		/*  A             red		*/
+   48, 16, 16,		/*  a       light red		*/
+   48, 32, 32,		/*  #  very light red		*/
+   30, 18, 18,		/*  @        weak red		*/
+   16, 4, 0,		/*  o   very dark orange	*/
+   32, 8, 0,		/*  O        dark orange	*/
+   48, 12, 0,		/*  B             orange	*/
+   48, 24, 16,		/*  b       light orange	*/
+   48, 36, 32,		/*  $  very light orange	*/
+   30, 21, 18,		/*  %        weak orange	*/
+   16, 8, 0,		/*  p   very dark red-yellow	*/
+   32, 16, 0,		/*  P        dark red-yellow	*/
+   48, 24, 0,		/*  C             red-yellow	*/
+   48, 32, 16,		/*  c       light red-yellow	*/
+   48, 40, 32,		/*  &  very light red-yellow	*/
+   30, 24, 18,		/*  |        weak red-yellow	*/
+   16, 16, 0,		/*  q   very dark yellow	*/
+   32, 32, 0,		/*  Q        dark yellow	*/
+   48, 48, 0,		/*  D             yellow	*/
+   48, 48, 16,		/*  d       light yellow	*/
+   48, 48, 32,		/*  ,  very light yellow	*/
+   30, 30, 18,		/*  .        weak yellow	*/
+   8, 16, 0,		/*  r   very dark yellow-green	*/
+   16, 32, 0,		/*  R        dark yellow-green	*/
+   24, 48, 0,		/*  E             yellow-green	*/
+   32, 48, 16,		/*  e       light yellow-green	*/
+   40, 48, 32,		/*  ;  very light yellow-green	*/
+   24, 30, 18,		/*  :        weak yellow-green	*/
+   0, 16, 0,		/*  s   very dark green		*/
+   0, 32, 0,		/*  S        dark green		*/
+   0, 48, 0,		/*  F             green		*/
+   16, 48, 16,		/*  f       light green		*/
+   32, 48, 32,		/*  +  very light green		*/
+   18, 30, 18,		/*  -        weak green		*/
+   0, 16, 8,		/*  t   very dark cyan-green	*/
+   0, 32, 16,		/*  T        dark cyan-green	*/
+   0, 48, 24,		/*  G             cyan-green	*/
+   16, 48, 32,		/*  g       light cyan-green	*/
+   32, 48, 40,		/*  *  very light cyan-green	*/
+   18, 30, 24,		/*  /        weak cyan-green	*/
+   0, 16, 16,		/*  u   very dark cyan		*/
+   0, 32, 32,		/*  U        dark cyan		*/
+   0, 48, 48,		/*  H             cyan		*/
+   16, 48, 48,		/*  h       light cyan		*/
+   32, 48, 48,		/*  `  very light cyan		*/
+   18, 30, 30,		/*  '        weak cyan		*/
+   0, 8, 16,		/*  v   very dark blue-cyan	*/
+   0, 16, 32,		/*  V        dark blue-cyan	*/
+   0, 24, 48,		/*  I             blue-cyan	*/
+   16, 32, 48,		/*  i       light blue-cyan	*/
+   32, 40, 48,		/*  <  very light blue-cyan	*/
+   18, 24, 30,		/*  >        weak blue-cyan	*/
+   0, 0, 16,		/*  w   very dark blue		*/
+   0, 0, 32,		/*  W        dark blue		*/
+   0, 0, 48,		/*  J             blue		*/
+   16, 16, 48,		/*  j       light blue		*/
+   32, 32, 48,		/*  (  very light blue		*/
+   18, 18, 30,		/*  )        weak blue		*/
+   8, 0, 16,		/*  x   very dark purple	*/
+   16, 0, 32,		/*  X        dark purple	*/
+   24, 0, 48,		/*  K             purple	*/
+   32, 16, 48,		/*  k       light purple	*/
+   40, 32, 48,		/*  [  very light purple	*/
+   24, 18, 30,		/*  ]        weak purple	*/
+   16, 0, 16,		/*  y   very dark magenta	*/
+   32, 0, 32,		/*  Y        dark magenta	*/
+   48, 0, 48,		/*  L             magenta	*/
+   48, 16, 48,		/*  l       light magenta	*/
+   48, 32, 48,		/*  {  very light magenta	*/
+   30, 18, 30,		/*  }        weak magenta	*/
+   16, 0, 8,		/*  z   very dark magenta-red	*/
+   32, 0, 16,		/*  Z        dark magenta-red	*/
+   48, 0, 24,		/*  M             magenta-red	*/
+   48, 16, 32,		/*  m       light magenta-red	*/
+   48, 32, 40,		/*  ^  very light magenta-red	*/
+   30, 18, 24,		/*  =        weak magenta-red	*/
+   };
+
+/*
+ * palnum(d) - return palette number, or 0 if unrecognized.
+ *
+ *    returns +1 ... +6 for "c1" through "c6"
+ *    returns +1 for &null
+ *    returns -2 ... -256 for "g2" through "g256"
+ *    returns 0 for unrecognized palette name
+ *    returns -1 for non-string argument
+ */
+int palnum(d)
+dptr d;
+   {
+   tended char *s;
+   char c, x;
+   int n;
+
+   if (is:null(*d))
+      return 1;
+   if (!cnv:C_string(*d, s))
+      return -1;
+   if (sscanf(s, "%c%d%c", &c, &n, &x) != 2)
+      return 0;
+   if (c == 'c' && n >= 1 && n <= 6)
+      return n;
+   if (c == 'g' && n >= 2 && n <= 256)
+      return -n;
+   return 0;
+   }
+
+
+struct palentry *palsetup_palette;	/* current palette */
+
+/*
+ * palsetup(p) - set up palette for specified palette.
+ */
+struct palentry *palsetup(p)
+int p;
+   {
+   int r, g, b, i, n, c;
+   unsigned int rr, gg, bb;
+   unsigned char *s = NULL, *t;
+   double m;
+   struct palentry *e;
+   static int palnumber;		/* current palette number */
+
+   if (palnumber == p)
+      return palsetup_palette;
+   if (palsetup_palette == NULL) {
+      palsetup_palette =
+         (struct palentry *)malloc(256 * sizeof(struct palentry));
+      if (palsetup_palette == NULL)
+         return NULL;
+      }
+   palnumber = p;
+
+   for (i = 0; i < 256; i++)
+      palsetup_palette[i].valid = palsetup_palette[i].transpt = 0;
+   palsetup_palette[TCH1].transpt = 1;
+   palsetup_palette[TCH2].transpt = 1;
+
+   if (p < 0) {				/* grayscale palette */
+      n = -p;
+      if (n <= 64)
+         s = (unsigned char *)c4list;
+      else
+         s = allchars;
+      m = 1.0 / (n - 1);
+
+      for (i = 0; i < n; i++) {
+         e = &palsetup_palette[*s++];
+         gg = 65535 * m * i;
+         e->clr.red = e->clr.green = e->clr.blue = gg;
+         e->valid = 1;
+	 e->transpt = 0;
+         }
+      return palsetup_palette;
+      }
+
+   if (p == 1) {			/* special c1 palette */
+      s = (unsigned char *)c1list;
+      t = c1rgb;
+      while ((c = *s++) != 0) {
+         e = &palsetup_palette[c];
+         e->clr.red   = 65535 * (((int)*t++) / 48.0);
+         e->clr.green = 65535 * (((int)*t++) / 48.0);
+         e->clr.blue  = 65535 * (((int)*t++) / 48.0);
+         e->valid = 1;
+	 e->transpt = 0;
+         }
+      return palsetup_palette;
+      }
+
+   switch (p) {				/* color cube plus extra grays */
+      case  2:  s = (unsigned char *)c2list;	break;	/* c2 */
+      case  3:  s = (unsigned char *)c3list;	break;	/* c3 */
+      case  4:  s = (unsigned char *)c4list;	break;	/* c4 */
+      case  5:  s = allchars;			break;	/* c5 */
+      case  6:  s = allchars;			break;	/* c6 */
+      }
+   m = 1.0 / (p - 1);
+   for (r = 0; r < p; r++) {
+      rr = 65535 * m * r;
+      for (g = 0; g < p; g++) {
+         gg = 65535 * m * g;
+         for (b = 0; b < p; b++) {
+            bb = 65535 * m * b;
+            e = &palsetup_palette[*s++];
+            e->clr.red = rr;
+            e->clr.green = gg;
+            e->clr.blue = bb;
+            e->valid = 1;
+	    e->transpt = 0;
+            }
+         }
+      }
+   m = 1.0 / (p * (p - 1));
+   for (g = 0; g < p * (p - 1); g++)
+      if (g % p != 0) {
+         gg = 65535 * m * g;
+         e = &palsetup_palette[*s++];
+         e->clr.red = e->clr.green = e->clr.blue = gg;
+         e->valid = 1;
+	 e->transpt = 0;
+         }
+   return palsetup_palette;
+   }
+
+/*
+ * rgbkey(p,r,g,b) - return pointer to key of closest color in palette number p.
+ *
+ * In color cubes, finds "extra" grays only if r == g == b.
+ */
+char *rgbkey(p, r, g, b)
+int p;
+double r, g, b;
+   {
+   int n, i;
+   double m;
+   char *s;
+
+   if (p > 0) {				/* color */
+      if (r == g && g == b) {
+         if (p == 1)
+            m = 6;
+         else
+            m = p * (p - 1);
+         return cgrays[p - 1] + (int)(0.501 + m * g);
+         }
+      else {
+         if (p == 1)
+            n = C1Side;
+         else
+            n = p;
+         m = n - 1;
+         i = (int)(0.501 + m * r);
+         i = n * i + (int)(0.501 + m * g);
+         i = n * i + (int)(0.501 + m * b);
+         switch(p) {
+            case  1:  return c1cube + i;		/* c1 */
+            case  2:  return c2list + i;		/* c2 */
+            case  3:  return c3list + i;		/* c3 */
+            case  4:  return c4list + i;		/* c4 */
+            case  5:  return (char *)allchars + i;	/* c5 */
+            case  6:  return (char *)allchars + i;	/* c6 */
+            }
+         }
+      }
+   else {				/* grayscale */
+      if (p < -64)
+         s = (char *)allchars;
+      else
+         s = c4list;
+      return s + (int)(0.5 + (0.299 * r + 0.587 * g + 0.114 * b) * (-p - 1));
+      }
+
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+   }
+
+#else					/* Graphics */
+
+/*
+ * Stubs to prevent dynamic loader from rejecting cfunc library of IPL.
+ */
+int palnum(dptr *d)					{ return 0; }
+char *rgbkey(int p, double r, double g, double b)	{ return 0; }
+
+#endif					/* Graphics */
diff --git a/src/runtime/rcomp.r b/src/runtime/rcomp.r
new file mode 100644
index 0000000..6cd0610
--- /dev/null
+++ b/src/runtime/rcomp.r
@@ -0,0 +1,444 @@
+/*
+ * File: rcomp.r
+ *  Contents: anycmp, equiv, lexcmp
+ */
+
+/*
+ * anycmp - compare any two objects.
+ */
+
+int anycmp(dp1,dp2)
+dptr dp1, dp2;
+   {
+   register int o1, o2;
+   register long v1, v2, lresult;
+   int iresult;
+   double rres1, rres2, rresult;
+
+   /*
+    * Get a collating number for dp1 and dp2.
+    */
+   o1 = order(dp1);
+   o2 = order(dp2);
+
+   /*
+    * If dp1 and dp2 aren't of the same type, compare their collating numbers.
+    */
+   if (o1 != o2)
+      return (o1 > o2 ? Greater : Less);
+
+   if (o1 == 3)
+      /*
+       * dp1 and dp2 are strings, use lexcmp to compare them.
+       */
+      return lexcmp(dp1,dp2);
+
+   switch (Type(*dp1)) {
+
+#ifdef LargeInts
+
+      case T_Integer:
+	 if (Type(*dp2) != T_Lrgint) {
+            v1 = IntVal(*dp1);
+            v2 = IntVal(*dp2);
+            if (v1 < v2)
+               return Less;
+            else if (v1 == v2)
+               return Equal;
+            else
+               return Greater;
+            }
+	 /* if dp2 is a Lrgint, flow into next case */
+
+      case T_Lrgint:
+	 lresult = bigcmp(dp1, dp2);
+	 if (lresult == 0)
+	    return Equal;
+	 return ((lresult > 0) ? Greater : Less);
+
+#else					/* LargeInts */
+
+      case T_Integer:
+         v1 = IntVal(*dp1);
+         v2 = IntVal(*dp2);
+         if (v1 < v2)
+            return Less;
+         else if (v1 == v2)
+            return Equal;
+         else
+            return Greater;
+
+#endif					/* LargeInts */
+
+      case T_Coexpr:
+         /*
+          * Collate on co-expression id.
+          */
+         lresult = (BlkLoc(*dp1)->coexpr.id - BlkLoc(*dp2)->coexpr.id);
+         if (lresult == 0)
+            return Equal;
+         return ((lresult > 0) ? Greater : Less);
+
+      case T_Cset:
+         return csetcmp((unsigned int *)((struct b_cset *)BlkLoc(*dp1))->bits,
+            (unsigned int *)((struct b_cset *)BlkLoc(*dp2))->bits);
+
+      case T_File:
+         /*
+          * Collate on file name or window label.
+          */
+	 {
+	 struct descrip s1, s2; /* live only long enough to lexcmp them */
+	 dptr ps1 = &(BlkLoc(*dp1)->file.fname);
+	 dptr ps2 = &(BlkLoc(*dp2)->file.fname);
+#ifdef Graphics
+	 if (BlkLoc(*dp1)->file.status & Fs_Window) {
+	    wbp w = (wbp) BlkLoc(*dp1)->file.fd;
+	    StrLoc(s1) = w->window->windowlabel;
+	    StrLen(s1) = strlen(w->window->windowlabel);
+	    ps1 = &s1;
+	    }
+	 if (BlkLoc(*dp2)->file.status & Fs_Window) {
+	    wbp w = (wbp) BlkLoc(*dp2)->file.fd;
+	    StrLoc(s2) = w->window->windowlabel;
+	    StrLen(s2) = strlen(w->window->windowlabel);
+	    ps2 = &s2;
+	    }
+#endif					/* Graphics */
+         return lexcmp(ps1, ps2);
+         }
+
+      case T_List:
+         /*
+          * Collate on list id.
+          */
+         lresult = (BlkLoc(*dp1)->list.id - BlkLoc(*dp2)->list.id);
+         if (lresult == 0)
+            return Equal;
+         return ((lresult > 0) ? Greater : Less);
+
+      case T_Null:
+         return Equal;
+
+      case T_Proc:
+         /*
+          * Collate on procedure name.
+          */
+         return lexcmp(&(BlkLoc(*dp1)->proc.pname),
+            &(BlkLoc(*dp2)->proc.pname));
+
+      case T_Real:
+         GetReal(dp1,rres1);
+         GetReal(dp2,rres2);
+         rresult = rres1 - rres2;
+	 if (rresult == 0.0)
+	    return Equal;
+	 return ((rresult > 0.0) ? Greater : Less);
+
+      case T_Record:
+         /*
+          * Collate on record id within record name.
+          */
+         iresult = lexcmp(&(BlkLoc(*dp1)->record.recdesc->proc.pname),
+            &(BlkLoc(*dp2)->record.recdesc->proc.pname));
+         if (iresult == Equal) {
+            lresult = (BlkLoc(*dp1)->record.id - BlkLoc(*dp2)->record.id);
+            if (lresult > 0)	/* coded this way because of code-generation */
+               return Greater;  /* bug in MSC++ 7.0A;  do not change. */
+            else if (lresult < 0)
+               return Less;
+            else
+               return Equal;
+            }
+        return iresult;
+
+      case T_Set:
+         /*
+          * Collate on set id.
+          */
+         lresult = (BlkLoc(*dp1)->set.id - BlkLoc(*dp2)->set.id);
+         if (lresult == 0)
+            return Equal;
+         return ((lresult > 0) ? Greater : Less);
+
+      case T_Table:
+         /*
+          * Collate on table id.
+          */
+         lresult = (BlkLoc(*dp1)->table.id - BlkLoc(*dp2)->table.id);
+         if (lresult == 0)
+            return Equal;
+         return ((lresult > 0) ? Greater : Less);
+
+      case T_External:
+	 /*
+          * Collate these values according to the relative positions of
+          *  their blocks in the heap.
+	  */
+         lresult = ((long)BlkLoc(*dp1) - (long)BlkLoc(*dp2));
+         if (lresult == 0)
+            return Equal;
+         return ((lresult > 0) ? Greater : Less);
+
+      default:
+	 syserr("anycmp: unknown datatype.");
+	 /*NOTREACHED*/
+	 return 0;  /* avoid gcc warning */
+      }
+   }
+
+/*
+ * order(x) - return collating number for object x.
+ */
+
+int order(dp)
+dptr dp;
+   {
+   if (Qual(*dp))
+      return 3;			     /* string */
+   switch (Type(*dp)) {
+      case T_Null:
+	 return 0;
+      case T_Integer:
+	 return 1;
+
+#ifdef LargeInts
+      case T_Lrgint:
+	 return 1;
+#endif					/* LargeInts */
+
+      case T_Real:
+	 return 2;
+
+      /* string: return 3 (see above) */
+
+      case T_Cset:
+	 return 4;
+      case T_File:
+	 return 5;
+      case T_Coexpr:
+	 return 6;
+      case T_Proc:
+	 return 7;
+      case T_List:
+	 return 8;
+      case T_Set:
+	 return 9;
+      case T_Table:
+	 return 10;
+      case T_Record:
+	 return 11;
+      case T_External:
+         return 12;
+      default:
+	 syserr("order: unknown datatype.");
+	 /*NOTREACHED*/
+	 return 0;  /* avoid gcc warning */
+      }
+   }
+
+/*
+ * equiv - test equivalence of two objects.
+ */
+
+int equiv(dp1, dp2)
+dptr dp1, dp2;
+   {
+   register int result;
+   register word i;
+   register char *s1, *s2;
+   double rres1, rres2;
+
+   result = 0;
+
+      /*
+       * If the descriptors are identical, the objects are equivalent.
+       */
+   if (EqlDesc(*dp1,*dp2))
+      result = 1;
+   else if (Qual(*dp1) && Qual(*dp2)) {
+
+      /*
+       *  If both are strings of equal length, compare their characters.
+       */
+
+      if ((i = StrLen(*dp1)) == StrLen(*dp2)) {
+
+
+	 s1 = StrLoc(*dp1);
+	 s2 = StrLoc(*dp2);
+	 result = 1;
+	 while (i--)
+	   if (*s1++ != *s2++) {
+	      result = 0;
+	      break;
+	      }
+
+	 }
+      }
+   else if (dp1->dword == dp2->dword)
+      switch (Type(*dp1)) {
+	 /*
+	  * For integers and reals, just compare the values.
+	  */
+	 case T_Integer:
+	    result = (IntVal(*dp1) == IntVal(*dp2));
+	    break;
+
+#ifdef LargeInts
+	 case T_Lrgint:
+	    result = (bigcmp(dp1, dp2) == 0);
+	    break;
+#endif					/* LargeInts */
+
+
+	 case T_Real:
+            GetReal(dp1, rres1);
+            GetReal(dp2, rres2);
+            result = (rres1 == rres2);
+	    break;
+
+	 case T_Cset:
+	    /*
+	     * Compare the bit arrays of the csets.
+	     */
+	    result = 1;
+	    for (i = 0; i < CsetSize; i++)
+	       if (BlkLoc(*dp1)->cset.bits[i] != BlkLoc(*dp2)->cset.bits[i]) {
+		  result = 0;
+		  break;
+		  }
+	 }
+   else
+      /*
+       * dp1 and dp2 are of different types, so they can't be
+       *  equivalent.
+       */
+      result = 0;
+
+   return result;
+   }
+
+/*
+ * lexcmp - lexically compare two strings.
+ */
+
+int lexcmp(dp1, dp2)
+dptr dp1, dp2;
+   {
+
+
+   register char *s1, *s2;
+   register word minlen;
+   word l1, l2;
+
+   /*
+    * Get length and starting address of both strings.
+    */
+   l1 = StrLen(*dp1);
+   s1 = StrLoc(*dp1);
+   l2 = StrLen(*dp2);
+   s2 = StrLoc(*dp2);
+
+   /*
+    * Set minlen to length of the shorter string.
+    */
+   minlen = Min(l1, l2);
+
+   /*
+    * Compare as many bytes as are in the smaller string.  If an
+    *  inequality is found, compare the differing bytes.
+    */
+   while (minlen--)
+      if (*s1++ != *s2++)
+         return (*--s1 & 0377) > (*--s2 & 0377) ?  Greater : Less;
+
+   /*
+    * The strings compared equal for the length of the shorter.
+    */
+   if (l1 == l2)
+      return Equal;
+   else if (l1 > l2)
+      return Greater;
+   else
+      return Less;
+
+   }
+
+/*
+ * csetcmp - compare two cset bit arrays.
+ *  The order defined by this function is identical to the lexical order of
+ *  the two strings that the csets would be converted into.
+ */
+
+int csetcmp(cs1, cs2)
+unsigned int *cs1, *cs2;
+   {
+   unsigned int nbit, mask, *cs_end;
+
+   if (cs1 == cs2) return Equal;
+
+   /*
+    * The longest common prefix of the two bit arrays converts to some
+    *  common prefix string.  The first bit on which the csets disagree is
+    *  the first character of the conversion strings that disagree, and so this
+    *  is the character on which the order is determined.  The cset that has
+    *  this first non-common bit = one, has in that position the lowest
+    *  character, so this cset is lexically least iff the other cset has some
+    *  following bit set.  If the other cset has no bits set after the first
+    *  point of disagreement, then it is a prefix of the other, and is therefor
+    *  lexically less.
+    *
+    * Find the first word where cs1 and cs2 are different.
+    */
+   for (cs_end = cs1 + CsetSize; cs1 < cs_end; cs1++, cs2++)
+      if (*cs1 != *cs2) {
+	 /*
+	  * Let n be the position at which the bits first differ within
+	  *  the word.  Set nbit to some integer for which the nth bit
+	  *  is the first bit in the word that is one.  Note here and in the
+	  *  following, that bits go from right to left within a word, so
+	  *  the _first_ bit is the _rightmost_ bit.
+	  */
+	 nbit = *cs1 ^ *cs2;
+
+	 /* Set mask to an integer that has all zeros in bit positions
+	  *  upto and including position n, and all ones in bit positions
+	  *  _after_ bit position n.
+	  */
+	 for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1);
+
+	 /*
+	  * nbit & ~mask contains zeros everywhere except position n, which
+	  *  is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit
+	  *  of *cs2 is one.
+	  */
+	 if (*cs2 & (nbit & ~mask)) {
+	    /*
+	     * If there are bits set in cs1 after bit position n in the
+	     *  current word, then cs1 is lexically greater than cs2.
+	     */
+	    if (*cs1 & mask) return Greater;
+	    while (++cs1 < cs_end)
+	       if (*cs1) return Greater;
+
+	    /*
+	     * Otherwise cs1 is a proper prefix of cs2 and is therefore
+	     *  lexically less.
+	     */
+	     return Less;
+	     }
+
+	 /*
+	  * If the nth bit of *cs2 isn't one, then the nth bit of cs1
+	  *  must be one.  Just reverse the logic for the previous
+	  *  case.
+	  */
+	 if (*cs2 & mask) return Less;
+	 cs_end = cs2 + (cs_end - cs1);
+	 while (++cs2 < cs_end)
+	    if (*cs2) return Less;
+	 return Greater;
+	 }
+   return Equal;
+   }
diff --git a/src/runtime/rdebug.r b/src/runtime/rdebug.r
new file mode 100644
index 0000000..26d1167
--- /dev/null
+++ b/src/runtime/rdebug.r
@@ -0,0 +1,1019 @@
+/*
+ * rdebug.r - tracebk, get_name, xdisp, ctrace, rtrace, failtrace, strace,
+ *   atrace, cotrace
+ */
+
+/*
+ * Prototypes.
+ */
+static int     glbcmp    (char *pi, char *pj);
+static int     keyref    (union block *bp, dptr dp);
+static void showline  (char *f, int l);
+static void showlevel (register int n);
+static void ttrace	(void);
+static void xtrace
+   (struct b_proc *bp, word nargs, dptr arg, int pline, char *pfile);
+
+/*
+ * tracebk - print a trace of procedure calls.
+ */
+
+#if COMPILER
+
+void tracebk(lcl_pfp, argp)
+struct p_frame *lcl_pfp;
+dptr argp;
+   {
+   struct b_proc *cproc;
+
+   struct debug *debug;
+   word nparam;
+
+   if (lcl_pfp == NULL)
+      return;
+   debug = PFDebug(*lcl_pfp);
+   tracebk(lcl_pfp->old_pfp, lcl_pfp->old_argp);
+   cproc = debug->proc;
+   xtrace(cproc, (word)abs((int)cproc->nparam), argp, debug->old_line,
+      debug->old_fname);
+   }
+
+#else					/* COMPILER */
+
+void tracebk(lcl_pfp, argp)
+struct pf_marker *lcl_pfp;
+dptr argp;
+   {
+   struct b_proc *cproc;
+
+   struct pf_marker *origpfp = pfp;
+   dptr arg;
+   inst cipc;
+
+   /*
+    * Chain back through the procedure frame markers, looking for the
+    *  first one, while building a foward chain of pointers through
+    *  the expression frame pointers.
+    */
+
+   for (pfp->pf_efp = NULL; pfp->pf_pfp != NULL; pfp = pfp->pf_pfp) {
+      (pfp->pf_pfp)->pf_efp = (struct ef_marker *)pfp;
+      }
+
+   /* Now start from the base procedure frame marker, producing a listing
+    *  of the procedure calls up through the last one.
+    */
+
+   while (pfp) {
+      arg = &((dptr)pfp)[-(pfp->pf_nargs) - 1];
+      cproc = (struct b_proc *)BlkLoc(arg[0]);
+      /*
+       * The ipc in the procedure frame points after the "invoke n".
+       */
+      cipc = pfp->pf_ipc;
+      --cipc.opnd;
+      --cipc.op;
+
+      xtrace(cproc, pfp->pf_nargs, &arg[0], findline(cipc.opnd),
+         findfile(cipc.opnd));
+      /*
+       * On the last call, show both the call and the offending expression.
+       */
+      if (pfp == origpfp) {
+         ttrace();
+         break;
+         }
+
+      pfp = (struct pf_marker *)(pfp->pf_efp);
+      }
+   }
+
+#endif					/* COMPILER */
+
+/*
+ * xtrace - procedure *bp is being called with nargs arguments, the first
+ *  of which is at arg; produce a trace message.
+ */
+static void xtrace(bp, nargs, arg, pline, pfile)
+struct b_proc *bp;
+word nargs;
+dptr arg;
+int pline;
+char *pfile;
+   {
+
+   if (bp == NULL)
+      fprintf(stderr, "????");
+   else {
+
+#if COMPILER
+       putstr(stderr, &(bp->pname));
+#else					/* COMPILER */
+       if (arg[0].dword == D_Proc)
+          putstr(stderr, &(bp->pname));
+       else
+          outimage(stderr, arg, 0);
+       arg++;
+#endif					/* COMPILER */
+
+       putc('(', stderr);
+       while (nargs--) {
+          outimage(stderr, arg++, 0);
+          if (nargs)
+             putc(',', stderr);
+          }
+       putc(')', stderr);
+       }
+
+   if (pline != 0)
+      fprintf(stderr, " from line %d in %s", pline, pfile);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * get_name -- function to get print name of variable.
+ */
+int get_name(dp1,dp0)
+   dptr dp1, dp0;
+   {
+   dptr dp, varptr;
+   tended union block *blkptr;
+   dptr arg1;                           /* 1st parameter */
+   dptr loc1;                           /* 1st local */
+   struct b_proc *proc;                 /* address of procedure block */
+   char sbuf[100];			/* buffer; might be too small */
+   char *s, *s2;
+   word i, j, k;
+   int t;
+
+#if COMPILER
+   arg1 = glbl_argp;
+   loc1 = pfp->tend.d;
+   proc = PFDebug(*pfp)->proc;
+#else					/* COMPILER */
+   arg1 = &glbl_argp[1];
+   loc1 = pfp->pf_locals;
+   proc = &BlkLoc(*glbl_argp)->proc;
+#endif					/* COMPILER */
+
+   type_case *dp1 of {
+      tvsubs: {
+         blkptr = BlkLoc(*dp1);
+         get_name(&(blkptr->tvsubs.ssvar),dp0);
+         sprintf(sbuf,"[%ld:%ld]",(long)blkptr->tvsubs.sspos,
+            (long)blkptr->tvsubs.sspos+blkptr->tvsubs.sslen);
+         k = StrLen(*dp0);
+         j = strlen(sbuf);
+
+	 /*
+	  * allocate space for both the name and the subscript image,
+	  *  and then copy both parts into the allocated space
+	  */
+	 Protect(s = alcstr(NULL, k + j), return Error);
+	 s2 = StrLoc(*dp0);
+	 StrLoc(*dp0) = s;
+         StrLen(*dp0) = j + k;
+	 for (i = 0; i < k; i++)
+	    *s++ = *s2++;
+	 s2 = sbuf;
+	 for (i = 0; i < j; i++)
+	    *s++ = *s2++;
+         }
+
+      tvtbl: {
+         t = keyref(BlkLoc(*dp1) ,dp0);
+         if (t == Error)
+            return Error;
+          }
+
+      kywdint:
+         if (VarLoc(*dp1) == &kywd_ran) {
+            StrLen(*dp0) = 7;
+            StrLoc(*dp0) = "&random";
+            }
+         else if (VarLoc(*dp1) == &kywd_trc) {
+            StrLen(*dp0) = 6;
+            StrLoc(*dp0) = "&trace";
+            }
+
+#ifdef FncTrace
+         else if (VarLoc(*dp1) == &kywd_ftrc) {
+            StrLen(*dp0) = 7;
+            StrLoc(*dp0) = "&ftrace";
+            }
+#endif					/* FncTrace */
+
+         else if (VarLoc(*dp1) == &kywd_dmp) {
+            StrLen(*dp0) = 5;
+            StrLoc(*dp0) = "&dump";
+            }
+         else if (VarLoc(*dp1) == &kywd_err) {
+            StrLen(*dp0) = 6;
+            StrLoc(*dp0) = "&error";
+            }
+         else
+            syserr("name: unknown integer keyword variable");
+
+      kywdevent:
+#ifdef MultiThread
+         if (VarLoc(*dp1) == &curpstate->eventsource) {
+            StrLen(*dp0) = 12;
+            StrLoc(*dp0) = "&eventsource";
+            }
+         else if (VarLoc(*dp1) == &curpstate->eventval) {
+            StrLen(*dp0) = 11;
+            StrLoc(*dp0) = "&eventvalue";
+            }
+         else if (VarLoc(*dp1) == &curpstate->eventcode) {
+            StrLen(*dp0) = 10;
+            StrLoc(*dp0) = "&eventcode";
+            }
+         else
+#endif					/* MultiThread */
+            syserr("name: unknown event keyword variable");
+
+      kywdwin: {
+         StrLen(*dp0) = 7;
+         StrLoc(*dp0) = "&window";
+         }
+
+      kywdstr: {
+         StrLen(*dp0) = 9;
+         StrLoc(*dp0) = "&progname";
+         }
+
+      kywdpos: {
+         StrLen(*dp0) = 4;
+         StrLoc(*dp0) = "&pos";
+         }
+
+      kywdsubj: {
+         StrLen(*dp0) = 8;
+         StrLoc(*dp0) = "&subject";
+         }
+
+      default:
+         if (Offset(*dp1) == 0) {
+            /*
+             * Must be a named variable.
+             */
+            dp = VarLoc(*dp1);		 /* get address of variable */
+            if (InRange(globals,dp,eglobals)) {
+               *dp0 = gnames[dp - globals];		/* global */
+	       return GlobalName;
+	       }
+            else if (InRange(statics,dp,estatics)) {
+               i = dp - statics - proc->fstatic;	/* static */
+               if (i < 0 || i >= proc->nstatic)
+                  syserr("name: unreferencable static variable");
+               i += abs((int)proc->nparam) + abs((int)proc->ndynam);
+               *dp0 = proc->lnames[i];
+	       return StaticName;
+               }
+            else if (InRange(arg1, dp, &arg1[abs((int)proc->nparam)])) {
+               *dp0 = proc->lnames[dp - arg1];          /* argument */
+	       return ParamName;
+	       }
+            else if (InRange(loc1, dp, &loc1[proc->ndynam])) {
+               *dp0 = proc->lnames[dp - loc1 + abs((int)proc->nparam)];
+	       return LocalName;
+               }
+            else
+               syserr("name: cannot determine variable name");
+            }
+         else {
+            /*
+             * Must be an element of a structure.
+             */
+            blkptr = (union block *)VarLoc(*dp1);
+            varptr = (dptr)((word *)VarLoc(*dp1) + Offset(*dp1));
+            switch ((int)BlkType(blkptr)) {
+               case T_Lelem:		/* list */
+                  i = varptr - &blkptr->lelem.lslots[blkptr->lelem.first] + 1;
+                  if (i < 1)
+                     i += blkptr->lelem.nslots;
+#ifdef ListFix
+                  while (BlkType(blkptr->lelem.listprev) == T_Lelem) {
+#else					/* ListFix */
+                  while (blkptr->lelem.listprev != NULL) {
+#endif					/* ListFix */
+                     blkptr = blkptr->lelem.listprev;
+                     i += blkptr->lelem.nused;
+                     }
+#ifdef ListFix
+                  sprintf(sbuf,"list_%d[%ld]",
+			  (long)blkptr->lelem.listprev->list.id, (long)i);
+#else					/* ListFix */
+                  sprintf(sbuf,"L[%ld]", (long)i);
+#endif					/* ListFix */
+                  i = strlen(sbuf);
+                  Protect(StrLoc(*dp0) = alcstr(sbuf,i), return Error);
+                  StrLen(*dp0) = i;
+                  break;
+               case T_Record:		/* record */
+                  i = varptr - blkptr->record.fields;
+                  proc = &blkptr->record.recdesc->proc;
+
+#ifdef TableFix
+                  sprintf(sbuf,"record %s_%d.%s", StrLoc(proc->recname),
+			  blkptr->record.id,
+			  StrLoc(proc->lnames[i]));
+#else
+                  sprintf(sbuf,"%s.%s", StrLoc(proc->recname),
+			  StrLoc(proc->lnames[i]));
+#endif
+
+                  i = strlen(sbuf);
+                  Protect(StrLoc(*dp0) = alcstr(sbuf,i), return Error);
+                  StrLen(*dp0) = i;
+                  break;
+               case T_Telem:		/* table */
+                  t = keyref(blkptr,dp0);
+                  if (t == Error)
+                      return Error;
+                  break;
+               default:		/* none of the above */
+#ifdef EventMon
+                  *dp0 = emptystr;
+#else					/* EventMon */
+                  syserr("name: invalid structure reference");
+#endif					/* EventMon */
+
+               }
+           }
+      }
+   return Succeeded;
+   }
+
+#if COMPILER
+#begdef PTraceSetup()
+   struct b_proc *proc;
+
+   --k_trace;
+   showline(file_name, line_num);
+   showlevel(k_level);
+   proc = PFDebug(*pfp)->proc; /* get address of procedure block */
+   putstr(stderr, &proc->pname);
+#enddef
+
+/*
+ * ctrace - a procedure is being called; produce a trace message.
+ */
+void ctrace()
+   {
+   dptr arg;
+   int n;
+
+   PTraceSetup();
+
+   putc('(', stderr);
+   arg = glbl_argp;
+   n = abs((int)proc->nparam);
+   while (n--) {
+      outimage(stderr, arg++, 0);
+      if (n)
+         putc(',', stderr);
+      }
+   putc(')', stderr);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * rtrace - a procedure is returning; produce a trace message.
+ */
+
+void rtrace()
+   {
+   PTraceSetup();
+
+   fprintf(stderr, " returned ");
+   outimage(stderr, pfp->rslt, 0);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * failtrace - procedure named s is failing; produce a trace message.
+ */
+
+void failtrace()
+   {
+   PTraceSetup();
+
+   fprintf(stderr, " failed\n");
+   fflush(stderr);
+   }
+
+/*
+ * strace - a procedure is suspending; produce a trace message.
+ */
+
+void strace()
+   {
+   PTraceSetup();
+
+   fprintf(stderr, " suspended ");
+   outimage(stderr, pfp->rslt, 0);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * atrace - a procedure is being resumed; produce a trace message.
+ */
+void atrace()
+   {
+   PTraceSetup();
+
+   fprintf(stderr, " resumed\n");
+   fflush(stderr);
+   }
+#endif					/* COMPILER */
+
+/*
+ * keyref(bp,dp) -- print name of subscripted table
+ */
+static int keyref(bp, dp)
+   union block *bp;
+   dptr dp;
+   {
+   char *s, *s2;
+   char sbuf[100];			/* buffer; might be too small */
+   int len;
+
+   if (getimage(&(bp->telem.tref),dp) == Error)
+      return Error;
+
+   /*
+    * Allocate space, and copy the image surrounded by "table_n[" and "]"
+    */
+   s2 = StrLoc(*dp);
+   len = StrLen(*dp);
+#ifdef TableFix
+   if (BlkType(bp) == T_Tvtbl)
+      bp = bp->tvtbl.clink;
+   else
+      while(BlkType(bp) == T_Telem)
+         bp = bp->telem.clink;
+   sprintf(sbuf, "table_%d[", bp->table.id);
+#else					/* TableFix */
+   strcpy(sbuf, "T[");
+#endif					/* TableFix */
+   { char * dest = sbuf + strlen(sbuf);
+   strncpy(dest, s2, len);
+   dest[len] = '\0';
+   }
+   strcat(sbuf, "]");
+   len = strlen(sbuf);
+   Protect(s = alcstr(sbuf, len), return Error);
+   StrLoc(*dp) = s;
+   StrLen(*dp) = len;
+   return Succeeded;
+   }
+
+#ifdef Coexpr
+/*
+ * cotrace -- a co-expression context switch; produce a trace message.
+ */
+void cotrace(ccp, ncp, swtch_typ, valloc)
+struct b_coexpr *ccp;
+struct b_coexpr *ncp;
+int swtch_typ;
+dptr valloc;
+   {
+   struct b_proc *proc;
+
+#if !COMPILER
+   inst t_ipc;
+#endif					/* !COMPILER */
+
+   --k_trace;
+
+#if COMPILER
+   showline(ccp->file_name, ccp->line_num);
+   proc = PFDebug(*ccp->es_pfp)->proc;     /* get address of procedure block */
+#else					/* COMPILER */
+
+   /*
+    * Compute the ipc of the instruction causing the context switch.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   proc = (struct b_proc *)BlkLoc(*glbl_argp);
+#endif					/* COMPILER */
+
+   showlevel(k_level);
+   putstr(stderr, &proc->pname);
+   fprintf(stderr,"; co-expression_%ld ", (long)ccp->id);
+   switch (swtch_typ) {
+      case A_Coact:
+         fprintf(stderr,": ");
+         outimage(stderr, valloc, 0);
+         fprintf(stderr," @ ");
+         break;
+      case A_Coret:
+         fprintf(stderr,"returned ");
+         outimage(stderr, valloc, 0);
+         fprintf(stderr," to ");
+         break;
+      case A_Cofail:
+         fprintf(stderr,"failed to ");
+         break;
+      }
+   fprintf(stderr,"co-expression_%ld\n", (long)ncp->id);
+   fflush(stderr);
+   }
+#endif					/* Coexpr */
+
+/*
+ * showline - print file and line number information.
+ */
+static void showline(f, l)
+char *f;
+int l;
+   {
+   int i;
+
+   i = (int)strlen(f);
+   while (i > 13) {
+      f++;
+      i--;
+      }
+   if (l > 0)
+      fprintf(stderr, "%-13s: %4d  ",f, l);
+   else
+      fprintf(stderr, "             :       ");
+   }
+
+/*
+ * showlevel - print "| " n times.
+ */
+static void showlevel(n)
+register int n;
+   {
+   while (n-- > 0) {
+      putc('|', stderr);
+      putc(' ', stderr);
+      }
+   }
+
+#if !COMPILER
+
+#include "../h/opdefs.h"
+
+
+extern struct descrip value_tmp;		/* argument of Op_Apply */
+extern struct b_proc *opblks[];
+
+
+/*
+ * ttrace - show offending expression.
+ */
+static void ttrace()
+   {
+   struct b_proc *bp;
+   word nargs;
+   switch ((int)lastop) {
+
+      case Op_Keywd:
+         fprintf(stderr,"bad keyword reference");
+         break;
+
+      case Op_Invoke:
+         bp = (struct b_proc *)BlkLoc(*xargp);
+         nargs = xnargs;
+         if (xargp[0].dword == D_Proc)
+            putstr(stderr, &(bp->pname));
+         else
+            outimage(stderr, xargp, 0);
+         putc('(', stderr);
+         while (nargs--) {
+            outimage(stderr, ++xargp, 0);
+            if (nargs)
+               putc(',', stderr);
+            }
+         putc(')', stderr);
+         break;
+
+      case Op_Toby:
+         putc('{', stderr);
+         outimage(stderr, ++xargp, 0);
+         fprintf(stderr, " to ");
+         outimage(stderr, ++xargp, 0);
+         fprintf(stderr, " by ");
+         outimage(stderr, ++xargp, 0);
+         putc('}', stderr);
+         break;
+
+      case Op_Subsc:
+         putc('{', stderr);
+         outimage(stderr, ++xargp, 0);
+         putc('[', stderr);
+         outimage(stderr, ++xargp, 0);
+         putc(']', stderr);
+         putc('}', stderr);
+         break;
+
+      case Op_Sect:
+         putc('{', stderr);
+         outimage(stderr, ++xargp, 0);
+         putc('[', stderr);
+         outimage(stderr, ++xargp, 0);
+         putc(':', stderr);
+         outimage(stderr, ++xargp, 0);
+         putc(']', stderr);
+         putc('}', stderr);
+         break;
+
+      case Op_Bscan:
+         putc('{', stderr);
+         outimage(stderr, xargp, 0);
+         fputs(" ? ..}", stderr);
+         break;
+
+      case Op_Coact:
+         putc('{', stderr);
+         outimage(stderr, ++xargp, 0);
+         fprintf(stderr, " @ ");
+         outimage(stderr, ++xargp, 0);
+         putc('}', stderr);
+         break;
+
+      case Op_Apply:
+         outimage(stderr, xargp++, 0);
+         fprintf(stderr," ! ");
+         outimage(stderr, &value_tmp, 0);
+         break;
+
+      case Op_Create:
+         fprintf(stderr,"{create ..}");
+         break;
+
+      case Op_Field:
+         putc('{', stderr);
+         outimage(stderr, ++xargp, 0);
+         fprintf(stderr, " . ");
+	 ++xargp;
+	 if (IntVal(*xargp) == -1)
+            fprintf(stderr, "field");
+	 else
+            fprintf(stderr, "%s", StrLoc(fnames[IntVal(*xargp)]));
+         putc('}', stderr);
+         break;
+
+      case Op_Limit:
+         fprintf(stderr, "limit counter: ");
+         outimage(stderr, xargp, 0);
+         break;
+
+      case Op_Llist:
+         fprintf(stderr,"[ ... ]");
+         break;
+
+      default:
+
+         bp = opblks[lastop];
+         nargs = abs((int)bp->nparam);
+         putc('{', stderr);
+         if (lastop == Op_Bang || lastop == Op_Random)
+            goto oneop;
+         if (abs((int)bp->nparam) >= 2) {
+            outimage(stderr, ++xargp, 0);
+            putc(' ', stderr);
+            putstr(stderr, &(bp->pname));
+            putc(' ', stderr);
+	    }
+         else
+oneop:
+         putstr(stderr, &(bp->pname));
+         outimage(stderr, ++xargp, 0);
+         putc('}', stderr);
+      }
+
+   if (ipc.opnd != NULL)
+      fprintf(stderr, " from line %d in %s", findline(ipc.opnd),
+         findfile(ipc.opnd));
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+
+/*
+ * ctrace - procedure named s is being called with nargs arguments, the first
+ *  of which is at arg; produce a trace message.
+ */
+void ctrace(dp, nargs, arg)
+dptr dp;
+int nargs;
+dptr arg;
+   {
+
+   showline(findfile(ipc.opnd), findline(ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, dp);
+   putc('(', stderr);
+   while (nargs--) {
+      outimage(stderr, arg++, 0);
+      if (nargs)
+         putc(',', stderr);
+      }
+   putc(')', stderr);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * rtrace - procedure named s is returning *rval; produce a trace message.
+ */
+
+void rtrace(dp, rval)
+dptr dp;
+dptr rval;
+   {
+   inst t_ipc;
+
+   /*
+    * Compute the ipc of the return instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, dp);
+   fprintf(stderr, " returned ");
+   outimage(stderr, rval, 0);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * failtrace - procedure named s is failing; produce a trace message.
+ */
+
+void failtrace(dp)
+dptr dp;
+   {
+   inst t_ipc;
+
+   /*
+    * Compute the ipc of the fail instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, dp);
+   fprintf(stderr, " failed");
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * strace - procedure named s is suspending *rval; produce a trace message.
+ */
+
+void strace(dp, rval)
+dptr dp;
+dptr rval;
+   {
+   inst t_ipc;
+
+   /*
+    * Compute the ipc of the suspend instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, dp);
+   fprintf(stderr, " suspended ");
+   outimage(stderr, rval, 0);
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+/*
+ * atrace - procedure named s is being resumed; produce a trace message.
+ */
+
+void atrace(dp)
+dptr dp;
+   {
+   inst t_ipc;
+
+   /*
+    * Compute the ipc of the instruction causing resumption.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, dp);
+   fprintf(stderr, " resumed");
+   putc('\n', stderr);
+   fflush(stderr);
+   }
+
+#ifdef Coexpr
+/*
+ * coacttrace -- co-expression is being activated; produce a trace message.
+ */
+void coacttrace(ccp, ncp)
+struct b_coexpr *ccp;
+struct b_coexpr *ncp;
+   {
+   struct b_proc *bp;
+   inst t_ipc;
+
+   bp = (struct b_proc *)BlkLoc(*glbl_argp);
+   /*
+    * Compute the ipc of the activation instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, &(bp->pname));
+   fprintf(stderr,"; co-expression_%ld : ", (long)ccp->id);
+   outimage(stderr, (dptr)(sp - 3), 0);
+   fprintf(stderr," @ co-expression_%ld\n", (long)ncp->id);
+   fflush(stderr);
+   }
+
+/*
+ * corettrace -- return from co-expression; produce a trace message.
+ */
+void corettrace(ccp, ncp)
+struct b_coexpr *ccp;
+struct b_coexpr *ncp;
+   {
+   struct b_proc *bp;
+   inst t_ipc;
+
+   bp = (struct b_proc *)BlkLoc(*glbl_argp);
+   /*
+    * Compute the ipc of the coret instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, &(bp->pname));
+   fprintf(stderr,"; co-expression_%ld returned ", (long)ccp->id);
+   outimage(stderr, (dptr)(&ncp->es_sp[-3]), 0);
+   fprintf(stderr," to co-expression_%ld\n", (long)ncp->id);
+   fflush(stderr);
+   }
+
+/*
+ * cofailtrace -- failure return from co-expression; produce a trace message.
+ */
+void cofailtrace(ccp, ncp)
+struct b_coexpr *ccp;
+struct b_coexpr *ncp;
+   {
+   struct b_proc *bp;
+   inst t_ipc;
+
+   bp = (struct b_proc *)BlkLoc(*glbl_argp);
+   /*
+    * Compute the ipc of the cofail instruction.
+    */
+   t_ipc.op = ipc.op - 1;
+   showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
+   showlevel(k_level);
+   putstr(stderr, &(bp->pname));
+   fprintf(stderr,"; co-expression_%ld failed to co-expression_%ld\n",
+      (long)ccp->id, (long)ncp->id);
+   fflush(stderr);
+   }
+#endif					/* Coexpr */
+#endif					/* !COMPILER */
+
+/*
+ * Service routine to display variables in given number of
+ *  procedure calls to file f.
+ */
+
+int xdisp(fp,dp,count,f)
+#if COMPILER
+   struct p_frame *fp;
+#else					/* COMPILER */
+   struct pf_marker *fp;
+#endif					/* COMPILER */
+   register dptr dp;
+   int count;
+   FILE *f;
+   {
+   register dptr np;
+   register int n;
+   struct b_proc *bp;
+   word nglobals, *indices;
+
+   while (count--) {		/* go back through 'count' frames */
+      if (fp == NULL)
+         break;       /* needed because &level is wrong in co-expressions */
+
+#if COMPILER
+      bp = PFDebug(*fp)->proc;	/* get address of procedure block */
+#else					/* COMPILER */
+      bp = (struct b_proc *)BlkLoc(*dp++); /* get addr of procedure block */
+      /* #%#% was: no post-increment there, but *pre*increment dp below */
+#endif					/* COMPILER */
+
+      /*
+       * Print procedure name.
+       */
+      putstr(f, &(bp->pname));
+      fprintf(f, " local identifiers:\n");
+
+      /*
+       * Print arguments.
+       */
+      np = bp->lnames;
+      for (n = abs((int)bp->nparam); n > 0; n--) {
+         fprintf(f, "   ");
+         putstr(f, np);
+         fprintf(f, " = ");
+         outimage(f, dp++, 0);
+         putc('\n', f);
+         np++;
+         }
+
+      /*
+       * Print locals.
+       */
+#if COMPILER
+      dp = fp->tend.d;
+#else					/* COMPILER */
+      dp = &fp->pf_locals[0];
+#endif					/* COMPILER */
+      for (n = bp->ndynam; n > 0; n--) {
+         fprintf(f, "   ");
+         putstr(f, np);
+         fprintf(f, " = ");
+         outimage(f, dp++, 0);
+         putc('\n', f);
+         np++;
+         }
+
+      /*
+       * Print statics.
+       */
+      dp = &statics[bp->fstatic];
+      for (n = bp->nstatic; n > 0; n--) {
+         fprintf(f, "   ");
+         putstr(f, np);
+         fprintf(f, " = ");
+         outimage(f, dp++, 0);
+         putc('\n', f);
+         np++;
+         }
+
+#if COMPILER
+      dp = fp->old_argp;
+      fp = fp->old_pfp;
+#else					/* COMPILER */
+      dp = fp->pf_argp;
+      fp = fp->pf_pfp;
+#endif					/* COMPILER */
+      }
+
+   /*
+    * Print globals.  Sort names in lexical order using temporary index array.
+    */
+
+#if COMPILER
+   nglobals = n_globals;
+#else					/* COMPILER */
+   nglobals = eglobals - globals;
+#endif					/* COMPILER */
+
+   indices = (word *)malloc(nglobals * sizeof(word));
+   if (indices == NULL)
+      return Failed;
+   else {
+      for (n = 0; n < nglobals; n++)
+         indices[n] = n;
+      qsort ((char*)indices, (int)nglobals, sizeof(word), (int (*)())glbcmp);
+      fprintf(f, "\nglobal identifiers:\n");
+      for (n = 0; n < nglobals; n++) {
+         fprintf(f, "   ");
+         putstr(f, &gnames[indices[n]]);
+         fprintf(f, " = ");
+         outimage(f, &globals[indices[n]], 0);
+         putc('\n', f);
+         }
+      fflush(f);
+      free((pointer)indices);
+      }
+   return Succeeded;
+   }
+
+/*
+ * glbcmp - compare the names of two globals using their temporary indices.
+ */
+static int glbcmp (pi, pj)
+char *pi, *pj;
+   {
+   register word i = *(word *)pi;
+   register word j = *(word *)pj;
+   return lexcmp(&gnames[i], &gnames[j]);
+   }
+
diff --git a/src/runtime/rimage.r b/src/runtime/rimage.r
new file mode 100644
index 0000000..775b836
--- /dev/null
+++ b/src/runtime/rimage.r
@@ -0,0 +1,930 @@
+/*
+ * File: rimage.c
+ *  Functions and data for reading and writing GIF images
+ */
+
+#ifdef Graphics
+
+#define GifSeparator	0x2C	/* (',') beginning of image */
+#define GifTerminator	0x3B	/* (';') end of image */
+#define GifExtension	0x21	/* ('!') extension block */
+#define GifControlExt	0xF9	/*       graphic control extension label */
+#define GifEmpty	-1	/* internal flag indicating no prefix */
+
+#define GifTableSize	4096	/* maximum number of entries in table */
+#define GifBlockSize	255	/* size of output block */
+
+typedef struct lzwnode {	/* structure of LZW encoding tree node */
+   unsigned short tcode;		/* token code */
+   unsigned short child;	/* first child node */
+   unsigned short sibling;	/* next sibling */
+   } lzwnode;
+
+static	int	gfread		(char *fn, int p);
+static	int	gfheader	(FILE *f);
+static	int	gfskip		(FILE *f);
+static	void	gfcontrol	(FILE *f);
+static	int	gfimhdr		(FILE *f);
+static	int	gfmap		(FILE *f, int p);
+static	int	gfsetup		(void);
+static	int	gfrdata		(FILE *f);
+static	int	gfrcode		(FILE *f);
+static	void	gfinsert	(int prev, int c);
+static	int	gffirst		(int c);
+static	void	gfgen		(int c);
+static	void	gfput		(int b);
+
+static	int	gfwrite		(wbp w, char *filename,
+				   int x, int y, int width, int height);
+static	void	gfmktree	(lzwnode *tree);
+static	void	gfout		(int tcode);
+static	void	gfdump		(void);
+
+static	int	medcut	(long hlist[], struct palentry plist[], int ncolors);
+
+static FILE *gf_f;			/* input file */
+
+static int gf_gcmap, gf_lcmap;		/* global color map? local color map? */
+static int gf_nbits;			/* number of bits per pixel */
+static int gf_ilace;			/* interlace flag */
+static int gf_width, gf_height;		/* image size */
+
+static short *gf_prefix, *gf_suffix;	/* prefix and suffix tables */
+static int gf_free;			/* next free position */
+
+static struct palentry *gf_paltbl;	/* palette table */
+static unsigned char *gf_string;	/* incoming image data */
+static short *gf_pixels;		/* outgoing image data */
+static unsigned char *gf_nxt, *gf_lim;	/* store pointer and its limit */
+static int gf_row, gf_step;		/* current row and step size */
+
+static int gf_cdsize;			/* code size */
+static int gf_clear, gf_eoi;		/* values of CLEAR and EOI codes */
+static int gf_lzwbits, gf_lzwmask;	/* current bits per code */
+
+static unsigned char *gf_obuf;		/* output buffer */
+static unsigned long gf_curr;		/* current partial byte(s) */
+static int gf_valid;			/* number of valid bits */
+static int gf_rem;			/* remaining bytes in this block */
+
+/*
+ * readGIF(filename, p, imd) - read GIF file into image data structure
+ *
+ * p is a palette number to which the GIF colors are to be coerced;
+ * p=0 uses the colors exactly as given in the GIF file.
+ */
+int readGIF(filename, p, imd)
+char *filename;
+int p;
+struct imgdata *imd;
+   {
+   int r;
+
+   r = gfread(filename, p);			/* read image */
+
+   if (gf_prefix) free((pointer)gf_prefix);	/* deallocate temp memory */
+   if (gf_suffix) free((pointer)gf_suffix);
+   if (gf_f) fclose(gf_f);
+
+   if (r != Succeeded) {			/* if no success, free mem */
+      if (gf_paltbl) free((pointer) gf_paltbl);
+      if (gf_string) free((pointer) gf_string);
+      return r;					/* return Failed or Error */
+      }
+
+   imd->width = gf_width;			/* set return variables */
+   imd->height = gf_height;
+   imd->paltbl = gf_paltbl;
+   imd->data = gf_string;
+
+   return Succeeded;				/* return success */
+   }
+
+/*
+ * gfread(filename, p) - read GIF file, setting gf_ globals
+ */
+static int gfread(filename, p)
+char *filename;
+int p;
+   {
+   int i;
+
+   gf_f = NULL;
+   gf_prefix = NULL;
+   gf_suffix = NULL;
+   gf_string = NULL;
+
+   if (!(gf_paltbl = (struct palentry *)malloc(256 * sizeof(struct palentry))))
+      return Failed;
+
+   if ((gf_f = fopen(filename, "rb")) == NULL)
+      return Failed;
+
+   for (i = 0; i < 256; i++)		/* init palette table */
+      gf_paltbl[i].used = gf_paltbl[i].valid = gf_paltbl[i].transpt = 0;
+
+   if (!gfheader(gf_f))			/* read file header */
+      return Failed;
+   if (gf_gcmap)			/* read global color map, if any */
+      if (!gfmap(gf_f, p))
+         return Failed;
+   if (!gfskip(gf_f))			/* skip to start of image */
+      return Failed;
+   if (!gfimhdr(gf_f))			/* read image header */
+      return Failed;
+   if (gf_lcmap)			/* read local color map, if any */
+      if (!gfmap(gf_f, p))
+         return Failed;
+   if (!gfsetup())			/* prepare to read image */
+      return Error;
+   if (!gfrdata(gf_f))			/* read image data */
+      return Failed;
+   while (gf_row < gf_height)		/* pad if too short */
+      gfput(0);
+
+   return Succeeded;
+   }
+
+/*
+ * gfheader(f) - read GIF file header; return nonzero if successful
+ */
+static int gfheader(f)
+FILE *f;
+   {
+   unsigned char hdr[13];		/* size of a GIF header */
+   int b;
+
+   if (fread((char *)hdr, sizeof(char), sizeof(hdr), f) != sizeof(hdr))
+      return 0;				/* header short or missing */
+   if (strncmp((char *)hdr, "GIF", 3) != 0 ||
+         !isdigit(hdr[3]) || !isdigit(hdr[4]))
+      return 0;				/* not GIFnn */
+
+   b = hdr[10];				/* flag byte */
+   gf_gcmap = b & 0x80;			/* global color map flag */
+   gf_nbits = (b & 7) + 1;		/* number of bits per pixel */
+   return 1;
+   }
+
+/*
+ * gfskip(f) - skip intermediate blocks and locate image
+ */
+static int gfskip(f)
+FILE *f;
+   {
+   int c, n;
+
+   while ((c = getc(f)) != GifSeparator) { /* look for start-of-image flag */
+      if (c == EOF)
+         return 0;
+      if (c == GifExtension) {		/* if extension block is present */
+         c = getc(f);				/* get label */
+	 if ((c & 0xFF) == GifControlExt)
+	    gfcontrol(f);			/* process control subblock */
+         while ((n = getc(f)) != 0) {		/* read blks until empty one */
+            if (n == EOF)
+               return 0;
+	    n &= 0xFF;				/* ensure positive count */
+            while (n--)				/* skip block contents */
+               getc(f);
+            }
+         }
+      }
+   return 1;
+   }
+
+/*
+ * gfcontrol(f) - process control extension subblock
+ */
+static void gfcontrol(f)
+FILE *f;
+   {
+   int i, n, c, t;
+
+   n = getc(f) & 0xFF;				/* subblock length (s/b 4) */
+   for (i = t = 0; i < n; i++) {
+      c = getc(f) & 0xFF;
+      if (i == 0)
+	 t = c & 1;				/* transparency flag */
+      else if (i == 3 && t != 0) {
+	 gf_paltbl[c].transpt = 1;		/* set flag for transpt color */
+	 gf_paltbl[c].valid = 0;		/* color is no longer "valid" */
+	 }
+      }
+   }
+
+/*
+ * gfimhdr(f) - read image header
+ */
+static int gfimhdr(f)
+FILE *f;
+   {
+   unsigned char hdr[9];		/* size of image hdr excl separator */
+   int b;
+
+   if (fread((char *)hdr, sizeof(char), sizeof(hdr), f) != sizeof(hdr))
+      return 0;				/* header short or missing */
+   gf_width = hdr[4] + 256 * hdr[5];
+   gf_height = hdr[6] + 256 * hdr[7];
+   b = hdr[8];				/* flag byte */
+   gf_lcmap = b & 0x80;			/* local color map flag */
+   gf_ilace = b & 0x40;			/* interlace flag */
+   if (gf_lcmap)
+      gf_nbits = (b & 7) + 1;		/* if local map, reset nbits also */
+   return 1;
+   }
+
+/*
+ * gfmap(f, p) - read GIF color map into paltbl under control of palette p
+ */
+static int gfmap(f, p)
+FILE *f;
+int p;
+   {
+   int ncolors, i, r, g, b, c;
+   struct palentry *stdpal = 0;
+
+   if (p)
+      stdpal = palsetup(p);
+
+   ncolors = 1 << gf_nbits;
+
+   for (i = 0; i < ncolors; i++) {
+      r = getc(f);
+      g = getc(f);
+      b = getc(f);
+      if (r == EOF || g == EOF || b == EOF)
+         return 0;
+      if (p) {
+         c = *(unsigned char *)(rgbkey(p, r / 255.0, g / 255.0, b / 255.0));
+         gf_paltbl[i].clr = stdpal[c].clr;
+         }
+      else {
+         gf_paltbl[i].clr.red   = 257 * r;	/* 257 * 255 -> 65535 */
+         gf_paltbl[i].clr.green = 257 * g;
+         gf_paltbl[i].clr.blue  = 257 * b;
+         }
+      if (!gf_paltbl[i].transpt)		/* if not transparent color */
+         gf_paltbl[i].valid = 1;		/* mark as valid/opaque */
+      }
+
+   return 1;
+   }
+
+/*
+ * gfsetup() - prepare to read GIF data
+ */
+static int gfsetup()
+   {
+   int i;
+   word len;
+
+   len = (word)gf_width * (word)gf_height;
+   gf_string = (unsigned char *)malloc(len);
+   gf_prefix = (short *)malloc(GifTableSize * sizeof(short));
+   gf_suffix = (short *)malloc(GifTableSize * sizeof(short));
+   if (!gf_string || !gf_prefix || !gf_suffix)
+      return 0;
+   for (i = 0; i < GifTableSize; i++) {
+      gf_prefix[i] = GifEmpty;
+      gf_suffix[i] = i;
+      }
+
+   gf_row = 0;				/* current row is 0 */
+   gf_nxt = gf_string;			/* set store pointer */
+
+   if (gf_ilace) {			/* if interlaced */
+      gf_step = 8;			/* step rows by 8 */
+      gf_lim = gf_string + gf_width;	/* stop at end of one row */
+      }
+   else {
+      gf_lim = gf_string + len;		/* do whole image at once */
+      gf_step = gf_height;		/* step to end when full */
+      }
+
+   return 1;
+   }
+
+/*
+ * gfrdata(f) - read GIF data
+ */
+static int gfrdata(f)
+FILE *f;
+   {
+   int curr, prev, c;
+
+   if ((gf_cdsize = getc(f)) == EOF)
+      return 0;
+   gf_clear = 1 << gf_cdsize;
+   gf_eoi = gf_clear + 1;
+   gf_free = gf_eoi + 1;
+
+   gf_lzwbits = gf_cdsize + 1;
+   gf_lzwmask = (1 << gf_lzwbits) - 1;
+
+   gf_curr = 0;
+   gf_valid = 0;
+   gf_rem = 0;
+
+   prev = curr = gfrcode(f);
+   while (curr != gf_eoi) {
+      if (curr == gf_clear) {		/* if reset code */
+         gf_lzwbits = gf_cdsize + 1;
+         gf_lzwmask = (1 << gf_lzwbits) - 1;
+         gf_free = gf_eoi + 1;
+         prev = curr = gfrcode(f);
+         gfgen(curr);
+         }
+      else if (curr < gf_free) {	/* if code is in table */
+         gfgen(curr);
+         gfinsert(prev, gffirst(curr));
+         prev = curr;
+         }
+      else if (curr == gf_free) {	/* not yet in table */
+         c = gffirst(prev);
+         gfgen(prev);
+         gfput(c);
+         gfinsert(prev, c);
+         prev = curr;
+         }
+      else {				/* illegal code */
+         if (gf_nxt == gf_lim)
+            return 1;			/* assume just extra stuff after end */
+         else
+            return 0;			/* more badly confused */
+         }
+      curr = gfrcode(f);
+      }
+
+   return 1;
+   }
+
+/*
+ * gfrcode(f) - read next LZW code
+ */
+static int gfrcode(f)
+FILE *f;
+   {
+   int c, r;
+
+   while (gf_valid < gf_lzwbits) {
+      if (--gf_rem <= 0) {
+         if ((gf_rem = getc(f)) == EOF)
+            return gf_eoi;
+         }
+      if ((c = getc(f)) == EOF)
+         return gf_eoi;
+      gf_curr |= ((c & 0xFF) << gf_valid);
+      gf_valid += 8;
+      }
+   r = gf_curr & gf_lzwmask;
+   gf_curr >>= gf_lzwbits;
+   gf_valid -= gf_lzwbits;
+   return r;
+   }
+
+/*
+ * gfinsert(prev, c) - insert into table
+ */
+static void gfinsert(prev, c)
+int prev, c;
+   {
+
+   if (gf_free >= GifTableSize)		/* sanity check */
+      return;
+
+   gf_prefix[gf_free] = prev;
+   gf_suffix[gf_free] = c;
+
+   /* increase code size if code bits are exhausted, up to max of 12 bits */
+   if (++gf_free > gf_lzwmask && gf_lzwbits < 12) {
+      gf_lzwmask = gf_lzwmask * 2 + 1;
+      gf_lzwbits++;
+      }
+
+   }
+
+/*
+ * gffirst(c) - return the first pixel in a map structure
+ */
+static int gffirst(c)
+int c;
+   {
+   int d;
+
+   if (c >= gf_free)
+      return 0;				/* not in table (error) */
+   while ((d = gf_prefix[c]) != GifEmpty)
+      c = d;
+   return gf_suffix[c];
+   }
+
+/*
+ * gfgen(c) - generate and output prefix
+ */
+static void gfgen(c)
+int c;
+   {
+   int d;
+
+   if ((d = gf_prefix[c]) != GifEmpty)
+      gfgen(d);
+   gfput(gf_suffix[c]);
+   }
+
+/*
+ * gfput(b) - add a byte to the output string
+ */
+static void gfput(b)
+int b;
+   {
+   if (gf_nxt >= gf_lim) {		/* if current row is full */
+      gf_row += gf_step;
+      while (gf_row >= gf_height && gf_ilace && gf_step > 2) {
+         if (gf_step == 4) {
+            gf_row = 1;
+            gf_step = 2;
+            }
+	 else if ((gf_row % 8) != 0) {
+            gf_row = 2;
+            gf_step = 4;
+            }
+         else {
+            gf_row = 4;
+	    /* gf_step remains 8 */
+	    }
+	 }
+
+      if (gf_row >= gf_height) {
+	 gf_step = 0;
+	 return;			/* too much data; ignore it */
+	 }
+      gf_nxt = gf_string + ((word)gf_row * (word)gf_width);
+      gf_lim = gf_nxt + gf_width;
+      }
+
+   *gf_nxt++ = b;			/* store byte */
+   gf_paltbl[b].used = 1;		/* mark color entry as used */
+   }
+
+/*
+ * writeGIF(w, filename, x, y, width, height) - write GIF image
+ *
+ * Returns Succeeded, Failed, or Error.
+ * We assume that the area specified is within the window.
+ */
+int writeGIF(w, filename, x, y, width, height)
+wbp w;
+char *filename;
+int x, y, width, height;
+   {
+   int r;
+
+   r = gfwrite(w, filename, x, y, width, height);
+   if (gf_f) fclose(gf_f);
+   if (gf_pixels) free((pointer)gf_pixels);
+   return r;
+   }
+
+/*
+ * gfwrite(w, filename, x, y, width, height) - write GIF file
+ *
+ * We write GIF87a format (not 89a) for maximum acceptability and because
+ * we don't need any of the extensions of GIF89.
+ */
+
+static int gfwrite(w, filename, x, y, width, height)
+wbp w;
+char *filename;
+int x, y, width, height;
+   {
+   unsigned char obuf[GifBlockSize];
+   short *p, *q;
+   int i, c, cur, nc;
+   long h, npixels, hlist[1<<15];
+   LinearColor *cp;
+   struct palentry paltbl[GIFMAX];
+   lzwnode tree[GifTableSize + 1];
+
+   npixels = (long)width * (long)height;	/* total length of data */
+
+   if (!(gf_f = fopen(filename, "wb")))
+      return Failed;
+   if (!(gf_pixels = malloc(npixels * sizeof(short))))
+      return Error;
+
+   if (!capture(w, x, y, width, height, gf_pixels))	/* get data (rgb15) */
+      return Error;
+
+   memset(hlist, 0, sizeof(hlist));
+   for (h = 0; h < npixels; h++)	/* make histogram */
+      hlist[gf_pixels[h]]++;
+
+   nc = medcut(hlist, paltbl, GIFMAX);	/* make palette using median cut alg */
+   if (nc == 0)
+      return Error;
+
+   gf_nbits = 1;			/* figure out gif bits for nc colors */
+   while ((1 << gf_nbits) < nc)
+      gf_nbits++;
+   if (gf_nbits < 2)
+      gf_cdsize = 2;
+   else
+      gf_cdsize = gf_nbits;
+
+   gf_clear = 1 << gf_cdsize;		/* set encoding variables */
+   gf_eoi = gf_clear + 1;
+   gf_free = gf_eoi + 1;
+   gf_lzwbits = gf_cdsize + 1;
+
+   /*
+    * Write the header, global color table, and image descriptor.
+    */
+
+   fprintf(gf_f, "GIF87a%c%c%c%c%c%c%c", width, width >> 8, height, height >> 8,
+      0x80 | ((gf_nbits - 1) << 4) | (gf_nbits - 1), 0, 0);
+
+   for (i = 0; i < (1 << gf_nbits); i++) {	/* output color table */
+      if (i < GIFMAX && i < nc) {
+         cp = &paltbl[i].clr;
+         putc(cp->red >> 8, gf_f);
+         putc(cp->green >> 8, gf_f);
+         putc(cp->blue >> 8, gf_f);
+         }
+      else {
+         putc(0, gf_f);
+         putc(0, gf_f);
+         putc(0, gf_f);
+         }
+      }
+
+   fprintf(gf_f, "%c%c%c%c%c%c%c%c%c%c%c", GifSeparator, 0, 0, 0, 0,
+      width, width >> 8, height, height >> 8, gf_nbits - 1, gf_cdsize);
+
+   /*
+    * Encode and write the image.
+    */
+   gf_obuf = obuf;			/* initialize output state */
+   gf_curr = 0;
+   gf_valid = 0;
+   gf_rem = GifBlockSize;
+
+   gfmktree(tree);			/* initialize encoding tree */
+
+   gfout(gf_clear);			/* start with CLEAR code */
+
+   p = gf_pixels;
+   q = p + npixels;
+   cur = hlist[*p++];			/* first pixel is special */
+   while (p < q) {
+      c = hlist[*p++];			/* get code */
+      for (i = tree[cur].child; i != 0; i = tree[i].sibling)
+         if (tree[i].tcode == c)	/* find as suffix of previous string */
+            break;
+      if (i != 0) {			/* if found in encoding tree */
+         cur = i;			/* note where */
+         continue;			/* and accumulate more */
+         }
+      gfout(cur);			/* new combination -- output prefix */
+      tree[gf_free].tcode = c;		/* make node for new combination */
+      tree[gf_free].child = 0;
+      tree[gf_free].sibling = tree[cur].child;
+      tree[cur].child = gf_free;
+      cur = c;				/* restart string from single pixel */
+      ++gf_free;			/* grow tree to account for new node */
+      if (gf_free > (1 << gf_lzwbits)) {
+         if (gf_free > GifTableSize) {
+            gfout(gf_clear);		/* table is full; reset to empty */
+            gf_lzwbits = gf_cdsize + 1;
+            gfmktree(tree);
+            }
+         else
+            gf_lzwbits++;		/* time to make output one bit wider */
+         }
+      }
+
+   /*
+    * Finish up.
+    */
+   gfout(cur);				/* flush accumulated prefix */
+   gfout(gf_eoi);			/* send EOI code */
+   gf_lzwbits = 7;
+   gfout(0);				/* force out last partial byte */
+   gfdump();				/* dump final block */
+   putc(0, gf_f);			/* terminate image (block of size 0) */
+   putc(GifTerminator, gf_f);		/* terminate file */
+
+   fflush(gf_f);
+   if (ferror(gf_f))
+      return Failed;
+   else
+      return Succeeded;			/* caller will close file */
+   }
+
+/*
+ * gfmktree() - initialize or reinitialize encoding tree
+ */
+
+static void gfmktree(tree)
+lzwnode *tree;
+   {
+   int i;
+
+   for (i = 0; i < gf_clear; i++) {	/* for each basic entry */
+      tree[i].tcode = i;			/* code is pixel value */
+      tree[i].child = 0;		/* no suffixes yet */
+      tree[i].sibling = i + 1;		/* next code is sibling */
+      }
+   tree[gf_clear - 1].sibling = 0;	/* last entry has no sibling */
+   gf_free = gf_eoi + 1;		/* reset next free entry */
+   }
+
+/*
+ * gfout(code) - output one LZW token
+ */
+static void gfout(tcode)
+int tcode;
+   {
+   gf_curr |= tcode << gf_valid;		/* add to current word */
+   gf_valid += gf_lzwbits;		/* count the bits */
+   while (gf_valid >= 8) {		/* while we have a byte to output */
+      gf_obuf[GifBlockSize - gf_rem] = gf_curr;	/* put in buffer */
+      gf_curr >>= 8;				/* remove from word */
+      gf_valid -= 8;
+      if (--gf_rem == 0)			/* flush buffer when full */
+         gfdump();
+      }
+   }
+
+/*
+ * gfdump() - dump output buffer
+ */
+static void gfdump()
+   {
+   int n;
+
+   n = GifBlockSize - gf_rem;
+   putc(n, gf_f);			/* write block size */
+   fwrite((pointer)gf_obuf, 1, n, gf_f); /*write block */
+   gf_rem = GifBlockSize;		/* reset buffer to empty */
+   }
+
+/*
+ * Median cut quantization code, based on the classic algorithm from
+ *	Color Image Quantization for Frame Buffer Display
+ *	Paul Heckbert
+ *	SIGGRAPH '82, July 1982 (vol 16 no 3), pp297-307
+ */
+
+typedef struct box {	/* 3-D RGB region for median cut algorithm */
+   struct box *next;		/* next box in chain */
+   long count;			/* number of occurrences in this region */
+   char maxaxis;		/* indication of longest axis */
+   char maxdim;			/* length along longest axis */
+   char cutpt;			/* cut point along that axis */
+   char rmin, gmin, bmin;	/* minimum r, g, b values (5-bit color) */
+   char rmax, gmax, bmax;	/* maximum r, g, b values (5-bit color) */
+   } box;
+
+#define MC_QUANT 5		/* quantize colors to 5 bits for median cut */
+#define MC_MAXC ((1 << MC_QUANT) - 1)	/* so the maximum color value is 31 */
+
+#define MC_RED (2 * MC_QUANT)	/* red shift */
+#define MC_GRN (1 * MC_QUANT)	/* green shift */
+#define MC_BLU (0 * MC_QUANT)	/* blue shift */
+
+static void mc_shrink(box *bx);
+static void mc_cut(box *bx);
+static void mc_setcolor(box *bx, struct palentry *pe, int i);
+static void mc_median(box *bx, int axis, long counts[], int min, int max);
+static void mc_remove(box *bx);
+static void mc_insert(box *bx);
+
+static long *mc_hlist;		/* current histogram list */
+static box *mc_blist;		/* current box list */
+static int mc_nboxes = 0;	/* number of boxes allocated so far */
+
+static box *mc_bfirst;		/* first box on linked list */
+
+/*
+ * medcut(hlist, plist, n) -- perform median-cut color quantization.
+ *
+ * On entry, hlist is a histogram of 32768 entries (5-bit color),
+ *  plist is an array of n palentry structs to be filled in,
+ *  and n is the number of colors desired in the result.
+ *
+ * On exit, up to n entries in plist have been filled in, and each
+ *  hlist entry is an index into plist for the corresponding color.
+ *
+ * medcut returns the number of entries actually used.
+ *  This is usually n if the histogram has that many nonzero entries.
+ *  A return code of 0 indicates an allocation failure.
+ */
+int medcut(long hlist[], struct palentry plist[], int ncolors) {
+   box *bx;
+   int i;
+
+   if ((mc_blist = malloc(ncolors * sizeof(box))) == NULL)
+      return 0;
+   mc_nboxes = 0;
+   mc_hlist = hlist;
+
+   bx = &mc_blist[mc_nboxes++];		/* create initial box */
+   bx->next = NULL;
+   bx->rmin = bx->gmin = bx->bmin = 0;
+   bx->rmax = bx->gmax = bx->bmax = 31;
+   mc_shrink(bx);			/* set box statistics */
+   mc_bfirst = bx;			/* put as first and only box on chain */
+
+   while (mc_nboxes < ncolors && mc_bfirst->maxdim > 1)
+      mc_cut(mc_bfirst);		/* split box with longest dimension */
+
+   for (i = 0; i < mc_nboxes; i++)		/* for every box created */
+      mc_setcolor(&mc_blist[i], &plist[i], i);	/* set palette entry */
+
+   free(mc_blist);
+   return mc_nboxes;
+   }
+
+/*
+ * mc_shrink(bx) -- shrink a box to tightly enclose its contents.
+ *
+ *  Adjusts rmin, gmin, bmin, rmax, gmax, bmax. 
+ *  Calculates count, maxaxis, maxdim, and cutpt
+ *  (while the necessary statistics are handy).
+ */
+static void mc_shrink(box *bx) {
+   int i, n, r, g, b, t, dr, dg, db;
+   long rcounts[MC_MAXC+1], gcounts[MC_MAXC+1], bcounts[MC_MAXC+1];
+
+   memset(rcounts, 0, (MC_MAXC + 1) * sizeof(long));
+   memset(gcounts, 0, (MC_MAXC + 1) * sizeof(long));
+   memset(bcounts, 0, (MC_MAXC + 1) * sizeof(long));
+
+   /*
+    * Simultaneously count cross-sections along r, g, and b axes.
+    */
+   t = n = 0;
+   for (r = bx->rmin; r <= bx->rmax; r++) {
+      for (g = bx->gmin; g <= bx->gmax; g++) {
+         for (b = bx->bmin; b <= bx->bmax; b++) {
+            i = (r << MC_RED) + (g << MC_GRN) + (b << MC_BLU);
+            n = mc_hlist[i];
+            t += n;
+            rcounts[r] += n;
+            gcounts[g] += n;
+            bcounts[b] += n;
+            }
+         }
+      }
+   bx->count = t;
+
+   /*
+    * Adjust min/mas bounds to tightly enclose the data we found.
+    */
+   while (rcounts[bx->rmin] == 0)  bx->rmin++;
+   while (rcounts[bx->rmax] == 0)  bx->rmax--;
+   while (gcounts[bx->gmin] == 0)  bx->gmin++;
+   while (gcounts[bx->gmax] == 0)  bx->gmax--;
+   while (bcounts[bx->bmin] == 0)  bx->bmin++;
+   while (bcounts[bx->bmax] == 0)  bx->bmax--;
+
+   /*
+    * Find and record the axis of longest dimension.
+    */
+   dr = bx->rmax - bx->rmin;
+   dg = bx->gmax - bx->gmin;
+   db = bx->bmax - bx->bmin;
+   if (db > dg && db > dr)
+      mc_median(bx, MC_BLU, bcounts, bx->bmin, bx->bmax);
+   else if (dr > dg)
+      mc_median(bx, MC_RED, rcounts, bx->rmin, bx->rmax);
+   else
+      mc_median(bx, MC_GRN, gcounts, bx->gmin, bx->gmax);
+   }
+
+/*
+ * mc_median(bx, axis, counts, cmin, cmax) -- find median and set box values.
+ */
+static void mc_median(box *bx, int axis, long counts[], int cmin, int cmax) {
+   int lower, upper;
+
+   bx->maxaxis = axis;
+   bx->maxdim = cmax - cmin + 1;
+   lower = counts[cmin];
+   upper = counts[cmax];
+
+   /*
+    * Approach from both ends to find the median bin.
+    */
+   while (cmin < cmax) {
+      if (lower < upper)
+         lower += counts[++cmin];
+      else
+         upper += counts[--cmax];
+      }
+
+   /*
+    * Have counted the median bin in both upper and lower halves.
+    *  Remove it from the larger of those two.
+    */
+   if (lower < upper)
+      upper -= counts[cmax++];
+   else
+      lower -= counts[cmin--];
+
+   bx->cutpt = cmax;
+   bx->count = lower + upper;
+   }
+
+/*
+ * mc_cut(bx) -- split box at previously recorded cutpoint.
+ */
+static void mc_cut(box *b1) {
+   box *b2;
+
+   mc_remove(b1);			/* unlink box */
+   b2 = &mc_blist[mc_nboxes++];		/* allocate new box */
+   *b2 = *b1;				/* duplicate the contents */
+
+   switch (b1->maxaxis) {
+      case MC_RED:  b1->rmax = b1->cutpt - 1;  b2->rmin = b2->cutpt;  break;
+      case MC_GRN:  b1->gmax = b1->cutpt - 1;  b2->gmin = b2->cutpt;  break;
+      case MC_BLU:  b1->bmax = b1->cutpt - 1;  b2->bmin = b2->cutpt;  break;
+      }
+   mc_shrink(b1);			/* recomputes box statistics */
+   mc_shrink(b2);
+
+   mc_insert(b1);			/* put both boxes back on list */
+   mc_insert(b2);
+   }
+
+/*
+ * mc_remove(bx) -- remove box from global linked list.
+ *
+ *  This is fast in practice because we always remove the first entry.
+ */
+static void mc_remove(box *bx) {
+   box **bp;
+
+   for (bp = &mc_bfirst; *bp != NULL; bp = &(*bp)->next) {
+      if (*bp == bx) {
+         *bp = bx->next;
+         return;
+         }
+      }
+   }
+
+/*
+ * mc_insert(bx) -- insert box in list, preserving decreasing maxdim ordering.
+ */
+static void mc_insert(box *bx) {
+   box **bp;
+
+   for (bp = &mc_bfirst; *bp != NULL; bp = &(*bp)->next) {
+      if (bx->maxdim > (*bp)->maxdim
+      || (bx->maxdim == (*bp)->maxdim && bx->count >= (*bp)->count)) 
+	 break;
+      }
+   bx->next = *bp;
+   *bp = bx;
+   }
+
+/*
+ * mc_setcolor(bx, pe, i) -- set palette entry to box color.
+ *
+ *  Also sets the associated hlist entries to i, the palette index.
+ */
+static void mc_setcolor(box *bx, struct palentry *pe, int i) {
+   int j, r, g, b;
+   long n, t = 0, rtotal = 0, gtotal = 0, btotal = 0;
+
+   /*
+    * Calculate a weighted sum of the colors in the box.
+    */
+   for (r = bx->rmin; r <= bx->rmax; r++) {
+      for (g = bx->gmin; g <= bx->gmax; g++) {
+         for (b = bx->bmin; b <= bx->bmax; b++) {
+            j = (r << MC_RED) + (g << MC_GRN) + (b << MC_BLU);
+            n = mc_hlist[j];
+            t += n;
+            rtotal += n * r;
+            gtotal += n * g;
+            btotal += n * b;
+            mc_hlist[j] = i;
+            }
+         }
+      }
+
+   /*
+    * Scale colors using floating arithmetic to avoid overflow.
+    */
+   pe->clr.red = (65535. / MC_MAXC) * rtotal / t + 0.5;
+   pe->clr.green = (65535. / MC_MAXC) * gtotal / t + 0.5;
+   pe->clr.blue = (65535. / MC_MAXC) * btotal / t + 0.5;
+   pe->used = 1;
+   pe->valid = 1;
+   pe->transpt = 0;
+   }
+
+#endif					/* Graphics */
diff --git a/src/runtime/rlrgint.r b/src/runtime/rlrgint.r
new file mode 100644
index 0000000..f624cc7
--- /dev/null
+++ b/src/runtime/rlrgint.r
@@ -0,0 +1,2302 @@
+/*
+ * File: rlrgint.r
+ *  Large integer arithmetic
+ */
+
+#ifdef LargeInts
+
+extern int over_flow;
+
+/*
+ *  Conventions:
+ *
+ *  Lrgints entering this module and leaving it are too large to
+ *  be represented with T_Integer.  So, externally, a given value
+ *  is always T_Integer or always T_Lrgint.
+ *
+ *  Routines outside this module operate on bignums by calling
+ *  a routine like
+ *
+ *      bigadd(da, db, dx)
+ *
+ *  where da, db, and dx are pointers to tended descriptors.
+ *  For the common case where one argument is a T_Integer, these
+ *  call routines like
+ *
+ *      bigaddi(da, IntVal(*db), dx).
+ *
+ *  The bigxxxi routines can convert an integer to bignum form;
+ *  they use itobig.
+ *
+ *  The routines that actually do the work take (length, address)
+ *  pairs specifying unsigned base-B digit strings.  The sign handling
+ *  is done in the bigxxx routines.
+ */
+
+/*
+ * Type for doing arithmetic on (2 * NB)-bit nonnegative numbers.
+ *  Normally unsigned but may be signed (with NB reduced appropriately)
+ *  if unsigned arithmetic is slow.
+ */
+
+/* The bignum radix, B */
+
+#define B            ((word)1 << NB)
+
+/* Lrgint digits in a word */
+
+#define WORDLEN  (WordBits / NB + (WordBits % NB != 0))
+
+/* size of a bignum block that will hold an integer */
+
+#define INTBIGBLK  sizeof(struct b_bignum) + sizeof(DIGIT) * WORDLEN
+
+/* lo(uword d) :            the low digit of a uword
+   hi(uword d) :            the rest, d is unsigned
+   signed_hi(uword d) :     the rest, d is signed
+   dbl(DIGIT a, DIGIT b) : the two-digit uword [a,b] */
+
+#define lo(d)        ((d) & (B - 1))
+#define hi(d)        ((uword)(d) >> NB)
+#define dbl(a,b)     (((uword)(a) << NB) + (b))
+
+#if ((-1) >> 1) < 0
+#define signed_hi(d) ((word)(d) >> NB)
+#else
+#define signbit      ((uword)1 << (WordBits - NB - 1))
+#define signed_hi(d) ((word)((((uword)(d) >> NB) ^ signbit) - signbit))
+#endif
+
+/* LrgInt(dptr dp) : the struct b_bignum pointed to by dp */
+
+#define LrgInt(dp)   ((struct b_bignum *)&BlkLoc(*dp)->bignumblk)
+
+/* LEN(struct b_bignum *b) : number of significant digits */
+
+#define LEN(b)       ((b)->lsd - (b)->msd + 1)
+
+/* DIG(struct b_bignum *b, word i): pointer to ith most significant digit */
+/*  (NOTE: This macro expansion often results in a very long string,
+ *   so when DIG is used, keep it to one use per line.)
+ */
+
+#define DIG(b,i)     (&(b)->digits[(b)->msd+(i)])
+
+/* ceil, ln: ceil may be 1 too high in case ln is inaccurate */
+
+#undef ceil
+#define ceil(x)      ((word)((x) + 1.01))
+#define ln(n)        (log((double)n))
+
+/* determine the number of words needed for a bignum block with n digits */
+
+#define LrgNeed(n)   ( ((sizeof(struct b_bignum) + ((n) - 1) * sizeof(DIGIT)) \
+		       + WordSize - 1) & -WordSize )
+
+/* copied from rconv.c */
+
+#define tonum(c)     (isdigit(c) ? (c)-'0' : 10+(((c)|(040))-'a'))
+
+/* copied from oref.c */
+
+#define RandVal (RanScale*(k_random=(RandA*(long)k_random+RandC)&0x7fffffffL))
+
+/*
+ * Prototypes.
+ */
+
+static int mkdesc	(struct b_bignum *x, dptr dx);
+static void itobig	(word i, struct b_bignum *x, dptr dx);
+
+static void decout	(FILE *f, DIGIT *n, word l);
+
+static int bigaddi	(dptr da, word i, dptr dx);
+static int bigsubi	(dptr da, word i, dptr dx);
+static int bigmuli	(dptr da, word i, dptr dx);
+static int bigdivi	(dptr da, word i, dptr dx);
+static int bigmodi	(dptr da, word i, dptr dx);
+static int bigpowi	(dptr da, word i, dptr dx);
+static int bigpowii	(word a, word i, dptr dx);
+static word bigcmpi	(dptr da, word i);
+
+static DIGIT add1	(DIGIT *u, DIGIT *v, DIGIT *w, word n);
+static word sub1	(DIGIT *u, DIGIT *v, DIGIT *w, word n);
+static void mul1	(DIGIT *u, DIGIT *v, DIGIT *w, word n, word m);
+static int div1
+   (DIGIT *a, DIGIT *b, DIGIT *q, DIGIT *r, word m, word n, struct b_bignum *b1, struct b_bignum *b2);
+static void compl1	(DIGIT *u, DIGIT *w, word n);
+static word cmp1	(DIGIT *u, DIGIT *v, word n);
+static DIGIT addi1	(DIGIT *u, word k, DIGIT *w, word n);
+static void subi1	(DIGIT *u, word k, DIGIT *w, word n);
+static DIGIT muli1	(DIGIT *u, word k, int c, DIGIT *w, word n);
+static DIGIT divi1	(DIGIT *u, word k, DIGIT *w, word n);
+static DIGIT shifti1	(DIGIT *u, word k, DIGIT c, DIGIT *w, word n);
+static word cmpi1	(DIGIT *u, word k, word n);
+
+#define bdzero(dest,l)  memset(dest, '\0', (l) * sizeof(DIGIT))
+#define bdcopy(src, dest, l)  memcpy(dest, src, (l) * sizeof(DIGIT))
+
+/*
+ * mkdesc -- put value into a descriptor
+ */
+
+static int mkdesc(x, dx)
+struct b_bignum *x;
+dptr dx;
+{
+   word xlen, cmp;
+   static DIGIT maxword[WORDLEN] = { 1 << ((WordBits - 1) % NB) };
+
+   /* suppress leading zero digits */
+
+   while (x->msd != x->lsd &&
+          *DIG(x,0) == 0)
+      x->msd++;
+
+   /* put it into a word if it fits, otherwise return the bignum */
+
+   xlen = LEN(x);
+
+   if (xlen < WORDLEN ||
+       (xlen == WORDLEN &&
+        ((cmp = cmp1(DIG(x,0), maxword, (word)WORDLEN)) < 0 ||
+        (cmp == (word)0 && x->sign)))) {
+      word val = -(word)*DIG(x,0);
+      word i;
+
+      for (i = x->msd; ++i <= x->lsd; )
+         val = (val << NB) - x->digits[i];
+      if (!x->sign)
+	 val = -val;
+      dx->dword = D_Integer;
+      IntVal(*dx) = val;
+      }
+   else {
+      dx->dword = D_Lrgint;
+      BlkLoc(*dx) = (union block *)x;
+      }
+   return Succeeded;
+}
+
+/*
+ *  i -> big
+ */
+
+static void itobig(i, x, dx)
+word i;
+struct b_bignum *x;
+dptr dx;
+{
+   x->lsd = WORDLEN - 1;
+   x->msd = WORDLEN;
+   x->sign = 0;
+
+   if (i == 0) {
+      x->msd--;
+      *DIG(x,0) = 0;
+      }
+   else if (i < 0) {
+      word d = lo(i);
+
+      if (d != 0) {
+         d = B - d;
+         i += B;
+         }
+      i = - signed_hi(i);
+      x->msd--;
+      *DIG(x,0) = d;
+      x->sign = 1;
+      }
+
+   while (i != 0) {
+      x->msd--;
+      *DIG(x,0) = lo(i);
+      i = hi(i);
+      }
+
+   dx->dword = D_Lrgint;
+   BlkLoc(*dx) = (union block *)x;
+}
+
+/*
+ *  string -> bignum
+ */
+
+word bigradix(sign, r, s, end_s, result)
+int sign;                      /* '-' or not */
+int r;                          /* radix 2 .. 36 */
+char *s, *end_s;                        /* input string */
+union numeric *result;          /* output T_Integer or T_Lrgint */
+{
+   struct b_bignum *b;
+   DIGIT *bd;
+   word len;
+   int c;
+
+   if (r == 0)
+      return CvtFail;
+   len = ceil((end_s - s) * ln(r) / ln(B));
+   Protect(b = alcbignum(len), return Error);
+   bd = DIG(b,0);
+
+   bdzero(bd, len);
+
+   if (r < 2 || r > 36)
+      return CvtFail;
+
+   for (c = ((s < end_s) ? *s++ : ' '); isalnum(c);
+        c = ((s < end_s) ? *s++ : ' ')) {
+      c = tonum(c);
+      if (c >= r)
+	 return CvtFail;
+      muli1(bd, (word)r, c, bd, len);
+      }
+
+   /*
+    * Skip trailing white space and make sure there is nothing else left
+    *  in the string. Note, if we have already reached end-of-string,
+    *  c has been set to a space.
+    */
+   while (isspace(c) && s < end_s)
+      c = *s++;
+   if (!isspace(c))
+      return CvtFail;
+
+   if (sign == '-')
+      b->sign = 1;
+
+   /* put value into dx and return the type */
+
+   { struct descrip dx;
+   (void)mkdesc(b, &dx);
+   if (Type(dx) == T_Lrgint)
+     result->big = (struct b_bignum *)BlkLoc(dx);
+   else
+     result->integer = IntVal(dx);
+   return Type(dx);
+   }
+}
+
+/*
+ *  bignum -> real
+ */
+
+double bigtoreal(da)
+dptr da;
+{
+   word i;
+   double r = 0;
+   struct b_bignum *b = &BlkLoc(*da)->bignumblk;
+
+   for (i = b->msd; i <= b->lsd; i++)
+      r = r * B + b->digits[i];
+
+   return (b->sign ? -r : r);
+}
+
+/*
+ *  real -> bignum
+ */
+
+int realtobig(da, dx)
+dptr da, dx;
+{
+
+#ifdef Double
+   double x;
+#else					/* Double */
+   double x = BlkLoc(*da)->realblk.realval;
+#endif					/* Double */
+
+   struct b_bignum *b;
+   word i, blen;
+   word d;
+   int sgn;
+
+#ifdef Double
+	{
+		int	*rp, *rq;
+		rp = (int *) &(BlkLoc(*da)->realblk.realval);
+		rq = (int *) &x;
+		*rq++ = *rp++;
+		*rq = *rp;
+	}
+#endif					/* Double */
+
+   if (x > 0.9999 * MinLong && x < 0.9999 * MaxLong) {
+      MakeInt((word)x, dx);
+      return Succeeded;		/* got lucky; a simple integer suffices */
+      }
+
+   if (sgn = x < 0)
+      x = -x;
+   blen = ln(x) / ln(B) + 0.99;
+   for (i = 0; i < blen; i++)
+      x /= B;
+   if (x >= 1.0) {
+      x /= B;
+      blen += 1;
+      }
+
+   Protect(b = alcbignum(blen), return Error);
+   for (i = 0; i < blen; i++) {
+      d = (x *= B);
+      *DIG(b,i) = d;
+      x -= d;
+      }
+
+   b->sign = sgn;
+   return mkdesc(b, dx);
+}
+
+/*
+ *  bignum -> string
+ */
+
+int bigtos(da, dx)
+dptr da, dx;
+{
+   tended struct b_bignum *a, *temp;
+   word alen = LEN(LrgInt(da));
+   word slen = ceil(alen * ln(B) / ln(10));
+   char *p, *q;
+
+   a = LrgInt(da);
+   Protect(temp = alcbignum(alen), fatalerr(0,NULL));
+   if (a->sign)
+      slen++;
+   Protect(q = alcstr(NULL,slen), fatalerr(0,NULL));
+   bdcopy(DIG(a,0),
+          DIG(temp,0),
+          alen);
+   p = q += slen;
+   while (cmpi1(DIG(temp,0),
+                (word)0, alen))
+      *--p = '0' + divi1(DIG(temp,0),
+                         (word)10,
+                         DIG(temp,0),
+                         alen);
+   if (a->sign)
+      *--p = '-';
+   StrLen(*dx) = q - p;
+   StrLoc(*dx) = p;
+   return NoCvt;	/* The mnemonic is wrong, but the signal means */
+			/* that the string is allocated and not null- */
+			/* terminated. */
+}
+
+/*
+ *  bignum -> file
+ */
+
+void bigprint(f, da)
+FILE *f;
+dptr da;
+{
+   struct b_bignum *a, *temp;
+   word alen = LEN(LrgInt(da));
+   word slen, dlen;
+   struct b_bignum *blk = &BlkLoc(*da)->bignumblk;
+
+   slen = blk->lsd - blk->msd;
+   dlen = slen * NB * 0.3010299956639812	/* 1 / log2(10) */
+      + log((double)blk->digits[blk->msd]) * 0.4342944819032518 + 0.5;
+						/* 1 / ln(10) */
+   if (dlen >= MaxDigits) {
+      fprintf(f, "integer(~10^%ld)",(long)dlen);
+      return;
+      }
+
+   /* not worth passing this one back */
+   Protect(temp = alcbignum(alen), fatalerr(0, NULL));
+
+   a = LrgInt(da);
+   bdcopy(DIG(a,0),
+          DIG(temp,0),
+          alen);
+   if (a->sign)
+      putc('-', f);
+   decout(f,
+          DIG(temp,0),
+          alen);
+}
+
+/*
+ * decout - given a base B digit string, print the number in base 10.
+ */
+static void decout(f, n, l)
+FILE *f;
+DIGIT *n;
+word l;
+{
+   DIGIT i = divi1(n, (word)10, n, l);
+
+   if (cmpi1(n, (word)0, l))
+      decout(f, n, l);
+   putc('0' + i, f);
+}
+
+/*
+ *  da -> dx
+ */
+
+int cpbignum(da, dx)
+dptr da, dx;
+{
+   struct b_bignum *a, *x;
+   word alen = LEN(LrgInt(da));
+
+   Protect(x = alcbignum(alen), return Error);
+   a = LrgInt(da);
+   bdcopy(DIG(a,0),
+          DIG(x,0),
+          alen);
+   x->sign = a->sign;
+   return mkdesc(x, dx);
+}
+
+/*
+ *  da + db -> dx
+ */
+
+int bigadd(da, db, dx)
+dptr da, db;
+dptr dx;
+{
+   tended struct b_bignum *a, *b;
+   struct b_bignum *x;
+   word alen, blen;
+   word c;
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      a = LrgInt(da);
+      b = LrgInt(db);
+      if (a->sign == b->sign) {
+         if (alen > blen) {
+            Protect(x = alcbignum(alen + 1), return Error);
+            c = add1(DIG(a,alen-blen),
+                     DIG(b,0),
+                     DIG(x,alen-blen+1),
+                     blen);
+            *DIG(x,0) =
+                addi1(DIG(a,0),
+                      c,
+                      DIG(x,1),
+                      alen-blen);
+            }
+         else if (alen == blen) {
+            Protect(x = alcbignum(alen + 1), return Error);
+            *DIG(x,0) =
+               add1(DIG(a,0),
+                    DIG(b,0),
+                    DIG(x,1),
+                    alen);
+            }
+         else {
+            Protect(x = alcbignum(blen + 1), return Error);
+            c = add1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen+1),
+                     alen);
+            *DIG(x,0) =
+               addi1(DIG(b,0),
+                     c,
+                     DIG(x,1),
+                     blen-alen);
+            }
+         x->sign = a->sign;
+         }
+      else {
+         if (alen > blen) {
+            Protect(x = alcbignum(alen), return Error);
+            c = sub1(DIG(a,alen-blen),
+                     DIG(b,0),
+                     DIG(x,alen-blen),
+                     blen);
+            subi1(DIG(a,0),
+                  -c,
+                  DIG(x,0),
+                  alen-blen);
+            x->sign = a->sign;
+            }
+         else if (alen == blen) {
+            Protect(x = alcbignum(alen), return Error);
+            if (cmp1(DIG(a,0),
+                     DIG(b,0),
+                     alen) > 0) {
+               (void)sub1(DIG(a,0),
+                          DIG(b,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = a->sign;
+               }
+            else {
+               (void)sub1(DIG(b,0),
+                          DIG(a,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = b->sign;
+               }
+            }
+         else {
+            Protect(x = alcbignum(blen), return Error);
+            c = sub1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen),
+                     alen);
+            subi1(DIG(b,0),
+                  -c,
+                  DIG(x,0),
+                  blen-alen);
+            x->sign = b->sign;
+            }
+         }
+      return mkdesc(x, dx);
+      }
+   else if (Type(*da) == T_Lrgint)    /* bignum + integer */
+      return bigaddi(da, IntVal(*db), dx);
+   else if (Type(*db) == T_Lrgint)    /* integer + bignum */
+      return bigaddi(db, IntVal(*da), dx);
+   else {                             /* integer + integer */
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      return bigaddi(&td, IntVal(*db), dx);
+      }
+}
+
+/*
+ *  da - db -> dx
+ */
+
+int bigsub(da, db, dx)
+dptr da, db, dx;
+{
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+   tended struct b_bignum *a, *b;
+   struct b_bignum *x;
+   word alen, blen;
+   word c;
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      a = LrgInt(da);
+      b = LrgInt(db);
+      if (a->sign != b->sign) {
+         if (alen > blen) {
+            Protect(x = alcbignum(alen + 1), return Error);
+            c = add1(DIG(a,alen-blen),
+                     DIG(b,0),
+                     DIG(x,alen-blen+1),
+                     blen);
+            *DIG(x,0) =
+               addi1(DIG(a,0),
+                     c,
+                     DIG(x,1),
+                     alen-blen);
+            }
+         else if (alen == blen) {
+            Protect(x = alcbignum(alen + 1), return Error);
+            *DIG(x,0) =
+               add1(DIG(a,0),
+                    DIG(b,0),
+                    DIG(x,1),
+                    alen);
+            }
+         else {
+            Protect(x = alcbignum(blen + 1), return Error);
+            c = add1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen+1),
+                     alen);
+            *DIG(x,0) =
+               addi1(DIG(b,0),
+                     c,
+                     DIG(x,1),
+                     blen-alen);
+            }
+         x->sign = a->sign;
+         }
+      else {
+         if (alen > blen) {
+            Protect(x = alcbignum(alen), return Error);
+            c = sub1(DIG(a,alen-blen),
+                     DIG(b,0),
+                     DIG(x,alen-blen),
+                     blen);
+            subi1(DIG(a,0),
+                  -c,
+                  DIG(x,0),
+                  alen-blen);
+            x->sign = a->sign;
+            }
+         else if (alen == blen) {
+            Protect(x = alcbignum(alen), return Error);
+            if (cmp1(DIG(a,0),
+                     DIG(b,0),
+                     alen) > 0) {
+               (void)sub1(DIG(a,0),
+                          DIG(b,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = a->sign;
+               }
+            else {
+               (void)sub1(DIG(b,0),
+                          DIG(a,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = 1 ^ b->sign;
+               }
+            }
+         else {
+            Protect(x = alcbignum(blen), return Error);
+            c = sub1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen),
+                     alen);
+            subi1(DIG(b,0),
+                      -c,
+                      DIG(x,0),
+                      blen-alen);
+            x->sign = 1 ^ b->sign;
+            }
+         }
+      return mkdesc(x, dx);
+      }
+   else if (Type(*da) == T_Lrgint)     /* bignum - integer */
+      return bigsubi(da, IntVal(*db), dx);
+   else if (Type(*db) == T_Lrgint) {   /* integer - bignum */
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(&td));
+      blen = LEN(LrgInt(db));
+      a = LrgInt(&td);
+      b = LrgInt(db);
+      if (a->sign != b->sign) {
+         if (alen == blen) {
+            Protect(x = alcbignum(alen + 1), return Error);
+            *DIG(x,0) =
+               add1(DIG(a,0),
+                    DIG(b,0),
+                    DIG(x,1),
+                    alen);
+            }
+         else {
+            Protect(x = alcbignum(blen + 1), return Error);
+            c = add1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen+1),
+                     alen);
+            *DIG(x,0) =
+               addi1(DIG(b,0),
+                     c,
+                     DIG(x,1),
+                     blen-alen);
+            }
+         x->sign = a->sign;
+         }
+      else {
+         if (alen == blen) {
+            Protect(x = alcbignum(alen), return Error);
+            if (cmp1(DIG(a,0),
+                     DIG(b,0),
+                     alen) > 0) {
+               (void)sub1(DIG(a,0),
+                          DIG(b,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = a->sign;
+               }
+            else {
+               (void)sub1(DIG(b,0),
+                          DIG(a,0),
+                          DIG(x,0),
+                          alen);
+               x->sign = 1 ^ b->sign;
+               }
+            }
+         else {
+            Protect(x = alcbignum(blen), return Error);
+            c = sub1(DIG(b,blen-alen),
+                     DIG(a,0),
+                     DIG(x,blen-alen),
+                     alen);
+            subi1(DIG(b,0),
+                  -c,
+                  DIG(x,0),
+                  blen-alen);
+            x->sign = 1 ^ b->sign;
+            }
+         }
+      return mkdesc(x, dx);
+      }
+   else {                              /* integer - integer */
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      return bigsubi(&td, IntVal(*db), dx);
+      }
+
+}
+
+/*
+ *  da * db -> dx
+ */
+
+int bigmul(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b;
+   struct b_bignum *x;
+   word alen, blen;
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(alen + blen), return Error);
+      mul1(DIG(a,0),
+           DIG(b,0),
+           DIG(x,0),
+           alen, blen);
+      x->sign = a->sign ^ b->sign;
+      return mkdesc(x, dx);
+      }
+   else if (Type(*da) == T_Lrgint)    /* bignum * integer */
+      return bigmuli(da, IntVal(*db), dx);
+   else if (Type(*db) == T_Lrgint)    /* integer * bignum */
+      return bigmuli(db, IntVal(*da), dx);
+   else {                             /* integer * integer */
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      return bigmuli(&td, IntVal(*db), dx);
+      }
+}
+
+/*
+ *  da / db -> dx
+ */
+
+int bigdiv(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b, *x, *tu, *tv;
+   word alen, blen;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   /* Put *da into large integer format. */
+   if (Type(*da) != T_Lrgint) {
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      da = &td;
+      }
+
+   if (Type(*db) == T_Lrgint) {         /* bignum / bignum */
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      if (alen < blen) {
+         MakeInt(0, dx);
+         return Succeeded;
+         }
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(alen - blen + 1), return Error);
+      if (blen == 1)
+         divi1(DIG(a,0),
+               (word)*DIG(b,0),
+               DIG(x,0),
+               alen);
+      else {
+         Protect(tu = alcbignum(alen + 1), return Error);
+         Protect(tv = alcbignum(blen), return Error);
+         if (div1(DIG(a,0),
+                  DIG(b,0),
+                  DIG(x,0),
+                  NULL, alen-blen, blen, tu, tv) == Error)
+            return Error;
+            }
+      x->sign = a->sign ^ b->sign;
+      return mkdesc(x, dx);
+      }
+   else                                 /* bignum / integer */
+      return bigdivi(da, IntVal(*db), dx);
+}
+
+/*
+ *  da % db -> dx
+ */
+
+int bigmod(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b, *x, *temp, *tu, *tv;
+   word alen, blen;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   /* Put *da into large integer format. */
+   if (Type(*da) != T_Lrgint) {
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      da = &td;
+      }
+
+   if (Type(*db) == T_Lrgint) {        /* bignum % bignum */
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      if (alen < blen) {
+         cpbignum(da, dx);
+         return Succeeded;
+         }
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(blen), return Error);
+      if (blen == 1) {
+	 Protect(temp = alcbignum(alen), return Error);
+         *DIG(x,0) =
+            divi1(DIG(a,0),
+                  (word)*DIG(b,0),
+                  DIG(temp,0),
+                  alen);
+         }
+      else {
+         Protect(tu = alcbignum(alen + 1), return Error);
+         Protect(tv = alcbignum(blen), return Error);
+         if (div1(DIG(a,0),
+                  DIG(b,0),
+                  NULL,
+                  DIG(x,0),
+                  alen-blen, blen, tu, tv) == Error)
+            return Error;
+            }
+      x->sign = a->sign;
+      return mkdesc(x, dx);
+      }
+   else				       /* bignum % integer */
+      return bigmodi(da, IntVal(*db), dx);
+}
+
+/*
+ *  -i -> dx
+ */
+
+int bigneg(da, dx)
+dptr da, dx;
+{
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+   int cpstat;
+
+   /* Put *da into large integer format. */
+   if (Type(*da) != T_Lrgint) {
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      da = &td;
+      }
+   LrgInt(da)->sign ^= 1;       /* Temporarily change the sign */
+   cpstat = cpbignum(da, dx);
+   LrgInt(da)->sign ^= 1;       /* Change it back */
+
+   return cpstat;
+}
+
+/*
+ *  da ^ db -> dx
+ */
+
+int bigpow(da, db, dx)
+dptr da, db, dx;
+{
+
+   if (Type(*db) == T_Lrgint) {
+      struct b_bignum *b;
+
+      b = LrgInt ( db );
+
+
+      if (Type(*da) == T_Lrgint) {
+	 if ( b->sign ) {
+	    /* bignum ^ -bignum = 0 */
+	    MakeInt ( 0, dx );
+	    return Succeeded;
+	    }
+	 else
+	    /* bignum ^ +bignum = guaranteed overflow */
+	    ReturnErrNum(307, Error);
+	 }
+      else if ( b->sign )
+	 /* integer ^ -bignum */
+	 switch ( IntVal ( *da ) ) {
+	    case 1:
+	       MakeInt ( 1, dx );
+	       return Succeeded;
+	    case -1:
+	       /* Result is +1 / -1, depending on whether *b is even or odd. */
+	       if ( ( b->digits[ b->lsd ] ) & 01 )
+		  MakeInt ( -1, dx );
+	       else
+		  MakeInt ( 1, dx );
+	       return Succeeded;
+	    case 0:
+	       ReturnErrNum(204,Error);
+	    default:
+	       /* da ^ (negative int) = 0 for all non-special cases */
+	       MakeInt(0, dx);
+	       return Succeeded;
+	    }
+      else {
+	 /* integer ^ +bignum */
+	 word n, blen;
+	 register DIGIT nth_dig, mask;
+
+	 b = LrgInt ( db );
+	 blen = LEN ( b );
+
+	 /* We scan the bits of b from the most to least significant.
+	  * The bit position in b is represented by the pair ( n, mask )
+	  * where n is the DIGIT number (0 = most sig.) and mask is the
+	  * the bit mask for the current bit.
+	  *
+	  * For each bit (most sig to least) in b,
+	  *  for each zero, square the partial result;
+	  *  for each one, square it and multiply it by a */
+	 MakeInt ( 1, dx );
+	 for ( n = 0; n < blen; ++n ) {
+	    nth_dig = *DIG ( b, n );
+	    for ( mask = 1 << ( NB - 1 ); mask; mask >>= 1 ) {
+	       if ( bigmul ( dx, dx, dx ) == Error )
+		  return Error;
+	       if ( nth_dig & mask )
+		  if ( bigmul ( dx, da, dx ) == Error )
+		     return Error;
+	       }
+	    }
+	 }
+      return Succeeded;
+      }
+   else if (Type(*da) == T_Lrgint)    /* bignum ^ integer */
+      return bigpowi(da, IntVal(*db), dx);
+   else                               /* integer ^ integer */
+      return bigpowii(IntVal(*da), IntVal(*db), dx);
+}
+
+int bigpowri( a, db, drslt )
+double a;
+dptr   db, drslt;
+{
+   register double retval;
+   register word n;
+   register DIGIT nth_dig, mask;
+   struct b_bignum *b;
+   word blen;
+
+   b = LrgInt ( db );
+   blen = LEN ( b );
+   if ( b->sign ) {
+      if ( a == 0.0 )
+	 ReturnErrNum(204, Error);
+      else
+	 a = 1.0 / a;
+      }
+
+   /* We scan the bits of b from the most to least significant.
+    * The bit position in b is represented by the pair ( n, mask )
+    * where n is the DIGIT number (0 = most sig.) and mask is the
+    * the bit mask for the current bit.
+    *
+    * For each bit (most sig to least) in b,
+    *  for each zero, square the partial result;
+    *  for each one, square it and multiply it by a */
+   retval = 1.0;
+   for ( n = 0; n < blen; ++n ) {
+      nth_dig = *DIG ( b, n );
+      for ( mask = 1 << ( NB - 1 ); mask; mask >>= 1 ) {
+	 retval *= retval;
+	 if ( nth_dig & mask )
+	    retval *= a;
+	 }
+      }
+
+   Protect(BlkLoc(*drslt) = (union block *)alcreal(retval), return Error);
+   drslt->dword = D_Real;
+   return Succeeded;
+}
+
+/*
+ *  iand(da, db) -> dx
+ */
+
+int bigand(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b, *x, *tad, *tbd;
+   word alen, blen, xlen;
+   word i;
+   DIGIT *ad, *bd;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(xlen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] & bd[i];
+
+      if (a->sign & b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*da) == T_Lrgint) {   /* iand(bignum,integer) */
+      itobig(IntVal(*db), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(&td));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(&td);
+      Protect(x = alcbignum(alen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] & bd[i];
+
+      if (a->sign & b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*db) == T_Lrgint) {   /* iand(integer,bignum) */
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(&td));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(&td);
+      b = LrgInt(db);
+      Protect(x = alcbignum(blen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] & bd[i];
+
+      if (a->sign & b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   /* not called for iand(integer,integer) */
+
+   return mkdesc(x, dx);
+}
+
+/*
+ *  ior(da, db) -> dx
+ */
+
+int bigor(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b, *x, *tad, *tbd;
+   word alen, blen, xlen;
+   word i;
+   DIGIT *ad, *bd;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(xlen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] | bd[i];
+
+      if (a->sign | b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*da) == T_Lrgint) {   /* ior(bignum,integer) */
+      itobig(IntVal(*db), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(&td));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(&td);
+      Protect(x = alcbignum(alen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] | bd[i];
+
+      if (a->sign | b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*db) == T_Lrgint) {   /* ior(integer,bignym) */
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(&td));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(&td);
+      b = LrgInt(db);
+      Protect(x = alcbignum(blen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] | bd[i];
+
+      if (a->sign | b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   /* not called for ior(integer,integer) */
+
+   return mkdesc(x, dx);
+}
+
+/*
+ *  xor(da, db) -> dx
+ */
+
+int bigxor(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *b, *x, *tad, *tbd;
+   word alen, blen, xlen;
+   word i;
+   DIGIT *ad, *bd;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(db);
+      Protect(x = alcbignum(xlen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] ^ bd[i];
+
+      if (a->sign ^ b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*da) == T_Lrgint) {   /* ixor(bignum,integer) */
+      itobig(IntVal(*db), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(da));
+      blen = LEN(LrgInt(&td));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(da);
+      b = LrgInt(&td);
+      Protect(x = alcbignum(alen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] ^ bd[i];
+
+      if (a->sign ^ b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   else if (Type(*db) == T_Lrgint) {   /* ixor(integer,bignum) */
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      alen = LEN(LrgInt(&td));
+      blen = LEN(LrgInt(db));
+      xlen = alen > blen ? alen : blen;
+      a = LrgInt(&td);
+      b = LrgInt(db);
+      Protect(x = alcbignum(blen), return Error);
+
+      if (alen == xlen && !a->sign)
+         ad = DIG(a,0);
+      else {
+         Protect(tad = alcbignum(xlen), return Error);
+         ad = DIG(tad,0);
+         bdzero(ad, xlen - alen);
+         bdcopy(DIG(a,0),
+                &ad[xlen-alen], alen);
+         if (a->sign)
+	    compl1(ad, ad, xlen);
+         }
+
+      if (blen == xlen && !b->sign)
+         bd = DIG(b,0);
+      else {
+         Protect(tbd = alcbignum(xlen), return Error);
+         bd = DIG(tbd,0);
+         bdzero(bd, xlen - blen);
+         bdcopy(DIG(b,0),
+                &bd[xlen-blen], blen);
+         if (b->sign)
+	    compl1(bd, bd, xlen);
+         }
+
+      for (i = 0; i < xlen; i++)
+         *DIG(x,i) =
+            ad[i] ^ bd[i];
+
+      if (a->sign ^ b->sign) {
+         x->sign = 1;
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      }
+   /* not called for ixor(integer,integer) */
+
+   return mkdesc(x, dx);
+}
+
+/*
+ *  bigshift(da, db) -> dx
+ */
+
+int bigshift(da, db, dx)
+dptr da, db, dx;
+{
+   tended struct b_bignum *a, *x, *tad;
+   word alen;
+   word r = IntVal(*db) % NB;
+   word q = (r >= 0 ? IntVal(*db) : (IntVal(*db) - (r += NB))) / NB;
+   word xlen;
+   DIGIT *ad;
+   struct descrip td;
+   char tdigits[INTBIGBLK];
+
+   if (Type(*da) == T_Integer) {
+      itobig(IntVal(*da), (struct b_bignum *)tdigits, &td);
+      da = &td;
+      }
+
+   alen = LEN(LrgInt(da));
+   xlen = alen + q + 1;
+   if (xlen <= 0) {
+      MakeInt(-LrgInt(da)->sign, dx);
+      return Succeeded;
+      }
+   else {
+      a = LrgInt(da);
+      Protect(x = alcbignum(xlen), return Error);
+
+      if (a->sign) {
+         Protect(tad = alcbignum(alen), return Error);
+         ad = DIG(tad,0);
+         bdcopy(DIG(a,0),
+                ad, alen);
+         compl1(ad, ad, alen);
+         }
+      else
+         ad = DIG(a,0);
+
+      if (q >= 0) {
+         *DIG(x,0) =
+            shifti1(ad, r, (DIGIT)0,
+                    DIG(x,1),
+                    alen);
+         bdzero(DIG(x,alen+1),
+                q);
+         }
+      else
+         *DIG(x,0) =
+            shifti1(ad, r, ad[alen+q] >> (NB-r),
+                    DIG(x,1), alen+q);
+
+      if (a->sign) {
+         x->sign = 1;
+         *DIG(x,0) |=
+            B - (1 << r);
+         compl1(DIG(x,0),
+                DIG(x,0),
+                xlen);
+         }
+      return mkdesc(x, dx);
+      }
+   }
+
+/*
+ *  negative if da < db
+ *  zero if da == db
+ *  positive if da > db
+ */
+
+word bigcmp(da, db)
+dptr da, db;
+{
+   struct b_bignum *a = LrgInt(da);
+   struct b_bignum *b = LrgInt(db);
+   word alen, blen;
+
+   if (Type(*da) == T_Lrgint && Type(*db) == T_Lrgint) {
+      if (a->sign != b->sign)
+         return (b->sign - a->sign);
+      alen = LEN(a);
+      blen = LEN(b);
+      if (alen != blen)
+         return (a->sign ? blen - alen : alen - blen);
+
+      if (a->sign)
+         return cmp1(DIG(b,0),
+                     DIG(a,0),
+                     alen);
+      else
+         return cmp1(DIG(a,0),
+                     DIG(b,0),
+                     alen);
+      }
+   else if (Type(*da) == T_Lrgint)    /* cmp(bignum, integer) */
+      return bigcmpi(da, IntVal(*db));
+   else                               /* cmp(integer, bignum) */
+      return -bigcmpi(db, IntVal(*da));
+}
+
+/*
+ *  ?da -> dx
+ */
+
+int bigrand(da, dx)
+dptr da, dx;
+{
+   tended struct b_bignum *x, *a, *td, *tu, *tv;
+   word alen = LEN(LrgInt(da));
+   DIGIT *d;
+   word i;
+   double rval;
+
+   Protect(x = alcbignum(alen), return Error);
+   Protect(td = alcbignum(alen + 1), return Error);
+   d = DIG(td,0);
+   a = LrgInt(da);
+
+   for (i = alen; i >= 0; i--) {
+      rval = RandVal;
+      d[i] = rval * B;
+      }
+
+   Protect(tu = alcbignum(alen + 2), return Error);
+   Protect(tv = alcbignum(alen), return Error);
+   if (div1(d, DIG(a,0),
+            NULL,
+            DIG(x,0),
+            (word)1, alen, tu, tv) == Error)
+      return Error;
+   addi1(DIG(x,0),
+         (word)1,
+         DIG(x,0),
+         alen);
+   return mkdesc(x, dx);
+}
+
+/*
+ *  da + i -> dx
+ */
+
+static int bigaddi(da, i, dx)
+dptr da, dx;
+word i;
+{
+   tended struct b_bignum *a;
+   struct b_bignum *x;
+   word alen;
+
+   if (i < 0 && i > MinLong)
+      return bigsubi(da, -i, dx);
+   else if (i < 0 || i >= B ) {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigadd(da, &td, dx);
+      }
+   else {
+      alen = LEN(LrgInt(da));
+      a = LrgInt(da);
+      if (a->sign) {
+	 Protect(x = alcbignum(alen), return Error);
+         subi1(DIG(a,0),
+               i,
+               DIG(x,0),
+               alen);
+         }
+      else {
+         Protect(x = alcbignum(alen + 1), return Error);
+         *DIG(x,0) =
+            addi1(DIG(a,0),
+                  i,
+                  DIG(x,1),
+                  alen);
+         }
+      x->sign = a->sign;
+      return mkdesc(x, dx);
+      }
+}
+
+/*
+ *  da - i -> dx
+ */
+
+static int bigsubi(da, i, dx)
+dptr da, dx;
+word i;
+{
+   tended struct b_bignum *a;
+   struct b_bignum *x;
+   word alen;
+
+   if (i < 0 && i > MinLong)
+      return bigaddi(da, -i, dx);
+   else if (i < 0 || i >= B) {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigsub(da, &td, dx);
+      }
+   else {
+      alen = LEN(LrgInt(da));
+      a = LrgInt(da);
+      if (a->sign) {
+         Protect(x = alcbignum(alen + 1), return Error);
+         *DIG(x,0) =
+            addi1(DIG(a,0),
+                  i,
+                  DIG(x,1),
+                  alen);
+         }
+      else {
+         Protect(x = alcbignum(alen), return Error);
+         subi1(DIG(a,0),
+               i,
+               DIG(x,0),
+               alen);
+         }
+      x->sign = a->sign;
+      return mkdesc(x, dx);
+      }
+}
+
+/*
+ *  da * i -> dx
+ */
+
+static int bigmuli(da, i, dx)
+dptr da, dx;
+word i;
+{
+   tended struct b_bignum *a;
+   struct b_bignum *x;
+   word alen;
+
+   if (i <= -B || i >= B) {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigmul(da, &td, dx);
+      }
+   else {
+      alen = LEN(LrgInt(da));
+      a = LrgInt(da);
+      Protect(x = alcbignum(alen + 1), return Error);
+      if (i >= 0)
+         x->sign = a->sign;
+      else {
+         x->sign = 1 ^ a->sign;
+         i = -i;
+         }
+      *DIG(x,0) =
+         muli1(DIG(a,0),
+               i, 0,
+               DIG(x,1),
+               alen);
+      return mkdesc(x, dx);
+      }
+}
+
+/*
+ *  da / i -> dx
+ */
+
+static int bigdivi(da, i, dx)
+dptr da, dx;
+word i;
+{
+   tended struct b_bignum *a;
+   struct b_bignum *x;
+   word alen;
+
+   if (i <= -B || i >= B) {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigdiv(da, &td, dx);
+      }
+   else {
+      alen = LEN(LrgInt(da));
+      a = LrgInt(da);
+      Protect(x = alcbignum(alen), return Error);
+      if (i >= 0)
+         x->sign = a->sign;
+      else {
+         x->sign = 1 ^ a->sign;
+         i = -i;
+         }
+      divi1(DIG(a,0),
+            i,
+            DIG(x,0),
+            alen);
+      return mkdesc(x, dx);
+      }
+}
+
+/*
+ *  da % i -> dx
+ */
+
+static int bigmodi(da, i, dx)
+dptr da, dx;
+word i;
+{
+   tended struct b_bignum *a, *temp;
+   word alen;
+   word x;
+
+   if (i <= -B || i >= B) {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigmod(da, &td, dx);
+      }
+   else {
+      alen = LEN(LrgInt(da));
+      a = LrgInt(da);
+      temp = a;			/* avoid trash pointer */
+      Protect(temp = alcbignum(alen), return Error);
+      x = divi1(DIG(a,0),
+                Abs(i),
+                DIG(temp,0),
+                alen);
+      if (a->sign)
+	 x = -x;
+      MakeInt(x, dx);
+      return Succeeded;
+      }
+}
+
+/*
+ *  da ^ i -> dx
+ */
+
+static int bigpowi(da, i, dx)
+dptr da, dx;
+word i;
+{
+   int n = WordBits;
+
+   if (i > 0) {
+      /* scan bits left to right.  skip leading 1. */
+      while (--n >= 0)
+         if (i & ((word)1 << n))
+	    break;
+      /* then, for each zero, square the partial result;
+         for each one, square it and multiply it by a */
+      *dx = *da;
+      while (--n >= 0) {
+         if (bigmul(dx, dx, dx) == Error)
+	    return Error;
+         if (i & ((word)1 << n))
+            if (bigmul(dx, da, dx) == Error)
+	       return Error;
+         }
+      }
+   else if (i == 0) {
+      MakeInt(1, dx);
+      }
+   else {
+      MakeInt(0, dx);
+      }
+   return Succeeded;
+}
+
+/*
+ *  a ^ i -> dx
+ */
+
+static int bigpowii(a, i, dx)
+word a, i;
+dptr dx;
+{
+   word x, y;
+   int n = WordBits;
+   int isbig = 0;
+
+   if (a == 0 || i <= 0) {              /* special cases */
+      if (a == 0 && i <= 0)             /* 0 ^ negative -> error */
+         ReturnErrNum(204,Error);
+      if (i == 0) {
+         MakeInt(1, dx);
+         return Succeeded;
+         }
+      if (a == -1) {                    /* -1 ^ [odd,even] -> [-1,+1] */
+         if (!(i & 1))
+	    a = 1;
+         }
+      else if (a != 1) {                /* 1 ^ any -> 1 */
+         a = 0;
+         }                   /* others ^ negative -> 0 */
+      MakeInt(a, dx);
+      }
+   else {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      /* scan bits left to right.  skip leading 1. */
+      while (--n >= 0)
+         if (i & ((word)1 << n))
+	    break;
+      /* then, for each zero, square the partial result;
+         for each one, square it and multiply it by a */
+      x = a;
+      while (--n >= 0) {
+         if (isbig) {
+            if (bigmul(dx, dx, dx) == Error)
+	       return Error;
+	    }
+         else {
+            y = mul(x, x);
+            if (!over_flow)
+               x = y;
+            else {
+               itobig(x, (struct b_bignum *)tdigits, &td);
+               if (bigmul(&td, &td, dx) == Error)
+	          return Error;
+               isbig = (Type(*dx) == T_Lrgint);
+               }
+            }
+         if (i & ((word)1 << n)) {
+            if (isbig) {
+               if (bigmuli(dx, a, dx) == Error)
+		  return Error;
+	       }
+            else {
+               y = mul(x, a);
+               if (!over_flow)
+                  x = y;
+               else {
+                  itobig(x, (struct b_bignum *)tdigits, &td);
+                  if (bigmuli(&td, a, dx) == Error)
+		  return Error;
+                  isbig = (Type(*dx) == T_Lrgint);
+                  }
+               }
+            }
+         }
+      if (!isbig) {
+	 MakeInt(x, dx);
+	 }
+      }
+   return Succeeded;
+}
+
+/*
+ *  negative if da < i
+ *  zero if da == i
+ *  positive if da > i
+ */
+
+static word bigcmpi(da, i)
+dptr da;
+word i;
+{
+   struct b_bignum *a = LrgInt(da);
+   word alen = LEN(a);
+
+   if (i > -B && i < B) {
+      if (i >= 0)
+         if (a->sign)
+	    return -1;
+         else
+	    return cmpi1(DIG(a,0),
+	                 i, alen);
+      else
+         if (a->sign)
+	    return -cmpi1(DIG(a,0),
+	                  -i, alen);
+         else
+	    return 1;
+      }
+   else {
+      struct descrip td;
+      char tdigits[INTBIGBLK];
+
+      itobig(i, (struct b_bignum *)tdigits, &td);
+      return bigcmp(da, &td);
+      }
+}
+
+
+/* These are all straight out of Knuth vol. 2, Sec. 4.3.1. */
+
+/*
+ *  (u,n) + (v,n) -> (w,n)
+ *
+ *  returns carry, 0 or 1
+ */
+
+static DIGIT add1(u, v, w, n)
+DIGIT *u, *v, *w;
+word n;
+{
+   uword dig, carry;
+   word i;
+
+   carry = 0;
+   for (i = n; --i >= 0; ) {
+      dig = (uword)u[i] + v[i] + carry;
+      w[i] = lo(dig);
+      carry = hi(dig);
+      }
+   return carry;
+}
+
+/*
+ *  (u,n) - (v,n) -> (w,n)
+ *
+ *  returns carry, 0 or -1
+ */
+
+static word sub1(u, v, w, n)
+DIGIT *u, *v, *w;
+word n;
+{
+   uword dig, carry;
+   word i;
+
+   carry = 0;
+   for (i = n; --i >= 0; ) {
+      dig = (uword)u[i] - v[i] + carry;
+      w[i] = lo(dig);
+      carry = signed_hi(dig);
+      }
+   return carry;
+}
+
+/*
+ *  (u,n) * (v,m) -> (w,m+n)
+ */
+
+static void mul1(u, v, w, n, m)
+DIGIT *u, *v, *w;
+word n, m;
+{
+   word i, j;
+   uword dig, carry;
+
+   bdzero(&w[m], n);
+
+   for (j = m; --j >= 0; ) {
+      carry = 0;
+      for (i = n; --i >= 0; ) {
+         dig = (uword)u[i] * v[j] + w[i+j+1] + carry;
+         w[i+j+1] = lo(dig);
+         carry = hi(dig);
+         }
+      w[j] = carry;
+      }
+}
+
+/*
+ *  (a,m+n) / (b,n) -> (q,m+1) (r,n)
+ *
+ *  if q or r is NULL, the quotient or remainder is discarded
+ */
+
+static int div1(a, b, q, r, m, n, tu, tv)
+DIGIT *a, *b, *q, *r;
+word m, n;
+struct b_bignum *tu, *tv;
+{
+   uword qhat, rhat;
+   uword dig, carry;
+   DIGIT *u, *v;
+   word d;
+   word i, j;
+
+   u = DIG(tu,0);
+   v = DIG(tv,0);
+
+   /* D1 */
+   for (d = 0; d < NB; d++)
+      if (b[0] & (1 << (NB - 1 - d)))
+         break;
+
+   u[0] = shifti1(a, d, (DIGIT)0, &u[1], m+n);
+   shifti1(b, d, (DIGIT)0, v, n);
+
+   /* D2, D7 */
+   for (j = 0; j <= m; j++) {
+      /* D3 */
+      if (u[j] == v[0]) {
+         qhat = B - 1;
+         rhat = (uword)v[0] + u[j+1];
+         }
+      else {
+         uword numerator = dbl(u[j], u[j+1]);
+         qhat = numerator / (uword)v[0];
+         rhat = numerator % (uword)v[0];
+         }
+
+      while (rhat < (uword)B && qhat * (uword)v[1] > (uword)dbl(rhat, u[j+2])) {
+         qhat -= 1;
+         rhat += v[0];
+         }
+
+      /* D4 */
+      carry = 0;
+      for (i = n; i > 0; i--) {
+         dig = u[i+j] - v[i-1] * qhat + carry;       /* -BSQ+B .. B-1 */
+         u[i+j] = lo(dig);
+         if ((uword)dig < (uword)B)
+            carry = hi(dig);
+         else carry = hi(dig) | -B;
+         }
+      carry = (word)(carry + u[j]) < 0;
+
+      /* D5 */
+      if (q)
+	 q[j] = qhat;
+
+      /* D6 */
+      if (carry) {
+         if (q)
+	    q[j] -= 1;
+         carry = 0;
+         for (i = n; i > 0; i--) {
+            dig = (uword)u[i+j] + v[i-1] + carry;
+            u[i+j] = lo(dig);
+            carry = hi(dig);
+            }
+         }
+      }
+
+   if (r) {
+      if (d == 0)
+         shifti1(&u[m+1], (word)d, (DIGIT)0, r, n);
+      else
+         r[0] = shifti1(&u[m+1], (word)(NB - d), u[m+n]>>d, &r[1], n - 1);
+      }
+   return Succeeded;
+}
+
+/*
+ *  - (u,n) -> (w,n)
+ *
+ */
+
+static void compl1(u, w, n)
+DIGIT *u, *w;
+word n;
+{
+   uword dig, carry = 0;
+   word i;
+
+   for (i = n; --i >= 0; ) {
+      dig = carry - u[i];
+      w[i] = lo(dig);
+      carry = signed_hi(dig);
+      }
+}
+
+/*
+ *  (u,n) : (v,n)
+ */
+
+static word cmp1(u, v, n)
+DIGIT *u, *v;
+word n;
+{
+   word i;
+
+   for (i = 0; i < n; i++)
+      if (u[i] != v[i])
+         return u[i] > v[i] ? 1 : -1;
+   return 0;
+}
+
+/*
+ *  (u,n) + k -> (w,n)
+ *
+ *  k in 0 .. B-1
+ *  returns carry, 0 or 1
+ */
+
+static DIGIT addi1(u, k, w, n)
+DIGIT *u, *w;
+word k;
+word n;
+{
+   uword dig, carry;
+   word i;
+
+   carry = k;
+   for (i = n; --i >= 0; ) {
+      dig = (uword)u[i] + carry;
+      w[i] = lo(dig);
+      carry = hi(dig);
+      }
+   return carry;
+}
+
+/*
+ *  (u,n) - k -> (w,n)
+ *
+ *  k in 0 .. B-1
+ *  u must be greater than k
+ */
+
+static void subi1(u, k, w, n)
+DIGIT *u, *w;
+word k;
+word n;
+{
+   uword dig, carry;
+   word i;
+
+   carry = -k;
+   for (i = n; --i >= 0; ) {
+      dig = (uword)u[i] + carry;
+      w[i] = lo(dig);
+      carry = signed_hi(dig);
+      }
+}
+
+/*
+ *  (u,n) * k + c -> (w,n)
+ *
+ *  k in 0 .. B-1
+ *  returns carry, 0 .. B-1
+ */
+
+static DIGIT muli1(u, k, c, w, n)
+DIGIT *u, *w;
+word k;
+int c;
+word n;
+{
+   uword dig, carry;
+   word i;
+
+   carry = c;
+   for (i = n; --i >= 0; ) {
+      dig = (uword)k * u[i] + carry;
+      w[i] = lo(dig);
+      carry = hi(dig);
+      }
+   return carry;
+}
+
+/*
+ *  (u,n) / k -> (w,n)
+ *
+ *  k in 0 .. B-1
+ *  returns remainder, 0 .. B-1
+ */
+
+static DIGIT divi1(u, k, w, n)
+DIGIT *u, *w;
+word k;
+word n;
+{
+   uword dig, remain;
+   word i;
+
+   remain = 0;
+   for (i = 0; i < n; i++) {
+      dig = dbl(remain, u[i]);
+      w[i] = dig / k;
+      remain = dig % k;
+      }
+   return remain;
+}
+
+/*
+ *  ((u,n) << k) + c -> (w,n)
+ *
+ *  k in 0 .. NB-1
+ *  c in 0 .. B-1
+ *  returns carry, 0 .. B-1
+ */
+
+static DIGIT shifti1(u, k, c, w, n)
+DIGIT *u, c, *w;
+word k;
+word n;
+{
+   uword dig;
+   word i;
+
+   if (k == 0) {
+      bdcopy(u, w, n);
+      return 0;
+      }
+
+   for (i = n; --i >= 0; ) {
+      dig = ((uword)u[i] << k) + c;
+      w[i] = lo(dig);
+      c = hi(dig);
+      }
+   return c;
+}
+
+/*
+ *  (u,n) : k
+ *
+ *  k in 0 .. B-1
+ */
+
+static word cmpi1(u, k, n)
+DIGIT *u;
+word k;
+word n;
+{
+   word i;
+
+   for (i = 0; i < n-1; i++)
+      if (u[i])
+	 return 1;
+   if (u[n - 1] == (DIGIT)k)
+      return 0;
+   return u[n - 1] > (DIGIT)k ? 1 : -1;
+}
+
+#endif					/* LargeInts */
diff --git a/src/runtime/rmemmgt.r b/src/runtime/rmemmgt.r
new file mode 100644
index 0000000..4a9daa2
--- /dev/null
+++ b/src/runtime/rmemmgt.r
@@ -0,0 +1,1459 @@
+/*
+ * File: rmemmgt.r
+ *  Contents: block description arrays, memory initialization,
+ *   garbage collection, dump routines
+ */
+
+/*
+ * Prototypes
+ */
+static void postqual		(dptr dp);
+static void markblock	(dptr dp);
+static void markptr		(union block **ptr);
+static void sweep		(struct b_coexpr *ce);
+static void sweep_stk	(struct b_coexpr *ce);
+static void reclaim		(void);
+static void cofree		(void);
+static void scollect		(word extra);
+static int     qlcmp		(dptr  *q1,dptr  *q2);
+static void adjust		(char *source, char *dest);
+static void compact		(char *source);
+static void mvc		(uword n, char *src, char *dest);
+
+#ifdef MultiThread
+static void markprogram	(struct progstate *pstate);
+#endif					/*MultiThread*/
+
+/*
+ * Variables
+ */
+
+#ifndef MultiThread
+word coll_stat = 0;             /* collections in static region */
+word coll_str = 0;              /* collections in string region */
+word coll_blk = 0;              /* collections in block region */
+word coll_tot = 0;              /* total collections */
+#endif					/* MultiThread */
+word alcnum = 0;                /* co-expressions allocated since g.c. */
+
+dptr *quallist;                 /* string qualifier list */
+dptr *qualfree;                 /* qualifier list free pointer */
+dptr *equallist;                /* end of qualifier list */
+
+int qualfail;                   /* flag: qualifier list overflow */
+
+/*
+ * Allocated block size table (sizes given in bytes).  A size of -1 is used
+ *  for types that have no blocks; a size of 0 indicates that the
+ *  second word of the block contains the size; a value greater than
+ *  0 is used for types with constant sized blocks.
+ */
+
+int bsizes[] = {
+    -1,                       /* T_Null (0), not block */
+    -1,                       /* T_Integer (1), not block */
+     0,                       /* T_Lrgint (2), large integer */
+     sizeof(struct b_real),   /* T_Real (3), real number */
+     sizeof(struct b_cset),   /* T_Cset (4), cset */
+     sizeof(struct b_file),   /* T_File (5), file block */
+     0,                       /* T_Proc (6), procedure block */
+     0,                       /* T_Record (7), record block */
+     sizeof(struct b_list),   /* T_List (8), list header block */
+     0,                       /* T_Lelem (9), list element block */
+     sizeof(struct b_set),    /* T_Set (10), set header block */
+     sizeof(struct b_selem),  /* T_Selem (11), set element block */
+     sizeof(struct b_table),  /* T_Table (12), table header block */
+     sizeof(struct b_telem),  /* T_Telem (13), table element block */
+     sizeof(struct b_tvtbl),  /* T_Tvtbl (14), table element trapped variable */
+     0,                       /* T_Slots (15), set/table hash block */
+     sizeof(struct b_tvsubs), /* T_Tvsubs (16), substring trapped variable */
+     0,                       /* T_Refresh (17), refresh block */
+    -1,                       /* T_Coexpr (18), co-expression block */
+     0,                       /* T_External (19) external block */
+     -1,                      /* T_Kywdint (20), integer keyword variable */
+     -1,                      /* T_Kywdpos (21), keyword &pos */
+     -1,                      /* T_Kywdsubj (22), keyword &subject */
+     -1,                      /* T_Kywdwin (23), keyword &window */
+     -1,                      /* T_Kywdstr (24), string keyword variable */
+     -1,                      /* T_Kywdevent (25), event keyword variable */
+    };
+
+/*
+ * Table of offsets (in bytes) to first descriptor in blocks.  -1 is for
+ *  types not allocated, 0 for blocks with no descriptors.
+ */
+int firstd[] = {
+    -1,                       /* T_Null (0), not block */
+    -1,                       /* T_Integer (1), not block */
+     0,                       /* T_Lrgint (2), large integer */
+     0,                       /* T_Real (3), real number */
+     0,                       /* T_Cset (4), cset */
+     3*WordSize,              /* T_File (5), file block */
+
+#ifdef MultiThread
+     8*WordSize,              /* T_Proc (6), procedure block */
+#else					/* MultiThread */
+     7*WordSize,              /* T_Proc (6), procedure block */
+#endif					/* MultiThread */
+
+     4*WordSize,              /* T_Record (7), record block */
+     0,                       /* T_List (8), list header block */
+     7*WordSize,              /* T_Lelem (9), list element block */
+     0,                       /* T_Set (10), set header block */
+     3*WordSize,              /* T_Selem (11), set element block */
+     (4+HSegs)*WordSize,      /* T_Table (12), table header block */
+     3*WordSize,              /* T_Telem (13), table element block */
+     3*WordSize,              /* T_Tvtbl (14), table element trapped variable */
+     0,                       /* T_Slots (15), set/table hash block */
+     3*WordSize,              /* T_Tvsubs (16), substring trapped variable */
+
+#if COMPILER
+     2*WordSize,              /* T_Refresh (17), refresh block */
+#else					/* COMPILER */
+     (4+Wsizeof(struct pf_marker))*WordSize, /* T_Refresh (17), refresh block */
+#endif					/* COMPILER */
+
+    -1,                       /* T_Coexpr (18), co-expression block */
+     0,                       /* T_External (19), external block */
+     -1,                      /* T_Kywdint (20), integer keyword variable */
+     -1,                      /* T_Kywdpos (21), keyword &pos */
+     -1,                      /* T_Kywdsubj (22), keyword &subject */
+     -1,                      /* T_Kywdwin (23), keyword &window */
+     -1,                      /* T_Kywdstr (24), string keyword variable */
+     -1,                      /* T_Kywdevent (25), event keyword variable */
+    };
+
+/*
+ * Table of offsets (in bytes) to first pointer in blocks.  -1 is for
+ *  types not allocated, 0 for blocks with no pointers.
+ */
+int firstp[] = {
+    -1,                       /* T_Null (0), not block */
+    -1,                       /* T_Integer (1), not block */
+     0,                       /* T_Lrgint (2), large integer */
+     0,                       /* T_Real (3), real number */
+     0,                       /* T_Cset (4), cset */
+     0,                       /* T_File (5), file block */
+     0,                       /* T_Proc (6), procedure block */
+     3*WordSize,              /* T_Record (7), record block */
+     3*WordSize,              /* T_List (8), list header block */
+     2*WordSize,              /* T_Lelem (9), list element block */
+     4*WordSize,              /* T_Set (10), set header block */
+     1*WordSize,              /* T_Selem (11), set element block */
+     4*WordSize,              /* T_Table (12), table header block */
+     1*WordSize,              /* T_Telem (13), table element block */
+     1*WordSize,              /* T_Tvtbl (14), table element trapped variable */
+     2*WordSize,              /* T_Slots (15), set/table hash block */
+     0,                       /* T_Tvsubs (16), substring trapped variable */
+     0,                       /* T_Refresh (17), refresh block */
+    -1,                       /* T_Coexpr (18), co-expression block */
+     0,                       /* T_External (19), external block */
+     -1,                      /* T_Kywdint (20), integer keyword variable */
+     -1,                      /* T_Kywdpos (21), keyword &pos */
+     -1,                      /* T_Kywdsubj (22), keyword &subject */
+     -1,                      /* T_Kywdwin (23), keyword &window */
+     -1,                      /* T_Kywdstr (24), string keyword variable */
+     -1,                      /* T_Kywdevent (25), event keyword variable */
+    };
+
+/*
+ * Table of number of pointers in blocks.  -1 is for types not allocated and
+ *  types without pointers, 0 for pointers through the end of the block.
+ */
+int ptrno[] = {
+    -1,                       /* T_Null (0), not block */
+    -1,                       /* T_Integer (1), not block */
+    -1,                       /* T_Lrgint (2), large integer */
+    -1,                       /* T_Real (3), real number */
+    -1,                       /* T_Cset (4), cset */
+    -1,                       /* T_File (5), file block */
+    -1,                       /* T_Proc (6), procedure block */
+     1,                       /* T_Record (7), record block */
+     2,                       /* T_List (8), list header block */
+     2,                       /* T_Lelem (9), list element block */
+     HSegs,                   /* T_Set (10), set header block */
+     1,                       /* T_Selem (11), set element block */
+     HSegs,                   /* T_Table (12), table header block */
+     1,                       /* T_Telem (13), table element block */
+     1,                       /* T_Tvtbl (14), table element trapped variable */
+     0,                       /* T_Slots (15), set/table hash block */
+    -1,                       /* T_Tvsubs (16), substring trapped variable */
+    -1,                       /* T_Refresh (17), refresh block */
+    -1,                       /* T_Coexpr (18), co-expression block */
+    -1,                       /* T_External (19), external block */
+    -1,                       /* T_Kywdint (20), integer keyword variable */
+    -1,                       /* T_Kywdpos (21), keyword &pos */
+    -1,                       /* T_Kywdsubj (22), keyword &subject */
+    -1,                       /* T_Kywdwin (23), keyword &window */
+    -1,                       /* T_Kywdstr (24), string keyword variable */
+    -1,                       /* T_Kywdevent (25), event keyword variable */
+    };
+
+/*
+ * Table of block names used by debugging functions.
+ */
+char *blkname[] = {
+   "illegal object",                    /* T_Null (0), not block */
+   "illegal object",                    /* T_Integer (1), not block */
+   "large integer",                     /* T_Largint (2) */
+   "real number",                       /* T_Real (3) */
+   "cset",                              /* T_Cset (4) */
+   "file",                              /* T_File (5) */
+   "procedure",                         /* T_Proc (6) */
+   "record",                            /* T_Record (7) */
+   "list",                              /* T_List (8) */
+   "list element",                      /* T_Lelem (9) */
+   "set",                               /* T_Set (10) */
+   "set element",                       /* T_Selem (11) */
+   "table",                             /* T_Table (12) */
+   "table element",                     /* T_Telem (13) */
+   "table element trapped variable",    /* T_Tvtbl (14) */
+   "hash block",                        /* T_Slots (15) */
+   "substring trapped variable",        /* T_Tvsubs (16) */
+   "refresh block",                     /* T_Refresh (17) */
+   "co-expression",                     /* T_Coexpr (18) */
+   "external block",                    /* T_External (19) */
+   "integer keyword variable",          /* T_Kywdint (20) */
+   "&pos",                              /* T_Kywdpos (21) */
+   "&subject",                          /* T_Kywdsubj (22) */
+   "illegal object",                    /* T_Kywdwin (23) */
+   "illegal object",                    /* T_Kywdstr (24) */
+   "illegal object",                    /* T_Kywdevent (25) */
+   };
+
+/*
+ * Sizes of hash chain segments.
+ *  Table size must equal or exceed HSegs.
+ */
+uword segsize[] = {
+   ((uword)HSlots),			/* segment 0 */
+   ((uword)HSlots),			/* segment 1 */
+   ((uword)HSlots) << 1,		/* segment 2 */
+   ((uword)HSlots) << 2,		/* segment 3 */
+   ((uword)HSlots) << 3,		/* segment 4 */
+   ((uword)HSlots) << 4,		/* segment 5 */
+   ((uword)HSlots) << 5,		/* segment 6 */
+   ((uword)HSlots) << 6,		/* segment 7 */
+   ((uword)HSlots) << 7,		/* segment 8 */
+   ((uword)HSlots) << 8,		/* segment 9 */
+   ((uword)HSlots) << 9,		/* segment 10 */
+   ((uword)HSlots) << 10,		/* segment 11 */
+   ((uword)HSlots) << 11,		/* segment 12 */
+   ((uword)HSlots) << 12,		/* segment 13 */
+   ((uword)HSlots) << 13,		/* segment 14 */
+   ((uword)HSlots) << 14,		/* segment 15 */
+   ((uword)HSlots) << 15,		/* segment 16 */
+   ((uword)HSlots) << 16,		/* segment 17 */
+   ((uword)HSlots) << 17,		/* segment 18 */
+   ((uword)HSlots) << 18,		/* segment 19 */
+   };
+
+/*
+ * initalloc - initialization routine to allocate memory regions
+ */
+
+#if COMPILER
+void initalloc()
+   {
+
+#else					/* COMPILER */
+#ifdef MultiThread
+void initalloc(codesize,p)
+struct progstate *p;
+#else					/* MultiThread */
+void initalloc(codesize)
+#endif					/* MultiThread */
+word codesize;
+   {
+#ifdef MultiThread
+   struct region *ps, *pb;
+#endif
+
+   if ((uword)codesize > (unsigned)MaxBlock)
+      error(NULL, "icode file too large");
+   /*
+    * Allocate icode region
+    */
+#ifdef MultiThread
+   if (codesize)
+#endif					/* MultiThread */
+   if ((code = (char *)AllocReg(codesize)) == NULL)
+      error(NULL,
+	 "insufficient memory, corrupted icode file, or wrong platform");
+#endif					/* COMPILER */
+
+   /*
+    * Set up allocated memory.	The regions are:
+    *	Static memory region (not used)
+    *	Allocated string region
+    *	Allocate block region
+    *	Qualifier list
+    */
+
+#ifdef MultiThread
+   ps = p->stringregion;
+   ps->free = ps->base = (char *)AllocReg(ps->size);
+   if (ps->free == NULL)
+      error(NULL, "insufficient memory for string region");
+   ps->end = ps->base + ps->size;
+
+   pb = p->blockregion;
+   pb->free = pb->base = (char *)AllocReg(pb->size);
+   if (pb->free == NULL)
+      error(NULL, "insufficient memory for block region");
+   pb->end = pb->base + pb->size;
+
+   if (p == &rootpstate) {
+      if ((quallist = (dptr *)malloc(qualsize)) == NULL)
+         error(NULL, "insufficient memory for qualifier list");
+      equallist = (dptr *)((char *)quallist + qualsize);
+      }
+#else					/* MultiThread */
+   {
+   uword t1, t2;
+   t1 = ssize;
+   t2 = abrsize;
+   curstring = (struct region *)malloc(sizeof(struct region));
+   curblock = (struct region *)malloc(sizeof(struct region));
+   curstring->size = t1;
+   curblock->size = t2;
+   }
+   curstring->next = curstring->prev = NULL;
+   curstring->Gnext = curstring->Gprev = NULL;
+   curblock->next = curblock->prev = NULL;
+   curblock->Gnext = curblock->Gprev = NULL;
+   if ((strfree = strbase = (char *)AllocReg(ssize)) == NULL)
+      error(NULL, "insufficient memory for string region");
+   strend = strbase + ssize;
+   if ((blkfree = blkbase = (char *)AllocReg(abrsize)) == NULL)
+      error(NULL, "insufficient memory for block region");
+   blkend = blkbase + abrsize;
+   if ((quallist = (dptr *)malloc(qualsize)) == NULL)
+      error(NULL, "insufficient memory for qualifier list");
+   equallist = (dptr *)((char *)quallist + qualsize);
+#endif					/* MultiThread */
+   }
+
+/*
+ * collect - do a garbage collection of currently active regions.
+ */
+
+int collect(region)
+int region;
+   {
+   struct b_coexpr *cp;
+
+#ifdef EventMon
+   if (!noMTevents)
+      EVVal((word)region,E_Collect);
+#endif					/* EventMon */
+
+   switch (region) {
+      case Static:
+         coll_stat++;
+         break;
+      case Strings:
+         coll_str++;
+         break;
+      case Blocks:
+         coll_blk++;
+         break;
+      }
+   coll_tot++;
+
+   alcnum = 0;
+
+   /*
+    * Garbage collection cannot be done until initialization is complete.
+    */
+
+#if !COMPILER
+   if (sp == NULL)
+      return 0;
+#endif					/* !COMPILER */
+
+   /*
+    * Sync the values (used by sweep) in the coexpr block for &current
+    *  with the current values.
+    */
+   cp = (struct b_coexpr *)BlkLoc(k_current);
+   cp->es_tend = tend;
+
+#if !COMPILER
+   cp->es_pfp = pfp;
+   cp->es_gfp = gfp;
+   cp->es_efp = efp;
+   cp->es_sp = sp;
+#endif					/* !COMPILER */
+
+   /*
+    * Reset qualifier list.
+    */
+   qualfree = quallist;
+   qualfail = 0;
+
+   /*
+    * Mark the stacks for &main and the current co-expression.
+    */
+#ifdef MultiThread
+   markprogram(&rootpstate);
+#endif					/* MultiThread */
+   markblock(&k_main);
+   markblock(&k_current);
+   /*
+    * Mark &subject and the cached s2 and s3 strings for map.
+    */
+#ifndef MultiThread
+   postqual(&k_subject);
+   postqual(&kywd_prog);
+#endif					/* MultiThread */
+   if (Qual(maps2))                     /*  caution: the cached arguments of */
+      postqual(&maps2);                 /*  map may not be strings. */
+   else if (Pointer(maps2))
+      markblock(&maps2);
+   if (Qual(maps3))
+      postqual(&maps3);
+   else if (Pointer(maps3))
+      markblock(&maps3);
+
+#ifdef Graphics
+   /*
+    * Mark file and list values for windows
+    */
+   {
+     wsp ws;
+
+     for (ws = wstates; ws ; ws = ws->next) {
+	    if (is:file(ws->filep))
+	      markblock(&(ws->filep));
+	    if (is:list(ws->listp))
+	      markblock(&(ws->listp));
+        }
+   }
+#endif					/* Graphics */
+
+   /*
+    * Mark the globals and the statics.
+    */
+
+#ifndef MultiThread
+   { register struct descrip *dp;
+   for (dp = globals; dp < eglobals; dp++)
+      if (Qual(*dp))
+	 postqual(dp);
+      else if (Pointer(*dp))
+	 markblock(dp);
+
+   for (dp = statics; dp < estatics; dp++)
+      if (Qual(*dp))
+	 postqual(dp);
+      else if (Pointer(*dp))
+	 markblock(dp);
+   }
+
+#ifdef Graphics
+   if (is:file(kywd_xwin[XKey_Window]))
+      markblock(&(kywd_xwin[XKey_Window]));
+   if (is:file(lastEventWin))
+      markblock(&(lastEventWin));
+#endif					/* Graphics */
+#endif					/* MultiThread */
+
+   reclaim();
+
+   /*
+    * Turn off all the marks in all the block regions everywhere
+    */
+   { struct region *br;
+   for (br = curblock->Gnext; br; br = br->Gnext) {
+      char *source = br->base, *free = br->free;
+      uword NoMark = (uword) ~F_Mark;
+      while (source < free) {
+	 BlkType(source) &= NoMark;
+         source += BlkSize(source);
+         }
+      }
+   for (br = curblock->Gprev; br; br = br->Gprev) {
+      char *source = br->base, *free = br->free;
+      uword NoMark = (uword) ~F_Mark;
+      while (source < free) {
+	 BlkType(source) &= NoMark;
+         source += BlkSize(source);
+         }
+      }
+   }
+
+#ifdef EventMon
+   if (!noMTevents) {
+      mmrefresh();
+      EVValD(&nulldesc, E_EndCollect);
+      }
+#endif					/* EventMon */
+
+   return 1;
+   }
+
+/*
+ * markprogram - traverse pointers out of a program state structure
+ */
+
+#ifdef MultiThread
+#define PostDescrip(d) \
+   if (Qual(d)) \
+      postqual(&(d)); \
+   else if (Pointer(d))\
+      markblock(&(d));
+
+static void markprogram(pstate)
+struct progstate *pstate;
+   {
+   struct descrip *dp;
+
+   PostDescrip(pstate->parentdesc);
+   PostDescrip(pstate->eventmask);
+   PostDescrip(pstate->opcodemask);
+   PostDescrip(pstate->eventcode);
+   PostDescrip(pstate->eventval);
+   PostDescrip(pstate->eventsource);
+
+   /* Kywd_err, &error, always an integer */
+   /* Kywd_pos, &pos, always an integer */
+   postqual(&(pstate->ksub));
+   postqual(&(pstate->Kywd_prog));
+   /* Kywd_ran, &random, always an integer */
+   /* Kywd_trc, &trace, always an integer */
+
+   /*
+    * Mark the globals and the statics.
+    */
+   for (dp = pstate->Globals; dp < pstate->Eglobals; dp++)
+      if (Qual(*dp))
+	 postqual(dp);
+      else if (Pointer(*dp))
+	 markblock(dp);
+
+   for (dp = pstate->Statics; dp < pstate->Estatics; dp++)
+      if (Qual(*dp))
+	 postqual(dp);
+      else if (Pointer(*dp))
+	 markblock(dp);
+
+   /*
+    * no marking for &x, &y, &row, &col, &interval, all integers
+    */
+#ifdef Graphics
+   PostDescrip(pstate->LastEventWin);	/* last Event() win */
+   PostDescrip(pstate->Kywd_xwin[XKey_Window]);	/* &window */
+#endif					/* Graphics */
+
+   PostDescrip(pstate->K_errorvalue);
+   PostDescrip(pstate->T_errorvalue);
+   }
+#endif					/* MultiThread */
+
+/*
+ * postqual - mark a string qualifier.  Strings outside the string space
+ *  are ignored.
+ */
+
+static void postqual(dp)
+dptr dp;
+   {
+   char *newqual;
+
+   if (InRange(strbase,StrLoc(*dp),strfree + 1)) {
+      /*
+       * The string is in the string space.  Add it to the string qualifier
+       *  list, but before adding it, expand the string qualifier list if
+       *  necessary.
+       */
+      if (qualfree >= equallist) {
+
+	 /* reallocate a new qualifier list that's twice as large */
+	 newqual = realloc(quallist, 2 * qualsize);
+	 if (newqual) {
+	    quallist = (dptr *)newqual;
+	    qualfree = (dptr *)(newqual + qualsize);
+	    qualsize *= 2;
+	    equallist = (dptr *)(newqual + qualsize);
+	    }
+	 else {
+            qualfail = 1;
+            return;
+	    }
+
+         }
+      *qualfree++ = dp;
+      }
+   }
+
+/*
+ * markblock - mark each accessible block in the block region and build
+ *  back-list of descriptors pointing to that block. (Phase I of garbage
+ *  collection.)
+ */
+static void markblock(dp)
+dptr dp;
+   {
+   register dptr dp1;
+   register char *block, *endblock;
+   word type, fdesc;
+   int numptr;
+   register union block **ptr, **lastptr;
+
+   if (Var(*dp)) {
+       if (dp->dword & F_Typecode) {
+          switch (Type(*dp)) {
+             case T_Kywdint:
+             case T_Kywdpos:
+             case T_Kywdsubj:
+                /*
+                 * The descriptor points to a keyword, not a block.
+                 */
+                return;
+             }
+          }
+       else if (Offset(*dp) == 0) {
+          /*
+           * The descriptor is a simple variable not residing in a block.
+           */
+          return;
+          }
+      }
+
+   /*
+    * Get the block to which dp points.
+    */
+   block = (char *)BlkLoc(*dp);
+
+   if (InRange(blkbase,block,blkfree)) {
+      type = BlkType(block);
+      if ((uword)type <= MaxType) {
+
+         /*
+          * The type is valid, which indicates that this block has not
+          *  been marked.  Point endblock to the byte past the end
+          *  of the block.
+          */
+         endblock = block + BlkSize(block);
+         }
+
+      /*
+       * Add dp to the back chain for the block and point the
+       *  block (via the type field) to dp.vword.
+       */
+      BlkLoc(*dp) = (union block *)type;
+      BlkType(block) = (uword)&BlkLoc(*dp);
+
+      if ((uword)type <= MaxType) {
+         /*
+          * The block was not marked; process pointers and descriptors
+          *  within the block.
+          */
+         if ((fdesc = firstp[type]) > 0) {
+            /*
+             * The block contains pointers; mark each pointer.
+             */
+            ptr = (union block **)(block + fdesc);
+	    numptr = ptrno[type];
+	    if (numptr > 0)
+	       lastptr = ptr + numptr;
+	    else
+	       lastptr = (union block **)endblock;
+	    for (; ptr < lastptr; ptr++)
+	       if (*ptr != NULL)
+                  markptr(ptr);
+	    }
+         if ((fdesc = firstd[type]) > 0)
+            /*
+             * The block contains descriptors; mark each descriptor.
+             */
+            for (dp1 = (dptr)(block + fdesc);
+                 (char *)dp1 < endblock; dp1++) {
+               if (Qual(*dp1))
+                  postqual(dp1);
+               else if (Pointer(*dp1))
+                  markblock(dp1);
+               }
+         }
+      }
+
+   else if ((unsigned int)BlkType(block) == T_Coexpr) {
+      struct b_coexpr *cp;
+      struct astkblk *abp;
+      int i;
+      struct descrip adesc;
+
+      /*
+       * dp points to a co-expression block that has not been
+       *  marked.  Point the block to dp.  Sweep the interpreter
+       *  stack in the block.  Then mark the block for the
+       *  activating co-expression and the refresh block.
+       */
+      BlkType(block) = (uword)dp;
+      sweep((struct b_coexpr *)block);
+
+#ifdef MultiThread
+      if (((struct b_coexpr *)block)+1 ==
+         (struct b_coexpr *)((struct b_coexpr *)block)->program){
+         /*
+          * This coexpr is an &main; traverse its roots
+          */
+         markprogram(((struct b_coexpr *)block)->program);
+         }
+#endif					/* MultiThread */
+
+#ifdef Coexpr
+      /*
+       * Mark the activators of this co-expression.   The activators are
+       *  stored as a list of addresses, but markblock requires the address
+       *  of a descriptor.  To accommodate markblock, the dummy descriptor
+       *  adesc is filled in with each activator address in turn and then
+       *  marked.  Since co-expressions and the descriptors that reference
+       *  them don't participate in the back-chaining scheme, it's ok to
+       *  reuse the descriptor in this manner.
+       */
+      cp = (struct b_coexpr *)block;
+      adesc.dword = D_Coexpr;
+      for (abp = cp->es_actstk; abp != NULL; abp = abp->astk_nxt) {
+         for (i = 1; i <= abp->nactivators; i++) {
+            BlkLoc(adesc) = (union block *)abp->arec[i-1].activator;
+            markblock(&adesc);
+            }
+         }
+      if(BlkLoc(cp->freshblk) != NULL)
+         markblock(&((struct b_coexpr *)block)->freshblk);
+#endif					/* Coexpr */
+      }
+
+   else {
+      struct region *rp;
+
+      /*
+       * Look for this block in other allocated block regions.
+       */
+      for (rp = curblock->Gnext; rp; rp = rp->Gnext)
+	 if (InRange(rp->base,block,rp->free)) break;
+
+      if (rp == NULL)
+         for (rp = curblock->Gprev; rp; rp = rp->Gprev)
+            if (InRange(rp->base,block,rp->free)) break;
+
+      /*
+       * If this block is not in a block region, its something else
+       *  like a procedure block.
+       */
+      if (rp == NULL)
+         return;
+
+      /*
+       * Get this block's type field; return if it is marked
+       */
+      type = BlkType(block);
+      if ((uword)type > MaxType)
+         return;
+
+      /*
+       * this is an unmarked block outside the (collecting) block region;
+       * process pointers and descriptors within the block.
+       *
+       * The type is valid, which indicates that this block has not
+       *  been marked.  Point endblock to the byte past the end
+       *  of the block.
+       */
+      endblock = block + BlkSize(block);
+
+      BlkType(block) |= F_Mark;			/* mark the block */
+
+      if ((fdesc = firstp[type]) > 0) {
+         /*
+          * The block contains pointers; mark each pointer.
+          */
+         ptr = (union block **)(block + fdesc);
+	 numptr = ptrno[type];
+	 if (numptr > 0)
+	    lastptr = ptr + numptr;
+	 else
+	    lastptr = (union block **)endblock;
+	 for (; ptr < lastptr; ptr++)
+	    if (*ptr != NULL)
+               markptr(ptr);
+	 }
+      if ((fdesc = firstd[type]) > 0)
+         /*
+          * The block contains descriptors; mark each descriptor.
+          */
+         for (dp1 = (dptr)(block + fdesc);
+              (char *)dp1 < endblock; dp1++) {
+            if (Qual(*dp1))
+               postqual(dp1);
+            else if (Pointer(*dp1))
+               markblock(dp1);
+            }
+      }
+   }
+
+/*
+ * markptr - just like mark block except the object pointing at the block
+ *  is just a block pointer, not a descriptor.
+ */
+
+static void markptr(ptr)
+union block **ptr;
+   {
+   register dptr dp;
+   register char *block, *endblock;
+   word type, fdesc;
+   int numptr;
+   register union block **ptr1, **lastptr;
+
+   /*
+    * Get the block to which ptr points.
+    */
+   block = (char *)*ptr;
+   if (InRange(blkbase,block,blkfree)) {
+      type = BlkType(block);
+      if ((uword)type <= MaxType) {
+         /*
+          * The type is valid, which indicates that this block has not
+          *  been marked.  Point endblock to the byte past the end
+          *  of the block.
+          */
+         endblock = block + BlkSize(block);
+         }
+
+      /*
+       * Add ptr to the back chain for the block and point the
+       *  block (via the type field) to ptr.
+       */
+      *ptr = (union block *)type;
+      BlkType(block) = (uword)ptr;
+
+      if ((uword)type <= MaxType) {
+         /*
+          * The block was not marked; process pointers and descriptors
+          *  within the block.
+          */
+         if ((fdesc = firstp[type]) > 0) {
+            /*
+             * The block contains pointers; mark each pointer.
+             */
+            ptr1 = (union block **)(block + fdesc);
+            numptr = ptrno[type];
+            if (numptr > 0)
+               lastptr = ptr1 + numptr;
+            else
+               lastptr = (union block **)endblock;
+            for (; ptr1 < lastptr; ptr1++)
+               if (*ptr1 != NULL)
+                  markptr(ptr1);
+            }
+         if ((fdesc = firstd[type]) > 0)
+            /*
+             * The block contains descriptors; mark each descriptor.
+             */
+            for (dp = (dptr)(block + fdesc);
+                 (char *)dp < endblock; dp++) {
+               if (Qual(*dp))
+                  postqual(dp);
+               else if (Pointer(*dp))
+                  markblock(dp);
+               }
+         }
+      }
+
+   else {
+      struct region *rp;
+
+      /*
+       * Look for this block in other allocated block regions.
+       */
+      for (rp = curblock->Gnext;rp;rp = rp->Gnext)
+	 if (InRange(rp->base,block,rp->free)) break;
+
+      if (rp == NULL)
+         for (rp = curblock->Gprev;rp;rp = rp->Gprev)
+            if (InRange(rp->base,block,rp->free)) break;
+
+      /*
+       * If this block is not in a block region, its something else
+       *  like a procedure block.
+       */
+      if (rp == NULL)
+         return;
+
+      /*
+       * Get this block's type field; return if it is marked
+       */
+      type = BlkType(block);
+      if ((uword)type > MaxType)
+         return;
+
+      /*
+       * this is an unmarked block outside the (collecting) block region;
+       * process pointers and descriptors within the block.
+       *
+       * The type is valid, which indicates that this block has not
+       *  been marked.  Point endblock to the byte past the end
+       *  of the block.
+       */
+      endblock = block + BlkSize(block);
+
+      BlkType(block) |= F_Mark;			/* mark the block */
+
+      if ((fdesc = firstp[type]) > 0) {
+         /*
+          * The block contains pointers; mark each pointer.
+          */
+         ptr1 = (union block **)(block + fdesc);
+         numptr = ptrno[type];
+         if (numptr > 0)
+	    lastptr = ptr1 + numptr;
+	 else
+	    lastptr = (union block **)endblock;
+	 for (; ptr1 < lastptr; ptr1++)
+	    if (*ptr1 != NULL)
+               markptr(ptr1);
+	 }
+      if ((fdesc = firstd[type]) > 0)
+         /*
+          * The block contains descriptors; mark each descriptor.
+          */
+         for (dp = (dptr)(block + fdesc);
+              (char *)dp < endblock; dp++) {
+            if (Qual(*dp))
+               postqual(dp);
+            else if (Pointer(*dp))
+               markblock(dp);
+            }
+         }
+   }
+
+/*
+ * sweep - sweep the chain of tended descriptors for a co-expression
+ *  marking the descriptors.
+ */
+
+static void sweep(ce)
+struct b_coexpr *ce;
+   {
+   register struct tend_desc *tp;
+   register int i;
+
+   for (tp = ce->es_tend; tp != NULL; tp = tp->previous) {
+      for (i = 0; i < tp->num; ++i) {
+         if (Qual(tp->d[i]))
+            postqual(&tp->d[i]);
+         else if (Pointer(tp->d[i])) {
+            if(BlkLoc(tp->d[i]) != NULL)
+               markblock(&tp->d[i]);
+	    }
+         }
+      }
+#if !COMPILER
+   sweep_stk(ce);
+#endif					/* !COMPILER */
+   }
+
+#if !COMPILER
+/*
+ * sweep_stk - sweep the stack, marking all descriptors there.  Method
+ *  is to start at a known point, specifically, the frame that the
+ *  fp points to, and then trace back along the stack looking for
+ *  descriptors and local variables, marking them when they are found.
+ *  The sp starts at the first frame, and then is moved down through
+ *  the stack.  Procedure, generator, and expression frames are
+ *  recognized when the sp is a certain distance from the fp, gfp,
+ *  and efp respectively.
+ *
+ * Sweeping problems can be manifested in a variety of ways due to
+ *  the "if it can't be identified it's a descriptor" methodology.
+ */
+
+static void sweep_stk(ce)
+struct b_coexpr *ce;
+   {
+   register word *s_sp;
+   register struct pf_marker *fp;
+   register struct gf_marker *s_gfp;
+   register struct ef_marker *s_efp;
+   word nargs, type = 0, gsize = 0;
+
+   fp = ce->es_pfp;
+   s_gfp = ce->es_gfp;
+   if (s_gfp != 0) {
+      type = s_gfp->gf_gentype;
+      if (type == G_Psusp)
+         gsize = Wsizeof(*s_gfp);
+      else
+         gsize = Wsizeof(struct gf_smallmarker);
+      }
+   s_efp = ce->es_efp;
+   s_sp =  ce->es_sp;
+   nargs = 0;                           /* Nargs counter is 0 initially. */
+
+#ifdef MultiThread
+   if (fp == 0) {
+      if (is:list(* (dptr) (s_sp - 1))) {
+	 /*
+	  * this is the argument list of an un-started task
+	  */
+         if (Pointer(*((dptr)(&s_sp[-1])))) {
+            markblock((dptr)&s_sp[-1]);
+	    }
+	 }
+      }
+#endif					/* MultiThread */
+
+   while ((fp != 0 || nargs)) {         /* Keep going until current fp is
+                                            0 and no arguments are left. */
+      if (s_sp == (word *)fp + Vwsizeof(*pfp) - 1) {
+                                        /* sp has reached the upper
+                                            boundary of a procedure frame,
+                                            process the frame. */
+         s_efp = fp->pf_efp;            /* Get saved efp out of frame */
+         s_gfp = fp->pf_gfp;            /* Get save gfp */
+         if (s_gfp != 0) {
+            type = s_gfp->gf_gentype;
+            if (type == G_Psusp)
+               gsize = Wsizeof(*s_gfp);
+            else
+               gsize = Wsizeof(struct gf_smallmarker);
+            }
+         s_sp = (word *)fp - 1;         /* First argument descriptor is
+                                            first word above proc frame */
+         nargs = fp->pf_nargs;
+         fp = fp->pf_pfp;
+         }
+      else if (s_gfp != NULL && s_sp == (word *)s_gfp + gsize - 1) {
+                                        /* The sp has reached the lower end
+                                            of a generator frame, process
+                                            the frame.*/
+         if (type == G_Psusp)
+            fp = s_gfp->gf_pfp;
+         s_sp = (word *)s_gfp - 1;
+         s_efp = s_gfp->gf_efp;
+         s_gfp = s_gfp->gf_gfp;
+         if (s_gfp != 0) {
+            type = s_gfp->gf_gentype;
+            if (type == G_Psusp)
+               gsize = Wsizeof(*s_gfp);
+            else
+               gsize = Wsizeof(struct gf_smallmarker);
+            }
+         nargs = 1;
+         }
+      else if (s_sp == (word *)s_efp + Wsizeof(*s_efp) - 1) {
+                                            /* The sp has reached the upper
+                                                end of an expression frame,
+                                                process the frame. */
+         s_gfp = s_efp->ef_gfp;         /* Restore gfp, */
+         if (s_gfp != 0) {
+            type = s_gfp->gf_gentype;
+            if (type == G_Psusp)
+               gsize = Wsizeof(*s_gfp);
+            else
+               gsize = Wsizeof(struct gf_smallmarker);
+            }
+         s_efp = s_efp->ef_efp;         /*  and efp from frame. */
+         s_sp -= Wsizeof(*s_efp);       /* Move past expression frame marker. */
+         }
+      else {                            /* Assume the sp is pointing at a
+                                            descriptor. */
+         if (Qual(*((dptr)(&s_sp[-1]))))
+            postqual((dptr)&s_sp[-1]);
+         else if (Pointer(*((dptr)(&s_sp[-1])))) {
+            markblock((dptr)&s_sp[-1]);
+	    }
+         s_sp -= 2;                     /* Move past descriptor. */
+         if (nargs)                     /* Decrement argument count if in an*/
+            nargs--;                    /*  argument list. */
+         }
+      }
+   }
+#endif					/* !COMPILER */
+
+/*
+ * reclaim - reclaim space in the allocated memory regions. The marking
+ *   phase has already been completed.
+ */
+
+static void reclaim()
+   {
+   /*
+    * Collect available co-expression blocks.
+    */
+   cofree();
+
+   /*
+    * Collect the string space leaving it where it is.
+    */
+   if (!qualfail)
+      scollect((word)0);
+
+   /*
+    * Adjust the blocks in the block region in place.
+    */
+   adjust(blkbase,blkbase);
+
+   /*
+    * Compact the block region.
+    */
+   compact(blkbase);
+   }
+
+/*
+ * cofree - collect co-expression blocks.  This is done after
+ *  the marking phase of garbage collection and the stacks that are
+ *  reachable have pointers to data blocks, rather than T_Coexpr,
+ *  in their type field.
+ */
+
+static void cofree()
+   {
+   register struct b_coexpr **ep, *xep;
+   register struct astkblk *abp, *xabp;
+
+   /*
+    * Reset the type for &main.
+    */
+
+#ifdef MultiThread
+   rootpstate.Mainhead->title = T_Coexpr;
+#else					/* MultiThread */
+   BlkLoc(k_main)->coexpr.title = T_Coexpr;
+#endif					/* MultiThread */
+
+   /*
+    * The co-expression blocks are linked together through their
+    *  nextstk fields, with stklist pointing to the head of the list.
+    *  The list is traversed and each stack that was not marked
+    *  is freed.
+    */
+   ep = &stklist;
+   while (*ep != NULL) {
+      if (BlkType(*ep) == T_Coexpr) {
+         xep = *ep;
+         *ep = (*ep)->nextstk;
+         /*
+          * Free the astkblks.  There should always be one and it seems that
+          *  it's not possible to have more than one, but nonetheless, the
+          *  code provides for more than one.
+          */
+         for (abp = xep->es_actstk; abp; ) {
+            xabp = abp;
+            abp = abp->astk_nxt;
+            free((pointer)xabp);
+            }
+         #ifdef CoClean
+	    coclean(xep->cstate);
+         #endif				/* CoClean */
+         free((pointer)xep);
+         }
+      else {
+         BlkType(*ep) = T_Coexpr;
+         ep = &(*ep)->nextstk;
+         }
+      }
+   }
+
+/*
+ * scollect - collect the string space.  quallist is a list of pointers to
+ *  descriptors for all the reachable strings in the string space.  For
+ *  ease of description, it is referred to as if it were composed of
+ *  descriptors rather than pointers to them.
+ */
+
+static void scollect(extra)
+word extra;
+   {
+   register char *source, *dest;
+   register dptr *qptr;
+   char *cend;
+
+   if (qualfree <= quallist) {
+      /*
+       * There are no accessible strings.  Thus, there are none to
+       *  collect and the whole string space is free.
+       */
+      strfree = strbase;
+      return;
+      }
+   /*
+    * Sort the pointers on quallist in ascending order of string
+    *  locations.
+    */
+   qsort((char *)quallist, (int)(DiffPtrs((char *)qualfree,(char *)quallist)) /
+     sizeof(dptr *), sizeof(dptr), (int (*)())qlcmp);
+   /*
+    * The string qualifiers are now ordered by starting location.
+    */
+   dest = strbase;
+   source = cend = StrLoc(**quallist);
+
+   /*
+    * Loop through qualifiers for accessible strings.
+    */
+   for (qptr = quallist; qptr < qualfree; qptr++) {
+      if (StrLoc(**qptr) > cend) {
+
+         /*
+          * qptr points to a qualifier for a string in the next clump.
+          *  The last clump is moved, and source and cend are set for
+          *  the next clump.
+          */
+         while (source < cend)
+            *dest++ = *source++;
+         source = cend = StrLoc(**qptr);
+         }
+      if ((StrLoc(**qptr) + StrLen(**qptr)) > cend)
+         /*
+          * qptr is a qualifier for a string in this clump; extend
+          *  the clump.
+          */
+         cend = StrLoc(**qptr) + StrLen(**qptr);
+      /*
+       * Relocate the string qualifier.
+       */
+      StrLoc(**qptr) = StrLoc(**qptr) + DiffPtrs(dest,source) + (uword)extra;
+      }
+
+   /*
+    * Move the last clump.
+    */
+   while (source < cend)
+      *dest++ = *source++;
+   strfree = dest;
+   }
+
+/*
+ * qlcmp - compare the location fields of two string qualifiers for qsort.
+ */
+
+static int qlcmp(q1,q2)
+dptr *q1, *q2;
+   {
+   return (int)(DiffPtrs(StrLoc(**q1),StrLoc(**q2)));
+   }
+
+/*
+ * adjust - adjust pointers into the block region, beginning with block oblk
+ *  and basing the "new" block region at nblk.  (Phase II of garbage
+ *  collection.)
+ */
+
+static void adjust(source,dest)
+char *source, *dest;
+   {
+   register union block **nxtptr, **tptr;
+
+   /*
+    * Loop through to the end of allocated block region, moving source
+    *  to each block in turn and using the size of a block to find the
+    *  next block.
+    */
+   while (source < blkfree) {
+      if ((uword)(nxtptr = (union block **)BlkType(source)) > MaxType) {
+
+         /*
+          * The type field of source is a back pointer.  Traverse the
+          *  chain of back pointers, changing each block location from
+          *  source to dest.
+          */
+         while ((uword)nxtptr > MaxType) {
+            tptr = nxtptr;
+            nxtptr = (union block **) *nxtptr;
+            *tptr = (union block *)dest;
+            }
+         BlkType(source) = (uword)nxtptr | F_Mark;
+         dest += BlkSize(source);
+         }
+      source += BlkSize(source);
+      }
+   }
+
+/*
+ * compact - compact good blocks in the block region. (Phase III of garbage
+ *  collection.)
+ */
+
+static void compact(source)
+char *source;
+   {
+   register char *dest;
+   register word size;
+
+   /*
+    * Start dest at source.
+    */
+   dest = source;
+
+   /*
+    * Loop through to end of allocated block space, moving source
+    *  to each block in turn, using the size of a block to find the next
+    *  block.  If a block has been marked, it is copied to the
+    *  location pointed to by dest and dest is pointed past the end
+    *  of the block, which is the location to place the next saved
+    *  block.  Marks are removed from the saved blocks.
+    */
+   while (source < blkfree) {
+      size = BlkSize(source);
+      if (BlkType(source) & F_Mark) {
+         BlkType(source) &= ~F_Mark;
+         if (source != dest)
+            mvc((uword)size,source,dest);
+         dest += size;
+         }
+      source += size;
+      }
+
+   /*
+    * dest is the location of the next free block.  Now that compaction
+    *  is complete, point blkfree to that location.
+    */
+   blkfree = dest;
+   }
+
+/*
+ * mvc - move n bytes from src to dest
+ *
+ *      The algorithm is to copy the data (using memcpy) in the largest
+ * chunks possible, which is the size of area of the source data not in
+ * the destination area (ie non-overlapped area).  (Chunks are expected to
+ * be fairly large.)
+ */
+
+static void mvc(n, src, dest)
+uword n;
+register char *src, *dest;
+   {
+   register char *srcend, *destend;        /* end of data areas */
+   word copy_size;                  /* of size copy_size */
+   word left_over;         /* size of last chunk < copy_size */
+
+   if (n == 0)
+      return;
+
+   srcend  = src + n;    /* point at byte after src data */
+   destend = dest + n;   /* point at byte after dest area */
+
+   if ((destend <= src) || (srcend <= dest))  /* not overlapping */
+      memcpy(dest,src,n);
+
+   else {                     /* overlapping data areas */
+      if (dest < src) {
+         /*
+          * The move is from higher memory to lower memory.
+          */
+         copy_size = DiffPtrs(src,dest);
+
+         /* now loop round copying copy_size chunks of data */
+
+         do {
+            memcpy(dest,src,copy_size);
+            dest = src;
+            src = src + copy_size;
+            }
+         while (DiffPtrs(srcend,src) > copy_size);
+
+         left_over = DiffPtrs(srcend,src);
+
+         /* copy final fragment of data - if there is one */
+
+         if (left_over > 0)
+            memcpy(dest,src,left_over);
+         }
+
+      else if (dest > src) {
+         /*
+          * The move is from lower memory to higher memory.
+          */
+         copy_size = DiffPtrs(destend,srcend);
+
+         /* now loop round copying copy_size chunks of data */
+
+         do {
+            destend = srcend;
+            srcend  = srcend - copy_size;
+            memcpy(destend,srcend,copy_size);
+            }
+         while (DiffPtrs(srcend,src) > copy_size);
+
+         left_over = DiffPtrs(srcend,src);
+
+         /* copy intial fragment of data - if there is one */
+
+         if (left_over > 0) memcpy(dest,src,left_over);
+         }
+
+      } /* end of overlapping data area code */
+
+   /*
+    *  Note that src == dest implies no action
+    */
+   }
+
+#ifdef DeBugIconx
+/*
+ * descr - dump a descriptor.  Used only for debugging.
+ */
+
+void descr(dp)
+dptr dp;
+   {
+   int i;
+
+   fprintf(stderr,"%08lx: ",(long)dp);
+   if (Qual(*dp))
+      fprintf(stderr,"%15s","qualifier");
+
+   else if (Var(*dp))
+      fprintf(stderr,"%15s","variable");
+   else {
+      i =  Type(*dp);
+      switch (i) {
+         case T_Null:
+            fprintf(stderr,"%15s","null");
+            break;
+         case T_Integer:
+            fprintf(stderr,"%15s","integer");
+            break;
+         default:
+            fprintf(stderr,"%15s",blkname[i]);
+         }
+      }
+   fprintf(stderr," %08lx %08lx\n",(long)dp->dword,(long)IntVal(*dp));
+   }
+
+/*
+ * blkdump - dump the allocated block region.  Used only for debugging.
+ *   NOTE:  Not adapted for multiple regions.
+ */
+
+void blkdump()
+   {
+   register char *blk;
+   register word type, size, fdesc;
+   register dptr ndesc;
+
+   fprintf(stderr,
+      "\nDump of allocated block region.  base:%08lx free:%08lx max:%08lx\n",
+         (long)blkbase,(long)blkfree,(long)blkend);
+   fprintf(stderr,"  loc     type              size  contents\n");
+
+   for (blk = blkbase; blk < blkfree; blk += BlkSize(blk)) {
+      type = BlkType(blk);
+      size = BlkSize(blk);
+      fprintf(stderr," %08lx   %15s   %4ld\n",(long)blk,blkname[type],
+         (long)size);
+      if ((fdesc = firstd[type]) > 0)
+         for (ndesc = (dptr)(blk + fdesc);
+               ndesc < (dptr)(blk + size); ndesc++) {
+            fprintf(stderr,"                                 ");
+            descr(ndesc);
+            }
+      fprintf(stderr,"\n");
+      }
+   fprintf(stderr,"end of block region.\n");
+   }
+#endif					/* DeBugIconx */
diff --git a/src/runtime/rmisc.r b/src/runtime/rmisc.r
new file mode 100644
index 0000000..a302da2
--- /dev/null
+++ b/src/runtime/rmisc.r
@@ -0,0 +1,1803 @@
+/*
+ * File: rmisc.r
+ *  Contents: deref, eq, getvar, hash, outimage,
+ *  qtos, pushact, popact, topact, [dumpact],
+ *  findline, findipc, findfile, doimage, getimage
+ *  printable, sig_rsm, cmd_line, varargs.
+ *
+ *  Integer overflow checking.
+ */
+
+/*
+ * Prototypes.
+ */
+
+static void	listimage
+   (FILE *f,struct b_list *lp, int noimage);
+static void	printimage	(FILE *f,int c,int q);
+static char *	csname		(dptr dp);
+
+
+/*
+ * eq - compare two Icon strings for equality
+ */
+int eq(d1, d2)
+dptr d1, d2;
+{
+	char *s1, *s2;
+	int i;
+
+	if (StrLen(*d1) != StrLen(*d2))
+	   return 0;
+	s1 = StrLoc(*d1);
+	s2 = StrLoc(*d2);
+	for (i = 0; i < StrLen(*d1); i++)
+	   if (*s1++ != *s2++)
+	      return 0;
+	return 1;
+}
+
+/*
+ * Get variable descriptor from name.  Returns the (integer-encoded) scope
+ *  of the variable (Succeeded for keywords), or Failed if the variable
+ *  does not exist.
+ */
+int getvar(s,vp)
+   char *s;
+   dptr vp;
+   {
+   register dptr dp;
+   register dptr np;
+   register int i;
+   struct b_proc *bp;
+#if COMPILER
+   struct descrip sdp;
+
+   if (!debug_info)
+      fatalerr(402,NULL);
+
+   StrLoc(sdp) = s;
+   StrLen(sdp) = strlen(s);
+#else					/* COMPILER */
+   struct pf_marker *fp = pfp;
+#endif					/* COMPILER */
+
+   /*
+    * Is it a keyword that's a variable?
+    */
+   if (*s == '&') {
+
+      if (strcmp(s,"&error") == 0) {	/* must put basic one first */
+         vp->dword = D_Kywdint;
+         VarLoc(*vp) = &kywd_err;
+         return Succeeded;
+         }
+      else if (strcmp(s,"&pos") == 0) {
+         vp->dword = D_Kywdpos;
+         VarLoc(*vp) = &kywd_pos;
+         return Succeeded;
+         }
+      else if (strcmp(s,"&progname") == 0) {
+         vp->dword = D_Kywdstr;
+         VarLoc(*vp) = &kywd_prog;
+         return Succeeded;
+         }
+      else if (strcmp(s,"&random") == 0) {
+         vp->dword = D_Kywdint;
+         VarLoc(*vp) = &kywd_ran;
+         return Succeeded;
+         }
+      else if (strcmp(s,"&subject") == 0) {
+         vp->dword = D_Kywdsubj;
+         VarLoc(*vp) = &k_subject;
+         return Succeeded;
+         }
+      else if (strcmp(s,"&trace") == 0) {
+         vp->dword = D_Kywdint;
+         VarLoc(*vp) = &kywd_trc;
+         return Succeeded;
+         }
+
+#ifdef FncTrace
+      else if (strcmp(s,"&ftrace") == 0) {
+         vp->dword = D_Kywdint;
+         VarLoc(*vp) = &kywd_ftrc;
+         return Succeeded;
+         }
+#endif					/* FncTrace */
+
+      else if (strcmp(s,"&dump") == 0) {
+         vp->dword = D_Kywdint;
+         VarLoc(*vp) = &kywd_dmp;
+         return Succeeded;
+         }
+#ifdef Graphics
+      else if (strcmp(s,"&window") == 0) {
+         vp->dword = D_Kywdwin;
+         VarLoc(*vp) = &(kywd_xwin[XKey_Window]);
+         return Succeeded;
+         }
+#endif					/* Graphics */
+
+#ifdef MultiThread
+      else if (strcmp(s,"&eventvalue") == 0) {
+         vp->dword = D_Var;
+         VarLoc(*vp) = (dptr)&(curpstate->eventval);
+         return Succeeded;
+         }
+      else if (strcmp(s,"&eventsource") == 0) {
+         vp->dword = D_Var;
+         VarLoc(*vp) = (dptr)&(curpstate->eventsource);
+         return Succeeded;
+         }
+      else if (strcmp(s,"&eventcode") == 0) {
+         vp->dword = D_Var;
+         VarLoc(*vp) = (dptr)&(curpstate->eventcode);
+         return Succeeded;
+         }
+#endif					/* MultiThread */
+
+      else return Failed;
+      }
+
+   /*
+    * Look for the variable the name with the local identifiers,
+    *  parameters, and static names in each Icon procedure frame on the
+    *  stack. If not found among the locals, check the global variables.
+    *  If a variable with name is found, variable() returns a variable
+    *  descriptor that points to the corresponding value descriptor.
+    *  If no such variable exits, it fails.
+    */
+
+#if !COMPILER
+   /*
+    *  If no procedure has been called (as can happen with icon_call(),
+    *  dont' try to find local identifier.
+    */
+   if (pfp == NULL)
+      goto glbvars;
+#endif					/* !COMPILER */
+
+   dp = glbl_argp;
+#if COMPILER
+   bp = PFDebug(*pfp)->proc;  /* get address of procedure block */
+#else					/* COMPILER */
+   bp = (struct b_proc *)BlkLoc(*dp);	/* get address of procedure block */
+#endif					/* COMPILER */
+
+   np = bp->lnames;		/* Check the formal parameter names. */
+
+   for (i = abs((int)bp->nparam); i > 0; i--) {
+#if COMPILER
+      if (eq(&sdp, np) == 1) {
+#else					/* COMPILER */
+      dp++;
+      if (strcmp(s,StrLoc(*np)) == 0) {
+#endif					/* COMPILER */
+         vp->dword = D_Var;
+         VarLoc(*vp) = (dptr)dp;
+         return ParamName;
+         }
+      np++;
+#if COMPILER
+      dp++;
+#endif					/* COMPILER */
+      }
+
+#if COMPILER
+   dp = &pfp->tend.d[0];
+#else					/* COMPILER */
+   dp = &fp->pf_locals[0];
+#endif					/* COMPILER */
+
+   for (i = (int)bp->ndynam; i > 0; i--) { /* Check the local dynamic names. */
+#if COMPILER
+         if (eq(&sdp, np)) {
+#else					/* COMPILER */
+	 if (strcmp(s,StrLoc(*np)) == 0) {
+#endif					/* COMPILER */
+            vp->dword = D_Var;
+            VarLoc(*vp) = (dptr)dp;
+            return LocalName;
+	    }
+         np++;
+         dp++;
+         }
+
+   dp = &statics[bp->fstatic]; /* Check the local static names. */
+   for (i = (int)bp->nstatic; i > 0; i--) {
+#if COMPILER
+         if (eq(&sdp, np)) {
+#else					/* COMPILER */
+         if (strcmp(s,StrLoc(*np)) == 0) {
+#endif					/* COMPILER */
+            vp->dword = D_Var;
+            VarLoc(*vp) = (dptr)dp;
+            return StaticName;
+	    }
+         np++;
+         dp++;
+         }
+
+#if COMPILER
+   for (i = 0; i < n_globals; ++i) {
+      if (eq(&sdp, &gnames[i])) {
+         vp->dword = D_Var;
+         VarLoc(*vp) = (dptr)&globals[i];
+         return GlobalName;
+         }
+      }
+#else					/* COMPILER */
+glbvars:
+   dp = globals;	/* Check the global variable names. */
+   np = gnames;
+   while (dp < eglobals) {
+      if (strcmp(s,StrLoc(*np)) == 0) {
+         vp->dword    =  D_Var;
+         VarLoc(*vp) =  (dptr)(dp);
+         return GlobalName;
+         }
+      np++;
+      dp++;
+      }
+#endif					/* COMPILER */
+   return Failed;
+   }
+
+/*
+ * hash - compute hash value of arbitrary object for table and set accessing.
+ */
+
+uword hash(dp)
+dptr dp;
+   {
+   register char *s;
+   register uword i;
+   register word j, n;
+   register unsigned int *bitarr;
+   double r;
+
+   if (Qual(*dp)) {
+   hashstring:
+      /*
+       * Compute the hash value for the string based on a scaled sum
+       *  of its first ten characters, plus its length.
+       */
+      i = 0;
+      s = StrLoc(*dp);
+      j = n = StrLen(*dp);
+      if (j > 10)		/* limit scan to first ten characters */
+         j = 10;
+      while (j-- > 0) {
+         i += *s++ & 0xFF;	/* add unsigned version of next char */
+         i *= 37;		/* scale total by a nice prime number */
+         }
+      i += n;			/* add the (untruncated) string length */
+      }
+
+   else {
+
+      switch (Type(*dp)) {
+         /*
+          * The hash value of an integer is itself times eight times the golden
+	  *  ratio.  We do this calculation in fixed point.  We don't just use
+	  *  the integer itself, for that would give bad results with sets
+	  *  having entries that are multiples of a power of two.
+          */
+         case T_Integer:
+            i = (13255 * (uword)IntVal(*dp)) >> 10;
+            break;
+
+#ifdef LargeInts
+         /*
+          * The hash value of a bignum is based on its length and its
+          *  most and least significant digits.
+          */
+	 case T_Lrgint:
+	    {
+	    struct b_bignum *b = &BlkLoc(*dp)->bignumblk;
+
+	    i = ((b->lsd - b->msd) << 16) ^
+		(b->digits[b->msd] << 8) ^ b->digits[b->lsd];
+	    }
+	    break;
+#endif					/* LargeInts */
+
+         /*
+          * The hash value of a real number is itself times a constant,
+          *  converted to an unsigned integer.  The intent is to scramble
+	  *  the bits well, in the case of integral values, and to scale up
+	  *  fractional values so they don't all land in the same bin.
+	  *  The constant below is 32749 / 29, the quotient of two primes,
+	  *  and was observed to work well in empirical testing.
+          */
+         case T_Real:
+            GetReal(dp,r);
+            i = r * 1129.27586206896558;
+            break;
+
+         /*
+          * The hash value of a cset is based on a convoluted combination
+          *  of all its bits.
+          */
+         case T_Cset:
+            i = 0;
+            bitarr = BlkLoc(*dp)->cset.bits + CsetSize - 1;
+            for (j = 0; j < CsetSize; j++) {
+               i += *bitarr--;
+               i *= 37;			/* better distribution */
+               }
+            i %= 1048583;		/* scramble the bits */
+            break;
+
+         /*
+          * The hash value of a list, set, table, or record is its id,
+          *   hashed like an integer.
+          */
+         case T_List:
+            i = (13255 * BlkLoc(*dp)->list.id) >> 10;
+            break;
+
+         case T_Set:
+            i = (13255 * BlkLoc(*dp)->set.id) >> 10;
+            break;
+
+         case T_Table:
+            i = (13255 * BlkLoc(*dp)->table.id) >> 10;
+            break;
+
+         case T_Record:
+            i = (13255 * BlkLoc(*dp)->record.id) >> 10;
+            break;
+
+	 case T_Proc:
+	    dp = &(BlkLoc(*dp)->proc.pname);
+	    goto hashstring;
+
+         default:
+            /*
+             * For other types, use the type code as the hash
+             *  value.
+             */
+            i = Type(*dp);
+            break;
+         }
+      }
+
+   return i;
+   }
+
+
+#define StringLimit	16		/* limit on length of imaged string */
+#define ListLimit	 6		/* limit on list items in image */
+
+/*
+ * outimage - print image of *dp on file f.  If noimage is nonzero,
+ *  fields of records will not be imaged.
+ */
+
+void outimage(f, dp, noimage)
+FILE *f;
+dptr dp;
+int noimage;
+   {
+   register word i, j;
+   register char *s;
+   register union block *bp;
+   char *type, *csn;
+   FILE *fd;
+   struct descrip q;
+   double rresult;
+   tended struct descrip tdp;
+
+   type_case *dp of {
+      string: {
+         /*
+          * *dp is a string qualifier.  Print StringLimit characters of it
+          *  using printimage and denote the presence of additional characters
+          *  by terminating the string with "...".
+          */
+         i = StrLen(*dp);
+         s = StrLoc(*dp);
+         j = Min(i, StringLimit);
+         putc('"', f);
+         while (j-- > 0)
+            printimage(f, *s++, '"');
+         if (i > StringLimit)
+            fprintf(f, "...");
+         putc('"', f);
+         }
+
+      null:
+         fprintf(f, "&null");
+
+      integer:
+
+#ifdef LargeInts
+         if (Type(*dp) == T_Lrgint)
+            bigprint(f, dp);
+         else
+            fprintf(f, "%ld", (long)IntVal(*dp));
+#else					/* LargeInts */
+         fprintf(f, "%ld", (long)IntVal(*dp));
+#endif					/* LargeInts */
+
+      real: {
+         char s[30];
+         struct descrip rd;
+
+         GetReal(dp,rresult);
+         rtos(rresult, &rd, s);
+         fprintf(f, "%s", StrLoc(rd));
+         }
+
+      cset: {
+         /*
+	  * Check for a predefined cset; use keyword name if found.
+	  */
+	 if ((csn = csname(dp)) != NULL) {
+	    fprintf(f, csn);
+	    return;
+	    }
+         /*
+          * Use printimage to print each character in the cset.  Follow
+          *  with "..." if the cset contains more than StringLimit
+          *  characters.
+          */
+         putc('\'', f);
+         j = StringLimit;
+         for (i = 0; i < 256; i++) {
+            if (Testb(i, *dp)) {
+               if (j-- <= 0) {
+                  fprintf(f, "...");
+                  break;
+                  }
+               printimage(f, (int)i, '\'');
+               }
+            }
+         putc('\'', f);
+         }
+
+      file: {
+         /*
+          * Check for distinguished files by looking at the address of
+          *  of the object to image.  If one is found, print its name.
+          */
+         if ((fd = BlkLoc(*dp)->file.fd) == stdin)
+            fprintf(f, "&input");
+         else if (fd == stdout)
+            fprintf(f, "&output");
+         else if (fd == stderr)
+            fprintf(f, "&errout");
+         else {
+            /*
+             * The file isn't a special one, just print "file(name)".
+             */
+	    i = StrLen(BlkLoc(*dp)->file.fname);
+	    s = StrLoc(BlkLoc(*dp)->file.fname);
+#ifdef Graphics
+	    if (BlkLoc(*dp)->file.status & Fs_Window) {
+	       s = ((wbp)(BlkLoc(*dp)->file.fd))->window->windowlabel;
+	       i = strlen(s);
+	       fprintf(f, "window_%d:%d(",
+		       ((wbp)BlkLoc(*dp)->file.fd)->window->serial,
+		       ((wbp)BlkLoc(*dp)->file.fd)->context->serial
+		       );
+	       }
+	    else
+#endif					/* Graphics */
+	       fprintf(f, "file(");
+	    while (i-- > 0)
+	       printimage(f, *s++, '\0');
+	    putc(')', f);
+            }
+         }
+
+      proc: {
+         /*
+          * Produce one of:
+          *  "procedure name"
+          *  "function name"
+          *  "record constructor name"
+          *
+          * Note that the number of dynamic locals is used to determine
+          *  what type of "procedure" is at hand.
+          */
+         i = StrLen(BlkLoc(*dp)->proc.pname);
+         s = StrLoc(BlkLoc(*dp)->proc.pname);
+         switch ((int)BlkLoc(*dp)->proc.ndynam) {
+            default:  type = "procedure"; break;
+            case -1:  type = "function"; break;
+            case -2:  type = "record constructor"; break;
+            }
+         fprintf(f, "%s ", type);
+         while (i-- > 0)
+            printimage(f, *s++, '\0');
+         }
+
+      list: {
+         /*
+          * listimage does the work for lists.
+          */
+         listimage(f, (struct b_list *)BlkLoc(*dp), noimage);
+         }
+
+      table: {
+         /*
+          * Print "table_m(n)" where n is the size of the table.
+          */
+         fprintf(f, "table_%ld(%ld)", (long)BlkLoc(*dp)->table.id,
+            (long)BlkLoc(*dp)->table.size);
+         }
+
+      set: {
+	/*
+         * print "set_m(n)" where n is the cardinality of the set
+         */
+	fprintf(f,"set_%ld(%ld)",(long)BlkLoc(*dp)->set.id,
+           (long)BlkLoc(*dp)->set.size);
+        }
+
+      record: {
+         /*
+          * If noimage is nonzero, print "record(n)" where n is the
+          *  number of fields in the record.  If noimage is zero, print
+          *  the image of each field instead of the number of fields.
+          */
+         bp = BlkLoc(*dp);
+         i = StrLen(bp->record.recdesc->proc.recname);
+         s = StrLoc(bp->record.recdesc->proc.recname);
+         fprintf(f, "record ");
+         while (i-- > 0)
+            printimage(f, *s++, '\0');
+         fprintf(f, "_%ld", (long)bp->record.id);
+         j = bp->record.recdesc->proc.nfields;
+         if (j <= 0)
+            fprintf(f, "()");
+         else if (noimage > 0)
+            fprintf(f, "(%ld)", (long)j);
+         else {
+            putc('(', f);
+            i = 0;
+            for (;;) {
+               outimage(f, &bp->record.fields[i], noimage+1);
+               if (++i >= j)
+                  break;
+               putc(',', f);
+               }
+            putc(')', f);
+            }
+         }
+
+      coexpr: {
+         fprintf(f, "co-expression_%ld(%ld)",
+            (long)((struct b_coexpr *)BlkLoc(*dp))->id,
+            (long)((struct b_coexpr *)BlkLoc(*dp))->size);
+         }
+
+      tvsubs: {
+         /*
+          * Produce "v[i+:j] = value" where v is the image of the variable
+          *  containing the substring, i is starting position of the substring
+          *  j is the length, and value is the string v[i+:j].	If the length
+          *  (j) is one, just produce "v[i] = value".
+          */
+         bp = BlkLoc(*dp);
+	 dp = VarLoc(bp->tvsubs.ssvar);
+         if (is:kywdsubj(bp->tvsubs.ssvar)) {
+            fprintf(f, "&subject");
+            fflush(f);
+            }
+         else {
+            dp = (dptr)((word *)dp + Offset(bp->tvsubs.ssvar));
+            outimage(f, dp, noimage);
+            }
+
+         if (bp->tvsubs.sslen == 1)
+            fprintf(f, "[%ld]", (long)bp->tvsubs.sspos);
+         else
+            fprintf(f, "[%ld+:%ld]", (long)bp->tvsubs.sspos,
+               (long)bp->tvsubs.sslen);
+
+         if (Qual(*dp)) {
+            if (bp->tvsubs.sspos + bp->tvsubs.sslen - 1 > StrLen(*dp))
+               return;
+            StrLen(q) = bp->tvsubs.sslen;
+            StrLoc(q) = StrLoc(*dp) + bp->tvsubs.sspos - 1;
+            fprintf(f, " = ");
+            outimage(f, &q, noimage);
+            }
+        }
+
+      tvtbl: {
+         /*
+          * produce "t[s]" where t is the image of the table containing
+          *  the element and s is the image of the subscript.
+          */
+         bp = BlkLoc(*dp);
+	 tdp.dword = D_Table;
+	 BlkLoc(tdp) = bp->tvtbl.clink;
+         outimage(f, &tdp, noimage);
+         putc('[', f);
+         outimage(f, &bp->tvtbl.tref, noimage);
+         putc(']', f);
+         }
+
+      kywdint: {
+         if (VarLoc(*dp) == &kywd_ran)
+            fprintf(f, "&random = ");
+         else if (VarLoc(*dp) == &kywd_trc)
+            fprintf(f, "&trace = ");
+
+#ifdef FncTrace
+         else if (VarLoc(*dp) == &kywd_ftrc)
+            fprintf(f, "&ftrace = ");
+#endif					/* FncTrace */
+
+         else if (VarLoc(*dp) == &kywd_dmp)
+            fprintf(f, "&dump = ");
+         else if (VarLoc(*dp) == &kywd_err)
+            fprintf(f, "&error = ");
+         outimage(f, VarLoc(*dp), noimage);
+         }
+
+      kywdevent: {
+#ifdef MultiThread
+         if (VarLoc(*dp) == &curpstate->eventsource)
+            fprintf(f, "&eventsource = ");
+         else if (VarLoc(*dp) == &curpstate->eventcode)
+            fprintf(f, "&eventcode = ");
+         else if (VarLoc(*dp) == &curpstate->eventval)
+            fprintf(f, "&eventval = ");
+#endif					/* MultiThread */
+         outimage(f, VarLoc(*dp), noimage);
+         }
+
+      kywdstr: {
+         outimage(f, VarLoc(*dp), noimage);
+         }
+
+      kywdpos: {
+         fprintf(f, "&pos = ");
+         outimage(f, VarLoc(*dp), noimage);
+         }
+
+      kywdsubj: {
+         fprintf(f, "&subject = ");
+         outimage(f, VarLoc(*dp), noimage);
+         }
+      kywdwin: {
+         fprintf(f, "&window = ");
+         outimage(f, VarLoc(*dp), noimage);
+         }
+
+      default: {
+         if (is:variable(*dp)) {
+            /*
+             * *d is a variable.  Print "variable =", dereference it, and
+             *  call outimage to handle the value.
+             */
+            fprintf(f, "(variable = ");
+            dp = (dptr)((word *)VarLoc(*dp) + Offset(*dp));
+            outimage(f, dp, noimage);
+            putc(')', f);
+            }
+         else if (Type(*dp) == T_External)
+            fprintf(f, "external(%d)",((struct b_external *)BlkLoc(*dp))->blksize);
+         else if (Type(*dp) <= MaxType)
+            fprintf(f, "%s", blkname[Type(*dp)]);
+         else
+            syserr("outimage: unknown type");
+         }
+      }
+   }
+
+/*
+ * printimage - print character c on file f using escape conventions
+ *  if c is unprintable, '\', or equal to q.
+ */
+
+static void printimage(f, c, q)
+FILE *f;
+int c, q;
+   {
+   if (printable(c)) {
+      /*
+       * c is printable, but special case ", ', and \.
+       */
+      switch (c) {
+         case '"':
+            if (c != q) goto deflt;
+            fprintf(f, "\\\"");
+            return;
+         case '\'':
+            if (c != q) goto deflt;
+            fprintf(f, "\\'");
+            return;
+         case '\\':
+            fprintf(f, "\\\\");
+            return;
+         default:
+         deflt:
+            putc(c, f);
+            return;
+         }
+      }
+
+   /*
+    * c is some sort of unprintable character.	If it one of the common
+    *  ones, produce a special representation for it, otherwise, produce
+    *  its hex value.
+    */
+   switch (c) {
+      case '\b':			/* backspace */
+         fprintf(f, "\\b");
+         return;
+      case '\177':			/* delete */
+         fprintf(f, "\\d");
+         return;
+      case '\33':			/* escape */
+         fprintf(f, "\\e");
+         return;
+      case '\f':			/* form feed */
+         fprintf(f, "\\f");
+         return;
+      case '\n':			/* newline (line feed) */
+         fprintf(f, "\\n");
+         return;
+      case '\r':			/* carriage return */
+         fprintf(f, "\\r");
+         return;
+      case '\t':			/* horizontal tab */
+         fprintf(f, "\\t");
+         return;
+      case '\13':			/* vertical tab */
+         fprintf(f, "\\v");
+         return;
+      default:				/* hex escape sequence */
+         fprintf(f, "\\x%02x", c & 0xff);
+         return;
+      }
+   }
+
+/*
+ * listimage - print an image of a list.
+ */
+
+static void listimage(f, lp, noimage)
+FILE *f;
+struct b_list *lp;
+int noimage;
+   {
+   register word i, j;
+   register struct b_lelem *bp;
+   word size, count;
+
+   bp = (struct b_lelem *) lp->listhead;
+   size = lp->size;
+
+   if (noimage > 0 && size > 0) {
+      /*
+       * Just give indication of size if the list isn't empty.
+       */
+      fprintf(f, "list_%ld(%ld)", (long)lp->id, (long)size);
+      return;
+      }
+
+   /*
+    * Print [e1,...,en] on f.  If more than ListLimit elements are in the
+    *  list, produce the first ListLimit/2 elements, an ellipsis, and the
+    *  last ListLimit elements.
+    */
+   fprintf(f, "list_%ld = [", (long)lp->id);
+   count = 1;
+   i = 0;
+   if (size > 0) {
+      for (;;) {
+         if (++i > bp->nused) {
+            i = 1;
+            bp = (struct b_lelem *) bp->listnext;
+            }
+         if (count <= ListLimit/2 || count > size - ListLimit/2) {
+            j = bp->first + i - 1;
+            if (j >= bp->nslots)
+               j -= bp->nslots;
+            outimage(f, &bp->lslots[j], noimage+1);
+            if (count >= size)
+               break;
+            putc(',', f);
+            }
+         else if (count == ListLimit/2 + 1)
+            fprintf(f, "...,");
+         count++;
+         }
+      }
+   putc(']', f);
+   }
+
+/*
+ * qsearch(key,base,nel,width,compar) - binary search
+ *
+ *  A binary search routine with arguments similar to qsort(3).
+ *  Returns a pointer to the item matching "key", or NULL if none.
+ *  Based on Bentley, CACM 28,7 (July, 1985), p. 676.
+ */
+
+char * qsearch (key, base, nel, width, compar)
+char * key;
+char * base;
+int nel, width;
+int (*compar)();
+{
+    int l, u, m, r;
+    char * a;
+
+    l = 0;
+    u = nel - 1;
+    while (l <= u) {
+	m = (l + u) / 2;
+	a = (char *) ((char *) base + width * m);
+	r = compar (a, key);
+	if (r < 0)
+	    l = m + 1;
+	else if (r > 0)
+	    u = m - 1;
+	else
+	    return a;
+    }
+    return 0;
+}
+
+#if !COMPILER
+/*
+ * qtos - convert a qualified string named by *dp to a C-style string.
+ *  Put the C-style string in sbuf if it will fit, otherwise put it
+ *  in the string region.
+ */
+
+int qtos(dp, sbuf)
+dptr dp;
+char *sbuf;
+   {
+   register word slen;
+   register char *c, *s;
+
+   c = StrLoc(*dp);
+   slen = StrLen(*dp)++;
+   if (slen >= MaxCvtLen) {
+      Protect(reserve(Strings, slen+1), return Error);
+      c = StrLoc(*dp);
+      if (c + slen != strfree) {
+         Protect(s = alcstr(c, slen), return Error);
+         }
+      else
+         s = c;
+      StrLoc(*dp) = s;
+      Protect(alcstr("",(word)1), return Error);
+      }
+   else {
+      StrLoc(*dp) = sbuf;
+      for ( ; slen > 0; slen--)
+         *sbuf++ = *c++;
+      *sbuf = '\0';
+      }
+   return Succeeded;
+   }
+#endif					/* !COMPILER */
+
+#ifdef Coexpr
+/*
+ * pushact - push actvtr on the activator stack of ce
+ */
+int pushact(ce, actvtr)
+struct b_coexpr *ce, *actvtr;
+{
+   struct astkblk *abp = ce->es_actstk, *nabp;
+   struct actrec *arp;
+
+#ifdef MultiThread
+   abp->arec[0].activator = actvtr;
+#else					/* MultiThread */
+
+   /*
+    * If the last activator is the same as this one, just increment
+    *  its count.
+    */
+   if (abp->nactivators > 0) {
+      arp = &abp->arec[abp->nactivators - 1];
+      if (arp->activator == actvtr) {
+         arp->acount++;
+         return Succeeded;
+         }
+      }
+   /*
+    * This activator is different from the last one.  Push this activator
+    *  on the stack, possibly adding another block.
+    */
+   if (abp->nactivators + 1 > ActStkBlkEnts) {
+      Protect(nabp = alcactiv(), fatalerr(0,NULL));
+      nabp->astk_nxt = abp;
+      abp = nabp;
+      }
+   abp->nactivators++;
+   arp = &abp->arec[abp->nactivators - 1];
+   arp->acount = 1;
+   arp->activator = actvtr;
+   ce->es_actstk = abp;
+#endif					/* MultiThread */
+   return Succeeded;
+}
+#endif					/* Coexpr */
+
+/*
+ * popact - pop the most recent activator from the activator stack of ce
+ *  and return it.
+ */
+struct b_coexpr *popact(ce)
+struct b_coexpr *ce;
+{
+
+#ifdef Coexpr
+
+   struct astkblk *abp = ce->es_actstk, *oabp;
+   struct actrec *arp;
+   struct b_coexpr *actvtr;
+
+#ifdef MultiThread
+   return abp->arec[0].activator;
+#else					/* MultiThread */
+
+   /*
+    * If the current stack block is empty, pop it.
+    */
+   if (abp->nactivators == 0) {
+      oabp = abp;
+      abp = abp->astk_nxt;
+      free((pointer)oabp);
+      }
+
+   if (abp == NULL || abp->nactivators == 0)
+      syserr("empty activator stack\n");
+
+   /*
+    * Find the activation record for the most recent co-expression.
+    *  Decrement the activation count and if it is zero, pop that
+    *  activation record and decrement the count of activators.
+    */
+   arp = &abp->arec[abp->nactivators - 1];
+   actvtr = arp->activator;
+   if (--arp->acount == 0)
+      abp->nactivators--;
+
+   ce->es_actstk = abp;
+   return actvtr;
+#endif					/* MultiThread */
+
+#else					/* Coexpr */
+    syserr("popact() called, but co-expressions not implemented");
+#endif					/* Coexpr */
+
+}
+
+#ifdef Coexpr
+/*
+ * topact - return the most recent activator of ce.
+ */
+struct b_coexpr *topact(ce)
+struct b_coexpr *ce;
+{
+   struct astkblk *abp = ce->es_actstk;
+
+#ifdef MultiThread
+   return abp->arec[0].activator;
+#else					/* MultiThread */
+   if (abp->nactivators == 0)
+      abp = abp->astk_nxt;
+   return abp->arec[abp->nactivators-1].activator;
+#endif					/* MultiThread */
+}
+
+#ifdef DeBugIconx
+/*
+ * dumpact - dump an activator stack
+ */
+void dumpact(ce)
+struct b_coexpr *ce;
+{
+   struct astkblk *abp = ce->es_actstk;
+   struct actrec *arp;
+   int i;
+
+   if (abp)
+      fprintf(stderr, "Ce %ld ", (long)ce->id);
+   while (abp) {
+      fprintf(stderr, "--- Activation stack block (%x) --- nact = %d\n",
+         abp, abp->nactivators);
+      for (i = abp->nactivators; i >= 1; i--) {
+         arp = &abp->arec[i-1];
+         /*for (j = 1; j <= arp->acount; j++)*/
+         fprintf(stderr, "co-expression_%ld(%d)\n", (long)(arp->activator->id),
+            arp->acount);
+         }
+      abp = abp->astk_nxt;
+      }
+}
+#endif					/* DeBugIconx */
+#endif					/* Coexpr */
+
+#if !COMPILER
+/*
+ * findline - find the source line number associated with the ipc
+ */
+#ifdef SrcColumnInfo
+int findline(ipc)
+word *ipc;
+{
+  return findloc(ipc) & 65535;
+}
+int findcol(ipc)
+word *ipc;
+{
+  return findloc(ipc) >> 16;
+}
+
+int findloc(ipc)
+#else					/* SrcColumnInfo */
+int findline(ipc)
+#endif					/* SrcColumnInfo */
+word *ipc;
+{
+   uword ipc_offset;
+   uword size;
+   struct ipc_line *base;
+
+#ifndef MultiThread
+   extern struct ipc_line *ilines, *elines;
+#endif					/* MultiThread */
+
+   static int two = 2;	/* some compilers generate bad code for division
+			   by a constant that is a power of two ... */
+
+   if (!InRange(code,ipc,ecode))
+      return 0;
+   ipc_offset = DiffPtrs((char *)ipc,(char *)code);
+   base = ilines;
+   size = DiffPtrs((char *)elines,(char *)ilines) / sizeof(struct ipc_line *);
+   while (size > 1) {
+      if (ipc_offset >= base[size / two].ipc) {
+         base = &base[size / two];
+         size -= size / two;
+         }
+      else
+         size = size / two;
+      }
+   /*
+    * return the line component of the location (column is top 16 bits)
+    */
+   return (int)(base->line);
+}
+/*
+ * findipc - find the first ipc associated with a source-code line number.
+ */
+int findipc(line)
+int line;
+{
+   uword size;
+   struct ipc_line *base;
+
+#ifndef MultiThread
+   extern struct ipc_line *ilines, *elines;
+#endif					/* MultiThread */
+
+   static int two = 2;	/* some compilers generate bad code for division
+			   by a constant that is a power of two ... */
+
+   base = ilines;
+   size = DiffPtrs((char *)elines,(char *)ilines) / sizeof(struct ipc_line *);
+   while (size > 1) {
+      if (line >= base[size / two].line) {
+         base = &base[size / two];
+         size -= size / two;
+         }
+      else
+         size = size / two;
+      }
+   return base->ipc;
+}
+
+/*
+ * findfile - find source file name associated with the ipc
+ */
+char *findfile(ipc)
+word *ipc;
+{
+   uword ipc_offset;
+   struct ipc_fname *p;
+
+#ifndef MultiThread
+   extern struct ipc_fname *filenms, *efilenms;
+#endif					/* MultiThread */
+
+   if (!InRange(code,ipc,ecode))
+      return "?";
+   ipc_offset = DiffPtrs((char *)ipc,(char *)code);
+   for (p = efilenms - 1; p >= filenms; p--)
+      if (ipc_offset >= p->ipc)
+         return strcons + p->fname;
+   fprintf(stderr,"bad ipc/file name table\n");
+   fflush(stderr);
+   c_exit(EXIT_FAILURE);
+   /*NOTREACHED*/
+   return 0;  /* avoid gcc warning */
+}
+#endif					/* !COMPILER */
+
+/*
+ * doimage(c,q) - allocate character c in string space, with escape
+ *  conventions if c is unprintable, '\', or equal to q.
+ *  Returns number of characters allocated.
+ */
+
+int doimage(c, q)
+int c, q;
+   {
+   static char cbuf[5];
+
+   if (printable(c)) {
+
+      /*
+       * c is printable, but special case ", ', and \.
+       */
+      switch (c) {
+         case '"':
+            if (c != q) goto deflt;
+            Protect(alcstr("\\\"", (word)(2)), return Error);
+            return 2;
+         case '\'':
+            if (c != q) goto deflt;
+            Protect(alcstr("\\'", (word)(2)), return Error);
+            return 2;
+         case '\\':
+            Protect(alcstr("\\\\", (word)(2)), return Error);
+            return 2;
+         default:
+         deflt:
+            cbuf[0] = c;
+            Protect(alcstr(cbuf, (word)(1)), return Error);
+            return 1;
+         }
+      }
+
+   /*
+    * c is some sort of unprintable character.	If it is one of the common
+    *  ones, produce a special representation for it, otherwise, produce
+    *  its hex value.
+    */
+   switch (c) {
+      case '\b':			/*	   backspace	*/
+         Protect(alcstr("\\b", (word)(2)), return Error);
+         return 2;
+      case '\177':			/*      delete	  */
+         Protect(alcstr("\\d", (word)(2)), return Error);
+         return 2;
+      case '\33':			/*	    escape	 */
+         Protect(alcstr("\\e", (word)(2)), return Error);
+         return 2;
+      case '\f':			/*	   form feed	*/
+         Protect(alcstr("\\f", (word)(2)), return Error);
+         return 2;
+      case '\n':			/*	   new line	*/
+         Protect(alcstr("\\n", (word)(2)), return Error);
+         return 2;
+      case '\r':			/*	   return	*/
+         Protect(alcstr("\\r", (word)(2)), return Error);
+         return 2;
+      case '\t':			/*	   horizontal tab     */
+         Protect(alcstr("\\t", (word)(2)), return Error);
+         return 2;
+      case '\13':			/*	    vertical tab     */
+         Protect(alcstr("\\v", (word)(2)), return Error);
+         return 2;
+      default:				/*	  hex escape sequence  */
+         sprintf(cbuf, "\\x%02x", c & 0xff);
+         Protect(alcstr(cbuf, (word)(4)), return Error);
+         return 4;
+      }
+   }
+
+/*
+ * getimage(dp1,dp2) - return string image of object dp1 in dp2.
+ */
+
+int getimage(dp1,dp2)
+dptr dp1, dp2;
+   {
+   register word len, outlen, rnlen;
+   int i;
+   tended char *s;
+   tended struct descrip source = *dp1;    /* the source may move during gc */
+   register union block *bp;
+   char *type, *t, *csn;
+   char sbuf[MaxCvtLen];
+   FILE *fd;
+
+   type_case source of {
+      string: {
+         /*
+          * Form the image by putting a quote in the string space, calling
+          *  doimage with each character in the string, and then putting
+          *  a quote at then end. Note that doimage directly writes into the
+          *  string space.  (Hence the indentation.)  This technique is used
+          *  several times in this routine.
+          */
+         s = StrLoc(source);
+         len = StrLen(source);
+	 Protect (reserve(Strings, (len << 2) + 2), return Error);
+         Protect(t = alcstr("\"", (word)(1)), return Error);
+         StrLoc(*dp2) = t;
+         StrLen(*dp2) = 1;
+
+         while (len-- > 0)
+            StrLen(*dp2) += doimage(*s++, '"');
+         Protect(alcstr("\"", (word)(1)), return Error);
+         ++StrLen(*dp2);
+         }
+
+      null: {
+         StrLoc(*dp2) = "&null";
+         StrLen(*dp2) = 5;
+         }
+
+      integer: {
+#ifdef LargeInts
+         if (Type(source) == T_Lrgint) {
+            word slen;
+            word dlen;
+            struct b_bignum *blk = &BlkLoc(source)->bignumblk;
+
+            slen = blk->lsd - blk->msd;
+            dlen = slen * NB * 0.3010299956639812	/* 1 / log2(10) */
+               + log((double)blk->digits[blk->msd]) * 0.4342944819032518 + 0.5;
+							/* 1 / ln(10) */
+            if (dlen >= MaxDigits) {
+               sprintf(sbuf, "integer(~10^%ld)", (long)dlen);
+	       len = strlen(sbuf);
+               Protect(StrLoc(*dp2) = alcstr(sbuf,len), return Error);
+
+
+               StrLen(*dp2) = len;
+               }
+	    else bigtos(&source,dp2);
+	    }
+         else
+            cnv: string(source, *dp2);
+#else					/* LargeInts */
+         cnv:string(source, *dp2);
+#endif					/* LargeInts */
+	 }
+
+      real: {
+         cnv:string(source, *dp2);
+         }
+
+      cset: {
+         /*
+	  * Check for the value of a predefined cset; use keyword name if found.
+	  */
+	 if ((csn = csname(dp1)) != NULL) {
+	    StrLoc(*dp2) = csn;
+	    StrLen(*dp2) = strlen(csn);
+	    return Succeeded;
+	    }
+	 /*
+	  * Otherwise, describe it in terms of the character membership.
+	  */
+
+	 i = BlkLoc(source)->cset.size;
+	 if (i < 0)
+	    i = cssize(&source);
+	 i = (i << 2) + 2;
+	 if (i > 730) i = 730;
+	 Protect (reserve(Strings, i), return Error);
+
+         Protect(t = alcstr("'", (word)(1)), return Error);
+         StrLoc(*dp2) = t;
+         StrLen(*dp2) = 1;
+         for (i = 0; i < 256; ++i)
+            if (Testb(i, source))
+               StrLen(*dp2) += doimage((char)i, '\'');
+         Protect(alcstr("'", (word)(1)), return Error);
+         ++StrLen(*dp2);
+         }
+
+      file: {
+         /*
+          * Check for distinguished files by looking at the address of
+          *  of the object to image.  If one is found, make a string
+          *  naming it and return.
+          */
+         if ((fd = BlkLoc(source)->file.fd) == stdin) {
+            StrLen(*dp2) = 6;
+            StrLoc(*dp2) = "&input";
+            }
+         else if (fd == stdout) {
+            StrLen(*dp2) = 7;
+            StrLoc(*dp2) = "&output";
+            }
+         else if (fd == stderr) {
+            StrLen(*dp2) = 7;
+            StrLoc(*dp2) = "&errout";
+            }
+         else {
+            /*
+             * The file is not a standard one; form a string of the form
+             *	file(nm) where nm is the argument originally given to
+             *	open.
+             */
+#ifdef Graphics
+	    if (BlkLoc(source)->file.status & Fs_Window) {
+	       s = ((wbp)(BlkLoc(source)->file.fd))->window->windowlabel;
+	       len = strlen(s);
+               Protect (reserve(Strings, (len << 2) + 16), return Error);
+	       sprintf(sbuf, "window_%d:%d(",
+		       ((wbp)BlkLoc(source)->file.fd)->window->serial,
+		       ((wbp)BlkLoc(source)->file.fd)->context->serial
+		       );
+	       Protect(t = alcstr(sbuf, (word)(strlen(sbuf))), return Error);
+	       StrLoc(*dp2) = t;
+	       StrLen(*dp2) = strlen(sbuf);
+	       }
+	    else {
+#endif					/* Graphics */
+               s = StrLoc(BlkLoc(source)->file.fname);
+               len = StrLen(BlkLoc(source)->file.fname);
+               Protect (reserve(Strings, (len << 2) + 12), return Error);
+	       Protect(t = alcstr("file(", (word)(5)), return Error);
+	       StrLoc(*dp2) = t;
+	       StrLen(*dp2) = 5;
+#ifdef Graphics
+	     }
+#endif					/* Graphics */
+            while (len-- > 0)
+               StrLen(*dp2) += doimage(*s++, '\0');
+            Protect(alcstr(")", (word)(1)), return Error);
+            ++StrLen(*dp2);
+            }
+         }
+
+      proc: {
+         /*
+          * Produce one of:
+          *  "procedure name"
+          *  "function name"
+          *  "record constructor name"
+          *
+          * Note that the number of dynamic locals is used to determine
+          *  what type of "procedure" is at hand.
+          */
+         len = StrLen(BlkLoc(source)->proc.pname);
+         s = StrLoc(BlkLoc(source)->proc.pname);
+	 Protect (reserve(Strings, len + 22), return Error);
+         switch ((int)BlkLoc(source)->proc.ndynam) {
+            default:  type = "procedure "; outlen = 10; break;
+            case -1:  type = "function "; outlen = 9; break;
+            case -2:  type = "record constructor "; outlen = 19; break;
+            }
+         Protect(t = alcstr(type, outlen), return Error);
+         StrLoc(*dp2) = t;
+         Protect(alcstr(s, len),  return Error);
+         StrLen(*dp2) = len + outlen;
+         }
+
+      list: {
+         /*
+          * Produce:
+          *  "list_m(n)"
+          * where n is the current size of the list.
+          */
+         bp = BlkLoc(*dp1);
+         sprintf(sbuf, "list_%ld(%ld)", (long)bp->list.id, (long)bp->list.size);
+         len = strlen(sbuf);
+         Protect(t = alcstr(sbuf, len), return Error);
+         StrLoc(*dp2) = t;
+         StrLen(*dp2) = len;
+         }
+
+      table: {
+         /*
+          * Produce:
+          *  "table_m(n)"
+          * where n is the size of the table.
+          */
+         bp = BlkLoc(*dp1);
+         sprintf(sbuf, "table_%ld(%ld)", (long)bp->table.id,
+            (long)bp->table.size);
+         len = strlen(sbuf);
+         Protect(t = alcstr(sbuf, len), return Error);
+         StrLoc(*dp2) = t;
+         StrLen(*dp2) = len;
+         }
+
+      set: {
+         /*
+          * Produce "set_m(n)" where n is size of the set.
+          */
+         bp = BlkLoc(*dp1);
+         sprintf(sbuf, "set_%ld(%ld)", (long)bp->set.id, (long)bp->set.size);
+         len = strlen(sbuf);
+         Protect(t = alcstr(sbuf,len), return Error);
+         StrLoc(*dp2) = t;
+         StrLen(*dp2) = len;
+         }
+
+      record: {
+         /*
+          * Produce:
+          *  "record name_m(n)"	-- under construction
+          * where n is the number of fields.
+          */
+         bp = BlkLoc(*dp1);
+         rnlen = StrLen(bp->record.recdesc->proc.recname);
+         sprintf(sbuf, "_%ld(%ld)", (long)bp->record.id,
+            (long)bp->record.recdesc->proc.nfields);
+         len = strlen(sbuf);
+	 Protect (reserve(Strings, 7 + len + rnlen), return Error);
+         Protect(t = alcstr("record ", (word)(7)), return Error);
+         bp = BlkLoc(*dp1);		/* refresh pointer */
+         StrLoc(*dp2) = t;
+	 StrLen(*dp2) = 7;
+         Protect(alcstr(StrLoc(bp->record.recdesc->proc.recname),rnlen),
+	            return Error);
+         StrLen(*dp2) += rnlen;
+         Protect(alcstr(sbuf, len),  return Error);
+         StrLen(*dp2) += len;
+         }
+
+      coexpr: {
+         /*
+          * Produce:
+          *  "co-expression_m (n)"
+          *  where m is the number of the co-expressions and n is the
+          *  number of results that have been produced.
+          */
+
+         sprintf(sbuf, "_%ld(%ld)", (long)BlkLoc(source)->coexpr.id,
+            (long)BlkLoc(source)->coexpr.size);
+         len = strlen(sbuf);
+	 Protect (reserve(Strings, len + 13), return Error);
+         Protect(t = alcstr("co-expression", (word)(13)), return Error);
+         StrLoc(*dp2) = t;
+         Protect(alcstr(sbuf, len), return Error);
+         StrLen(*dp2) = 13 + len;
+         }
+
+      default:
+        if (Type(*dp1) == T_External) {
+           /*
+            * For now, just produce "external(n)".
+            */
+           sprintf(sbuf, "external(%ld)", (long)BlkLoc(*dp1)->externl.blksize);
+           len = strlen(sbuf);
+           Protect(t = alcstr(sbuf, len), return Error);
+           StrLoc(*dp2) = t;
+           StrLen(*dp2) = len;
+           }
+         else {
+	    ReturnErrVal(123, source, Error);
+            }
+      }
+   return Succeeded;
+   }
+
+/*
+ * csname(dp) -- return the name of a predefined cset matching dp.
+ */
+static char *csname(dp)
+dptr dp;
+   {
+   register int n;
+
+   n = BlkLoc(*dp)->cset.size;
+   if (n < 0)
+      n = cssize(dp);
+
+   /*
+    * Check for a cset we recognize using a hardwired decision tree.
+    *  In ASCII, each of &lcase/&ucase/&digits are complete within 32 bits.
+    */
+   if (n == 52) {
+      if ((Cset32('a',*dp) & Cset32('A',*dp)) == (0377777777l << CsetOff('a')))
+	 return ("&letters");
+      }
+   else if (n < 52) {
+      if (n == 26) {
+	 if (Cset32('a',*dp) == (0377777777l << CsetOff('a')))
+	    return ("&lcase");
+	 else if (Cset32('A',*dp) == (0377777777l << CsetOff('A')))
+	    return ("&ucase");
+	 }
+      else if (n == 10 && *CsetPtr('0',*dp) == (01777 << CsetOff('0')))
+	 return ("&digits");
+      }
+   else /* n > 52 */ {
+      if (n == 256)
+	 return "&cset";
+      else if (n == 128 && ~0 ==
+	 (Cset32(0,*dp) & Cset32(32,*dp) & Cset32(64,*dp) & Cset32(96,*dp)))
+	    return "&ascii";
+      }
+   return NULL;
+   }
+
+/*
+ * cssize(dp) - calculate cset size, store it, and return it
+ */
+int cssize(dp)
+dptr dp;
+{
+   register int i, n;
+   register unsigned int w, *wp;
+   register struct b_cset *cs;
+
+   cs = &BlkLoc(*dp)->cset;
+   wp = (unsigned int *)cs->bits;
+   n = 0;
+   for (i = CsetSize; --i >= 0; )
+      for (w = *wp++; w != 0; w >>= 1)
+	 n += (w & 1);
+   cs->size = n;
+   return n;
+}
+
+/*
+ * printable(c) -- is c a "printable" character?
+ */
+
+int printable(c)
+int c;
+   {
+   return (isascii(c) && isprint(c));
+   }
+
+/*
+ * add, sub, mul, neg with overflow check
+ * all return 1 if ok, 0 if would overflow
+ */
+
+extern int over_flow;
+
+/*
+ * add - integer addition with overflow checking
+ */
+word add(a, b)
+word a, b;
+{
+   if ((a ^ b) >= 0 && (a >= 0 ? b > MaxLong - a : b < MinLong - a)) {
+      over_flow = 1;
+      return 0;
+      }
+   else {
+     over_flow = 0;
+     return a + b;
+     }
+}
+
+/* 
+ * sub - integer subtraction with overflow checking
+ */
+word sub(a, b)
+word a, b;
+{
+   if ((a ^ b) < 0 && (a >= 0 ? b < a - MaxLong : b > a - MinLong)) {
+      over_flow = 1;
+      return 0;
+      }
+   else {
+      over_flow = 0;
+      return a - b;
+      }
+}
+
+/*
+ * mul - integer multiplication with overflow checking
+ */
+word mul(a, b)
+word a, b;
+{
+   if (b != 0) {
+      if ((a ^ b) >= 0) {
+	 if (a >= 0 ? a > MaxLong / b : a < MaxLong / b) {
+            over_flow = 1;
+	    return 0;
+            }
+	 }
+      else if (b != -1 && (a >= 0 ? a > MinLong / b : a < MinLong / b)) {
+         over_flow = 1;
+	 return 0;
+         }
+      }
+
+   over_flow = 0;
+   return a * b;
+}
+
+/*
+ * mod3 - integer modulo with overflow checking (always rounds to 0)
+ */
+word mod3(a, b)
+word a, b;
+{
+   word retval;
+
+   switch ( b )
+   {
+      case 0:
+	 over_flow = 1; /* Not really an overflow, but definitely an error */
+	 return 0;
+
+      case MinLong:
+	 /* Handle this separately, since -MinLong can overflow */
+	 retval = ( a > MinLong ) ? a : 0;
+	 break;
+
+      default:
+	 /* First, we make b positive */
+	 if ( b < 0 ) b = -b;
+
+	 /* Make sure retval has the same sign as 'a' */
+	 retval = a % b;
+	 if ( ( a < 0 ) && ( retval > 0 ) )
+	    retval -= b;
+	 break;
+      }
+
+   over_flow = 0;
+   return retval;
+}
+
+/*
+ * div3 - integer divide with overflow checking (always rounds to 0)
+ */
+word div3(a, b)
+word a, b;
+{
+   if ( ( b == 0 ) ||	/* Not really an overflow, but definitely an error */
+        ( b == -1 && a == MinLong ) ) {
+      over_flow = 1;
+      return 0;
+      }
+
+   over_flow = 0;
+   return ( a - mod3 ( a, b ) ) / b;
+}
+
+/*
+ * neg - integer negation with overflow checking
+ */
+word neg(a)
+word a;
+{
+   if (a == MinLong) {
+      over_flow = 1;
+      return 0;
+      }
+   over_flow = 0;
+   return -a;
+}
+
+#if COMPILER
+/*
+ * sig_rsm - standard success continuation that just signals resumption.
+ */
+
+int sig_rsm()
+   {
+   return A_Resume;
+   }
+
+/*
+ * cmd_line - convert command line arguments into a list of strings.
+ */
+void cmd_line(argc, argv, rslt)
+int argc;
+char **argv;
+dptr rslt;
+   {
+   tended struct b_list *hp;
+   register word i;
+   register struct b_lelem *bp;  /* need not be tended */
+
+   /*
+    * Skip the program name.
+    */
+   --argc;
+   ++argv;
+
+   /*
+    * Allocate the list and a list block.
+    */
+   Protect(hp = alclist(argc), fatalerr(0,NULL));
+   Protect(bp = alclstb(argc, (word)0, argc), fatalerr(0,NULL));
+
+   /*
+    * Make the list block just allocated into the first and last blocks
+    *  for the list.
+    */
+   hp->listhead = hp->listtail = (union block *)bp;
+#ifdef ListFix
+   bp->listprev = bp->listnext = (union block *)hp;
+#endif					/* ListFix */
+
+   /*
+    * Copy the arguments into the list
+    */
+   for (i = 0; i < argc; ++i) {
+      StrLen(bp->lslots[i]) = strlen(argv[i]);
+      StrLoc(bp->lslots[i]) = argv[i];
+      }
+
+   rslt->dword = D_List;
+   rslt->vword.bptr = (union block *) hp;
+   }
+
+/*
+ * varargs - construct list for use in procedures with variable length
+ *  argument list.
+ */
+void varargs(argp, nargs, rslt)
+dptr argp;
+int nargs;
+dptr rslt;
+   {
+   tended struct b_list *hp;
+   register word i;
+   register struct b_lelem *bp;  /* need not be tended */
+
+   /*
+    * Allocate the list and a list block.
+    */
+   Protect(hp = alclist(nargs), fatalerr(0,NULL));
+   Protect(bp = alclstb(nargs, (word)0, nargs), fatalerr(0,NULL));
+
+   /*
+    * Make the list block just allocated into the first and last blocks
+    *  for the list.
+    */
+   hp->listhead = hp->listtail = (union block *)bp;
+#ifdef ListFix
+   bp->listprev = bp->listnext = (union block *)hp;
+#endif					/* ListFix */
+
+   /*
+    * Copy the arguments into the list
+    */
+   for (i = 0; i < nargs; i++)
+      deref(&argp[i], &bp->lslots[i]);
+
+   rslt->dword = D_List;
+   rslt->vword.bptr = (union block *) hp;
+   }
+#endif					/* COMPILER */
+
+/*
+ * retderef - Dereference local variables and substrings of local
+ *  string-valued variables. This is used for return, suspend, and
+ *  transmitting values across co-expression context switches.
+ */
+void retderef(valp, low, high)
+dptr valp;
+word *low;
+word *high;
+   {
+   struct b_tvsubs *tvb;
+   word *loc;
+
+   if (Type(*valp) == T_Tvsubs) {
+      tvb = (struct b_tvsubs *)BlkLoc(*valp);
+      loc = (word *)VarLoc(tvb->ssvar);
+      }
+   else
+      loc = (word *)VarLoc(*valp) + Offset(*valp);
+   if (InRange(low, loc, high))
+      deref(valp, valp);
+   }
diff --git a/src/runtime/rmswin.ri b/src/runtime/rmswin.ri
new file mode 100644
index 0000000..3471fd3
--- /dev/null
+++ b/src/runtime/rmswin.ri
@@ -0,0 +1,4204 @@
+/*
+ * rmswin.ri - Microsoft Windows-specific graphics interface code.
+ *
+ * Todo:
+ *   geticonpos
+ *   seticonimage
+ *   free_mutable
+ *   freecolor
+ *
+ * Untested:
+ *   toggle_fgbg
+ *   rebind
+ *   geticonic
+ *   getimstr
+ *   getfntnam
+ *   dumpimage
+ *   getpointername
+ *
+ * Blown off:
+ *   getvisual
+ *   getdefault
+ */
+#ifdef Graphics
+
+void wfreersc();
+int alc_rgb(wbp w, SysColor rgb);
+/*
+ * check_and_get_msg retreives the next message in *pMsg;
+ * returns 1 if regular message was retreived, 0 if quit message,
+ * -1 if there was an error.
+ */
+static int check_and_get_msg( MSG *pMsg );
+int numRealized;
+
+#ifndef min
+   #define min(x,y) (((x) < (y))?(x):(y))
+   #define max(x,y) (((x) > (y))?(x):(y))
+#endif					/* min */
+#define PALCLR(c) (c | 0x2000000L)
+
+int winInitialized = 0;
+int BORDHEIGHT;
+int BORDWIDTH;
+/*
+ * check for double-byte character set versions of Windows
+ */
+CPINFO cpinfo;
+int MAXBYTESPERCHAR;
+
+wclrp scp;
+HPALETTE palette;
+int numColors = 0;
+
+char szAppName[] = "Icon";
+
+/*
+ * pattern symbols
+ */
+stringint siPatternSyms[] = {
+  {0,           16},
+  { "black",     0},
+  { "checkers",  12},
+  { "darkgray",  2},
+  { "diagonal",  8},
+  { "grains",    13},
+  { "gray",      3},
+  { "grid",      10},
+  { "horizontal",9},
+  { "lightgray", 4},
+  { "scales",    14},
+  { "trellis",   11},
+  { "vertical",  7},
+  { "verydark",  1},
+  { "verylight", 5},
+  { "waves",     15},
+  { "white",     6},
+};
+
+/*
+ * draw ops
+ */
+stringint drawops[] = {
+   { 0, 16},
+   {"and",              R2_MASKPEN},
+   {"andInverted",      R2_MASKPENNOT},
+   {"andReverse",       R2_MASKNOTPEN},
+   {"clear",            R2_BLACK},
+   {"copy",             R2_COPYPEN},
+   {"copyInverted",     R2_NOTCOPYPEN},
+   {"equiv",            R2_NOTXORPEN},
+   {"invert",           R2_NOT},
+   {"nand",             R2_NOTMASKPEN},
+   {"noop",             R2_NOP},
+   {"nor",              R2_NOTMERGEPEN},
+   {"or",               R2_MERGEPEN},
+   {"orInverted",       R2_MERGEPENNOT},
+   {"orReverse",        R2_MERGENOTPEN},
+   {"set",              R2_WHITE},
+   {"xor",              R2_XORPEN},
+};
+
+/*
+ * line types
+ */
+stringint siLineTypes[] = {
+  {0, 6},
+  {"dashdotted",        PS_DASHDOT},
+  {"dashdotdotted",     PS_DASHDOTDOT},
+  {"dashed",            PS_DOT},
+  {"longdashed",        PS_DASH},
+  {"solid",             PS_SOLID},
+  {"striped",           PS_DOT}
+};
+
+HINSTANCE mswinInstance;
+int ncmdShow;
+
+int FoundIt, FoundNew;
+HWND NewWin;
+char *lookingfor;
+struct WNDlist {
+   HWND w;
+   struct WNDlist *next;
+   } * wlhead;
+
+struct WNDlist *wlinsert(HWND w)
+{
+   struct WNDlist *x = malloc(sizeof (struct WNDlist));
+   x->w = w;
+   x->next = wlhead;
+   wlhead = x;
+}
+
+int wlsearch(HWND w)
+{
+   struct WNDlist *x;
+   for(x=wlhead;x;x=x->next) if (x->w == w) return 1;
+   return 0;
+}
+
+void wlfree()
+{
+   struct WNDlist *x = wlhead;
+   while (wlhead) {
+      x = wlhead->next;
+      free(wlhead);
+      wlhead = x;
+      }
+}
+
+BOOL_CALLBACK myenumproc(HWND w, LPARAM l)
+{
+   wlinsert(w);
+   return 1;
+}
+
+BOOL_CALLBACK myenumproc2(HWND w, LPARAM l)
+{
+   if (!wlsearch(w)) {
+      FoundNew++;
+      NewWin = w;
+      }
+   return 1;
+}
+
+char * strcasestr(char *haystack, char *needle)
+{
+   int len = strlen(needle);
+   while (*haystack) {
+      if (strncasecmp(haystack, needle, len) == 0) return haystack;
+      haystack++;
+      }
+   return 0;
+}
+
+BOOL_CALLBACK myenumproc3(HWND w, LPARAM l)
+{
+   char s[64], s2[64];
+   GetWindowText(w, s2, 63);
+   /*
+    * Conditions to find a window:
+    * 1) wasn't in the list of windows already present when we launched.
+    * 2) either contains the argv[0] program name, or
+    *    was first window to appear after we called WinExec().
+    */
+   if (!wlsearch(w)) {
+      FoundNew++;
+      if ((strcasestr(s2, lookingfor) != NULL) || (NewWin && (NewWin == w))) {
+         FoundIt++;
+         }
+      }
+   return 1;
+}
+
+char *lookcmdname(char *buf, char *s)
+{
+  char *t = buf;
+  while (*s) {
+    *t++ = *s;
+    if (*s == '\\') t = buf;
+    s++;
+    }
+  *t++ = '\0';
+  s = buf;
+  while (*s) {
+    if (*s == '.') *s = '\0';
+    s++;
+    }
+  return buf;
+}
+
+
+/*
+ * wopen
+ */
+FILE *wopen(char *name, struct b_list *lp, dptr attr, int n, int *err_idx)
+   {
+   wbp w;
+   wsp ws;
+   wcp wc;
+   struct imgdata *imd;
+   char answer[256];
+   int i, r;
+   tended struct b_list *tlp;
+   tended struct descrip attrrslt;
+   HDC hdc, hdc2, hdc3;
+   TEXTMETRIC	metrics;
+   LOGPALETTE logpal[4]; /* really 1 + space for an extra palette entry */
+   HBRUSH brush;
+   HBITMAP oldpix, oldpix2;
+   HFONT oldfont;
+
+   if (! winInitialized++) {
+      BORDWIDTH = FRAMEWIDTH * 2;
+      BORDHEIGHT = TITLEHEIGHT + FRAMEHEIGHT * 2 - 1;
+      GetCPInfo(CP_ACP, &cpinfo);
+      MAXBYTESPERCHAR = cpinfo.MaxCharSize;
+      }
+
+   tlp = lp;
+
+   /*
+    * allocate a binding, a window state, and a context
+    */
+   Protect(w = alc_wbinding(), return NULL);
+   Protect(w->window = alc_winstate(), { free_binding(w); return NULL; });
+   Protect(w->context = alc_context(w), { free_binding(w); return NULL; });
+   ws = w->window;
+   ws->listp.dword = D_List;
+   BlkLoc(ws->listp) = (union block *)lp;
+   ws->width = ws->height = 0;
+   wc = w->context;
+
+   /*
+    * process the passed in attributes - by calling wattrib
+    */
+   for(i = 0; i < n; i++)
+      switch (wattrib(w, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt,
+			answer)) {
+      case Failed:
+	 wclose(w);
+	 return NULL;
+      case Error:
+	 /* think of something to do here */
+	 break;
+	 }
+
+   /*
+    * set the title, defaulting to the "filename" supplied to open()
+    */
+   if (ws->windowlabel == NULL) ws->windowlabel = salloc(name);
+   if (ws->iconlabel == NULL) ws->iconlabel = salloc(name);
+
+   if (ws->posx < 0) ws->posx = 0;
+   if (ws->posy < 0) ws->posy = 0;
+
+   /*
+    * create the window
+    */
+   ws->iconwin = CreateWindow( "iconx", ws->windowlabel, WS_OVERLAPPEDWINDOW,
+		   ws->posx, ws->posy,
+		   ws->width == 0 ? 400 : ws->width + BORDWIDTH,
+		   ws->height == 0 ? 400: ws->height + BORDHEIGHT,
+		   NULL, NULL, mswinInstance, NULL);
+   hdc = GetDC(ws->iconwin);
+   if ((GetDeviceCaps(hdc, RASTERCAPS) & RC_PALETTE) && (numColors == 0)){
+      /* This window is on a device that supports palettes */
+      numColors = 2;
+      logpal[0].palNumEntries = 2;
+      logpal[0].palVersion = 0x300;
+      logpal[0].palPalEntry[0].peFlags = 0;
+      logpal[0].palPalEntry[0].peRed = 0;
+      logpal[0].palPalEntry[0].peGreen = 0;
+      logpal[0].palPalEntry[0].peBlue = 0;
+      logpal[0].palPalEntry[1].peFlags = 0;
+      logpal[0].palPalEntry[1].peRed = 255;
+      logpal[0].palPalEntry[1].peGreen = 255;
+      logpal[0].palPalEntry[1].peBlue = 255;
+      palette = CreatePalette(logpal);
+      if ((scp = malloc(2 * sizeof (struct wcolor))) == NULL) return NULL;
+      scp[0].c = RGB(0,0,0);
+      scp[0].type = SHARED;
+      strcpy(scp[0].name, "black");
+      scp[1].c = RGB(255,255,255);
+      scp[1].type = SHARED;
+      strcpy(scp[1].name, "white");
+      }
+   oldfont = SelectObject(hdc, wc->font->font);
+   GetTextMetrics(hdc, &metrics);
+   wc->font->charwidth = dc_maxcharwidth(hdc);
+   SelectObject(hdc, oldfont);
+   ReleaseDC(ws->iconwin, hdc);
+   wc->font->ascent = metrics.tmAscent;
+   wc->font->descent = metrics.tmDescent;
+   /*   wc->font->charwidth = metrics.tmMaxCharWidth; buggy */
+   wc->font->height = metrics.tmHeight;
+   wc->leading = metrics.tmHeight;
+   ws->x = 0;
+   ws->y = ASCENT(w);
+   ws->y += w->context->dy;
+   ws->x += w->context->dx;
+   /*
+    * set the generic window's true default sizes
+    */
+   if (!ws->width || !ws->height) {
+      if (!ws->width) ws->width = FWIDTH(w) * 80;
+      if (!ws->height) ws->height = FHEIGHT(w) * 12;
+      SetWindowPos(ws->iconwin, ws->iconwin,
+		   ws->posx,
+		   ws->posy,
+		   ws->width + BORDWIDTH, ws->height + BORDHEIGHT,
+		   SWP_NOZORDER);
+      }
+   if (!ws->pix) {
+      hdc = GetDC(ws->iconwin);
+      ws->pix = CreateCompatibleBitmap(hdc, ws->width, ws->height);
+      ReleaseDC(ws->iconwin, hdc);
+      }
+
+   if (alc_rgb(w, wc->fg) == Failed) {
+      return 0;
+      }
+   if (alc_rgb(w, wc->bg) == Failed) {
+      return 0;
+      }
+   ws->pixwidth = ws->width;
+   ws->pixheight = ws->height;
+   if (!ISTOBEHIDDEN(ws)) {
+      ws->win = ws->iconwin;
+      ShowWindow(ws->win, ncmdShow);
+      }
+   else ws->win = 0;
+
+   if (ws->initialPix) {
+      hdc = GetDC(ws->iconwin);
+      hdc2 = CreateCompatibleDC(hdc);
+      oldpix = SelectObject(hdc2, ws->pix);
+      hdc3 = CreateCompatibleDC(hdc);
+      oldpix2 = SelectObject(hdc3, ws->initialPix);
+      BitBlt(hdc2, 0, 0, ws->width, ws->height, hdc3, 0, 0, SRCCOPY);
+      if (ws->win)
+         BitBlt(hdc, 0, 0, ws->width, ws->height, hdc3, 0, 0, SRCCOPY);
+      SelectObject(hdc2, oldpix);
+      SelectObject(hdc3, oldpix2);
+      DeleteDC(hdc2);
+      DeleteDC(hdc3);
+      DeleteObject(ws->initialPix);
+      ws->initialPix = (HBITMAP) NULL;
+      }
+   else {
+      /*
+       * initialize the image with the background color
+       */
+      RECT rec;
+      hdc = GetDC(ws->iconwin);
+      hdc2 = CreateCompatibleDC(hdc);
+      oldpix = SelectObject(hdc2, ws->pix);
+      rec.left = rec.top = 0;
+      rec.right = ws->width;
+      rec.bottom = ws->height;
+      if (palette) {
+         SelectPalette(hdc, palette, FALSE);
+         SelectPalette(hdc2, palette, FALSE);
+	 RealizePalette(hdc);
+	 RealizePalette(hdc2);
+	 }
+      brush = CreateBrushIndirect(&(wc->bgbrush));
+      if (ws->win)
+         FillRect(hdc, &rec, brush);
+      FillRect(hdc2, &rec, brush);
+      DeleteObject(brush);
+      SelectObject(hdc2, oldpix);
+      ReleaseDC(ws->iconwin, hdc);
+      DeleteDC(hdc2);
+
+      imd = &ws->initimage;
+      if (imd->width) {
+	 r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl,
+		      imd->data, (word)imd->width * (word)imd->height, 0);
+	 free((pointer)imd->paltbl);
+	 free((pointer)imd->data);
+	 imd->width = 0;
+	 if (r < 0) {
+	    return 0;
+	    }
+	 }
+      }
+   if (ws->win)
+      UpdateWindow(ws->win);
+
+   return (FILE *)w;
+   }
+
+int handle_config(wbp w, UINT msg, WPARAM wp, LPARAM lp)
+   {
+   int neww, newh;
+   struct descrip d;
+   wsp ws = w->window;
+
+   if (wp == SIZE_MINIMIZED) {
+      if (ws->win) {
+         SetWindowText(ws->win, ws->iconlabel);
+         ws->win = NULL;
+	 }
+      return 1;
+      }
+
+   if (ws->win)
+      SetWindowText(ws->win, ws->windowlabel);
+   ws->win = ws->iconwin;
+
+   /*
+    * make sure text cursor stays on-screen
+    */
+   ws->x = min(ws->x, LOWORD(lp) - FWIDTH(w));
+   ws->y = min(ws->y, HIWORD(lp));
+
+   neww = LOWORD(lp);
+   newh = HIWORD(lp);
+
+   /*
+    * if it was not a resize, drop it
+    */
+   if ((ws->width == neww) && (ws->height == newh)) {
+      return 1;
+      }
+
+   ws->width = neww;
+   ws->height = newh;
+   if (! resizePixmap(w, ws->width, ws->height)) return 0;
+   if (!ISEXPOSED(w)) {
+      SETEXPOSED(w);
+      return 1;
+      }
+   MakeInt(RESIZED, &d);
+   qevent(w->window, &d, ws->width, ws->height, ~(uword)0, 0);
+   return 1;
+   }
+
+/*
+ * handle window controls (child windows), at the moment these are
+ * buttons and scrollbars.  wp is which child (base 1).
+ * Buttons come in as undiluted messages.
+ * Scrollbars come in with msg = new value of scrollbar
+ */
+void handle_child(wbp wb, UINT msg, WPARAM wp, LPARAM lp)
+   {
+   DWORD dw;
+   LONG t;
+   WORD x, y;
+   wsp ws = wb->window;
+   char *s;
+   int len;
+   struct descrip d;
+   int flags = 0;
+   if (LOWORD(wp) > ws->nChildren) return;
+   s = ws->child[LOWORD(wp) - 1].id;
+   len = strlen(s);
+   d = nulldesc;
+   StrLoc(d) = alcstr(s, len);
+   StrLen(d) = len;
+   switch (HIWORD(wp)) {
+   case BN_CLICKED: {
+      dw = GetMessagePos();
+      x = LOWORD(dw);
+      y = HIWORD(dw);
+      break;
+      }
+   case EN_SETFOCUS: case EN_KILLFOCUS: case EN_CHANGE: case EN_UPDATE:
+   case EN_ERRSPACE: case EN_MAXTEXT: case EN_HSCROLL: case EN_VSCROLL: {
+	return;
+      }
+   default: { /* scrollbar */
+      x = y = msg;
+      }
+   }
+   t = GetMessageTime();
+   qevent(ws, &d, x, y, t, flags);
+   if (ws->focusChild)
+      SetFocus(ws->focusChild);
+   else if (ws->win)
+      SetFocus(ws->win);
+   else
+      SetFocus(ws->iconwin);
+   }
+
+void handle_menu(wbp wb, UINT msg, WPARAM wp, LPARAM lp)
+   {
+   wsp ws = wb->window;
+   DWORD dw;
+   LONG t;
+   WORD x, y;
+   struct descrip d;
+   char *s = ws->menuMap[wp];
+   int len = strlen(s);
+   int flags = 0;
+
+   d = nulldesc;
+   StrLoc(d) = alcstr(s, len);
+   StrLen(d) = len;
+   dw = GetMessagePos();
+   x = LOWORD(dw);
+   y = HIWORD(dw);
+   t = GetMessageTime();
+   qevent(ws, &d, x, y, t, flags);
+   }
+
+void handle_keypress(wbp wb, UINT msg, WPARAM wp, LPARAM lp, int meta)
+   {
+   wsp ws = wb->window;
+   DWORD dw;
+   LONG t;
+   WORD x, y;
+   struct descrip d;
+   int flags = 0;
+   if (msg == WM_CHAR || msg == WM_SYSCHAR) {
+      StrLen(d) = 1;
+      StrLoc(d) = (char *)&allchars[wp & 0xFF];
+      }
+   else { /* WM_KEYDOWN or WM_SYSKEYDOWN */
+      MakeInt(wp, &d);
+      }
+   dw = GetMessagePos();
+   x = LOWORD(dw);
+   y = HIWORD(dw);
+   t = GetMessageTime();
+   if (GetKeyState(VK_CONTROL) < 0) flags |= ControlMask;
+   if (GetKeyState(VK_SHIFT) < 0) flags |= ShiftMask;
+
+   if (meta) flags |= Mod1Mask;
+   qevent(ws, &d, x, y, t, flags);
+   }
+
+void handle_mouse(wbp wb, UINT msg, WPARAM wp, LPARAM lp)
+   {
+   wsp ws = wb->window;
+   LONG t;
+   WORD x, y;
+   struct descrip d;
+   long flags = 0, eventcode;
+
+   switch(msg) {
+   case WM_MOUSEMOVE: /* only called if one of these three cases is true */
+      if (MK_LBUTTON & wp)
+	 eventcode = MOUSELEFTDRAG;
+      else if (MK_RBUTTON & wp)
+	 eventcode = MOUSERIGHTDRAG;
+      else if (MK_MBUTTON & wp)
+	 eventcode = MOUSEMIDDRAG;
+      else eventcode = 0;
+      break;
+   case WM_LBUTTONDOWN:
+      eventcode = MOUSELEFT;
+      break;
+   case WM_MBUTTONDOWN:
+      eventcode = MOUSEMID;
+      break;
+   case WM_RBUTTONDOWN:
+      eventcode = MOUSERIGHT;
+      break;
+   case WM_LBUTTONUP:
+      eventcode = MOUSELEFTUP;
+      break;
+   case WM_MBUTTONUP:
+      eventcode = MOUSEMIDUP;
+      break;
+   case WM_RBUTTONUP:
+      eventcode = MOUSERIGHTUP;
+      break;
+   default:
+      eventcode = 0;
+      break;
+      }
+
+   MakeInt(eventcode, &d);
+   x = LOWORD(lp);
+   y = HIWORD(lp);
+   t = GetMessageTime(); /* why might someone comment this out? */
+
+   if (MK_CONTROL & wp) flags |= ControlMask;
+   if (MK_SHIFT & wp) flags |= ShiftMask;
+
+   qevent(ws, &d, x, y, t, flags);
+   }
+
+LRESULT_CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp)
+{
+   HDC hdc, hdc2;
+   PAINTSTRUCT ps;
+   RECT rect;
+   wbp wb = NULL;
+   wsp ws = NULL;
+   int n, i, imin, imax;
+
+   /*
+    * find a binding associated with the given window.
+    */
+   for (wb = wbndngs; wb; wb=wb->next) {
+      ws = wb->window;
+
+      if ((ws->win == hwnd) || (ws->iconwin == hwnd)) break;
+      }
+   if (msg == WM_QUIT) {
+      wfreersc();
+      }
+   else if (!wb) {
+      /*
+       * doesn't look like its for one of our windows, pass it to
+       * DefWindowProc and hope for the best.
+       */
+      }
+   else
+   switch(msg) {
+   case WM_PAINT:
+      hdc = BeginPaint(hwnd, &ps);
+      GetClientRect(hwnd, &rect);
+      if (IsIconic(hwnd)) {
+         HBRUSH hb = CreateBrushIndirect(&(wb->context->brush));
+	 FrameRect(hdc, &rect, hb);
+	 DeleteObject(hb);
+	 DrawText(hdc, "Iconx", 5, &rect, DT_WORDBREAK);
+	 }
+      else {
+         HBITMAP oldpix;
+	 hdc2 = CreateCompatibleDC(hdc);
+	 oldpix = SelectObject(hdc2, ws->pix);
+	 BitBlt(hdc, rect.left, rect.top,
+		rect.right - rect.left + 1, rect.bottom - rect.top + 1,
+		hdc2, rect.left, rect.top, SRCCOPY);
+         SelectObject(hdc2, oldpix);
+	 DeleteDC(hdc2);
+	 }
+      EndPaint(hwnd, &ps);
+      return 0;
+   case WM_MOUSEMOVE:
+      if (ws->curcursor)
+         SetCursor(ws->curcursor);
+      if ((MK_LBUTTON | MK_RBUTTON | MK_MBUTTON) & wp)
+	 handle_mouse(wb,msg,wp,lp);
+      return 0;
+   case WM_LBUTTONDOWN: case WM_RBUTTONDOWN: case WM_MBUTTONDOWN:
+   case WM_LBUTTONUP:   case WM_RBUTTONUP:   case WM_MBUTTONUP:
+      handle_mouse(wb,msg,wp,lp);
+      return 0;
+   case WM_KEYDOWN:
+      switch (wp) { /* VK defn's from <winuser.h> */
+      case VK_F1: case VK_F2: case VK_F3: case VK_F4:
+      case VK_F5: case VK_F6: case VK_F7: case VK_F8:
+      case VK_F9: case VK_F10: case VK_F11: case VK_F12:
+      case VK_HOME: case VK_END: case VK_PRIOR: case VK_NEXT:
+      case VK_LEFT: case VK_RIGHT: case VK_UP: case VK_DOWN:
+      case VK_INSERT: case VK_SELECT: case VK_PRINT:
+      case VK_EXECUTE: case VK_SNAPSHOT: case VK_HELP: case VK_SEPARATOR:
+      case VK_CLEAR: case VK_PAUSE: case VK_SCROLL:
+	 handle_keypress(wb, msg, wp, lp, 0);
+	 return 0;
+      case VK_DELETE:
+	 handle_keypress(wb, WM_CHAR, '\177', lp, 0);
+	 return 0;
+      }
+      break;
+   case WM_SYSKEYDOWN:
+      switch (wp) {
+      case VK_F1: case VK_F2: case VK_F3: /* alt-F4 terminates */
+      case VK_F5: case VK_F6: case VK_F7: case VK_F8:
+      case VK_F9: case VK_F10: case VK_F11: case VK_F12:
+      case VK_HOME: case VK_END: case VK_PRIOR: case VK_NEXT:
+      case VK_LEFT: case VK_RIGHT: case VK_UP: case VK_DOWN:
+      case VK_INSERT: case VK_DELETE: case VK_SELECT: case VK_PRINT:
+      case VK_EXECUTE: case VK_SNAPSHOT: case VK_HELP: case VK_SEPARATOR:
+      case VK_CLEAR: case VK_PAUSE:
+	 handle_keypress(wb, msg, wp, lp, 1);
+	 return 0;
+	}
+      break;
+   case WM_CHAR:
+      handle_keypress(wb, msg, wp, lp, 0);
+      return 0;
+   case WM_SYSCHAR:
+      handle_keypress(wb, msg, wp, lp, 1);
+      /*
+       * Unless there is a menu bar installed,
+       * Alt-A .. Alt-Z, and Alt-0 .. Alt-9 are eaten by Icon;
+       * others are passed on to Windows for things like Alt-Esc.
+       */
+      if (isalnum(wp) && !(ws->menuMap)) return 0;
+      break;
+   case WM_HSCROLL:
+   case WM_VSCROLL:
+      for(n=0; n < ws->nChildren && ws->child[n].win != (HWND)lp; n++){
+         }
+      if (n == ws->nChildren) break;
+      i = GetScrollPos(ws->child[n].win, SB_CTL);
+      GetScrollRange(ws->child[n].win, SB_CTL, &imin, &imax);
+      switch (LOWORD(wp)) {
+      case SB_PAGEDOWN :
+         break;
+      case SB_LINEDOWN :
+         if (i < imax) {
+            SetScrollPos(ws->child[n].win, SB_CTL,
+	       GetScrollPos(ws->child[n].win, SB_CTL) + 1, TRUE);
+	    }
+         break;
+      case SB_PAGEUP :
+         break;
+      case SB_LINEUP :
+         if (i > imin) {
+            SetScrollPos(ws->child[n].win, SB_CTL,
+	       GetScrollPos(ws->child[n].win, SB_CTL) - 1, TRUE);
+	    }
+         break;
+      case SB_TOP :
+         SetScrollPos(ws->child[n].win, SB_CTL, imin, TRUE);
+         break;
+      case SB_BOTTOM :
+         SetScrollPos(ws->child[n].win, SB_CTL, imax, TRUE);
+         break;
+      case SB_THUMBPOSITION :
+         SetScrollPos(ws->child[n].win, SB_CTL, HIWORD(wp), TRUE);
+         break;
+      case SB_THUMBTRACK :
+         SetScrollPos(ws->child[n].win, SB_CTL, HIWORD(wp), TRUE);
+         break;
+      case SB_ENDSCROLL: /* noop */
+         break;
+      default : /* potentially a problem here */
+         break;
+      }
+      i = GetScrollPos(ws->child[n].win, SB_CTL);
+      handle_child(wb, i, n+1, -1);
+      break;
+   case WM_COMMAND:
+      if (LOWORD(lp) == 0)
+         handle_menu(wb, msg, wp, lp);
+      else
+         handle_child(wb, msg, wp, lp);
+      break;
+   case WM_SIZE:
+      handle_config(wb, msg, wp, lp);
+      break;
+   case WM_MOVE:
+      ws->posx = LOWORD(lp) - (BORDWIDTH>>1);
+      ws->posy = HIWORD(lp) - (BORDHEIGHT - 4);
+      break;
+   case WM_ACTIVATE:
+      if (wp == WA_INACTIVE) {
+         if (ws->savedcursor) SetCursor(ws->savedcursor);
+         if (ws->hasCaret) {
+            HideCaret(ws->iconwin);
+            DestroyCaret();
+            ws->hasCaret = 0;
+            }
+         }
+      else { /* ... */
+         if (ws->savedcursor == NULL)
+            ws->savedcursor = SetCursor(ws->curcursor);
+         else (void) SetCursor(ws->curcursor);
+         if (ISCURSORON(wb)) {
+	    CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb));
+	    SetCaretPos(ws->x, ws->y - ASCENT(wb));
+	    SetCaretBlinkTime(500);
+	    ShowCaret(ws->iconwin);
+	    ws->hasCaret = 1;
+            }
+	 }
+      break;
+   case WM_GETMINMAXINFO: {
+      MINMAXINFO *mmi = (MINMAXINFO *)lp;
+      if (! ISRESIZABLE(wb)) {
+	 mmi->ptMinTrackSize.x = mmi->ptMaxTrackSize.x =
+	    ws->width + BORDWIDTH;
+	 mmi->ptMinTrackSize.y = mmi->ptMaxTrackSize.y =
+	    ws->height + BORDHEIGHT;
+	 }
+      return 0;
+      }
+   case WM_KILLFOCUS:
+      if (ws->hasCaret) {
+         HideCaret(ws->iconwin);
+         DestroyCaret();
+         ws->hasCaret = 0;
+         }
+      break;
+   case WM_SETFOCUS:
+      if (ws->focusChild)
+         SetFocus(ws->focusChild);
+      else if (ISCURSORON(wb)) {
+	 CreateCaret(ws->iconwin, NULL, FWIDTH(wb), FHEIGHT(wb));
+	 SetCaretPos(ws->x, ws->y - ASCENT(wb));
+	 SetCaretBlinkTime(500);
+	 ShowCaret(ws->iconwin);
+	 ws->hasCaret = 1;
+         }
+      break;
+   /* case WM_QUIT is handled prior to the switch*/
+   case WM_DESTROY:
+      if (ws->win == hwnd)
+	 ws->win = NULL;
+      if (ws->iconwin == hwnd)
+	 ws->iconwin = NULL;
+      if (ws->refcount > 0) {
+	 PostQuitMessage(0);
+	 return 0;
+	 }
+      else if (ws->refcount < 0) {
+	 ws->refcount = -ws->refcount;
+	 }
+      break;
+   case MM_MCINOTIFY:
+      mciSendCommand(LOWORD(lp), MCI_CLOSE, 0, (DWORD)NULL);
+      break;
+   }
+   return DefWindowProc(hwnd, msg, wp, lp);
+}
+
+/*
+ * wclose - make sure the window goes away - no questions asked
+ */
+int wclose(wbp w)
+   {
+   wsp ws = w->window;
+   if (pollevent() == -1) return -1;
+   if (ws->win && ws->refcount > 1) {
+      /*
+       * Decrement refcount and negate it to tell the window procedure
+       * that we closed the window, not the user, so don't terminate.
+       */
+      ws->refcount--;
+      ws->refcount = -ws->refcount;
+      DestroyWindow(ws->win);
+      while (ws->win)
+	 if (pollevent() == -1) return -1;
+      }
+   else {
+      free_binding(w);
+      }
+   return 1;
+   }
+
+int pollevent()
+   {
+   wbp w;
+   MSG m;
+   int result;
+
+   /* some while PeekMessage loops here, maybe one per window ? */
+   while (PeekMessage(&m, NULL, 0, 0, PM_NOREMOVE)) {
+      if ((result = check_and_get_msg(&m)) <= 0) return result;
+      TranslateMessage(&m);
+      DispatchMessage(&m);
+      }
+   return 400;
+   }
+
+/*
+ * write some text to both the window and the pixmap
+ */
+void xdis(w,s,n)
+register wbp w;
+char *s;
+int n;
+   {
+   XPoint pt;
+   HBRUSH hb;
+   XRectangle rect;
+   STDLOCALS(w);
+
+   STDFONT;
+   rect.left = ws->x; rect.right = ws->x + dc_textwidth(pixdc, s, n);
+   rect.top = ws->y - ASCENT(w); rect.bottom = ws->y + DESCENT(w);
+
+   /* skip resource allocation if we are offscreen */
+   if (!(rect.left > ws->width || rect.right < 0 ||
+       rect.top < 0 || rect.bottom > ws->height)) {
+
+      hb = CreateBrushIndirect(&(wc->bgbrush));
+      if (stdwin) {
+         /*
+          *  SetBkColor() does not dither consistently with bgbrush;
+          *  erase the background beforehand and use transparent drawing
+          */
+         FillRect(stddc, &rect, hb);
+         SetBkMode(stddc, TRANSPARENT);
+         SetTextColor(stddc, PALCLR(wc->fg));
+         TextOut(stddc, ws->x, ws->y - ASCENT(w), s, n);
+         }
+      FillRect(pixdc, &rect, hb);
+      DeleteObject(hb);
+      SetBkMode(pixdc, TRANSPARENT);
+      SetTextColor(pixdc, PALCLR(wc->fg));
+      TextOut(pixdc, ws->x, ws->y - ASCENT(w), s, n);
+      }
+   ws->x += dc_textwidth(pixdc, s, n);
+
+   FREE_STDLOCALS(w);
+   }
+/*
+ * wputc
+ */
+int wputc(int ci, wbp w)
+   {
+   char c = (char)ci;
+   wsp ws = w->window;
+   wcp wc = w->context;
+   int y_plus_descent;
+   HBRUSH hb;
+
+   switch (c) {
+   case '\n':
+      ws->y += LEADING(w);
+      if (ws->y + DESCENT(w) > ws->height) {
+	 RECT r;
+	 STDLOCALS(w);
+	 ws->y -= LEADING(w);
+	 y_plus_descent = ws->y + DESCENT(w);
+	 BitBlt(pixdc, 0, 0,
+		ws->width, y_plus_descent,
+		pixdc, 0, LEADING(w), SRCCOPY);
+	 r.left = 0;
+	 r.top = y_plus_descent - FHEIGHT(w);
+	 r.right = ws->width;
+	 r.bottom = ws->height;
+         hb = CreateBrushIndirect(&(wc->bgbrush));
+	 FillRect(pixdc, &r, hb);
+	 DeleteObject(hb);
+	 if (stdwin)
+	    BitBlt(stddc, 0, 0, ws->width, ws->height,
+		   pixdc, 0, 0, SRCCOPY);
+	 FREE_STDLOCALS(w);
+	 }
+      /* intended fall-through */
+    case '\r':
+      /*
+       * set the new x position
+       */
+      ws->x = wc->dx;
+      break;
+   case '\t':
+      xdis(w, "        ", 8 - (XTOCOL(w,ws->x) & 7));
+      break;
+      /*
+       * Handle backspaces.  This implements cooked mode echo handling.
+       */
+   case '\177':
+   case '\010': {
+      int i = 0, pre_x;
+
+      /*
+       * Start with the last character queued up.
+       */
+      i--;
+      /*
+       * Trot back to the control-H itself.
+       */
+      while ((i>-EQUEUELEN) && (EVQUESUB(w,i) != c)) {
+	 i--;
+	 }
+      if (i == -EQUEUELEN) break;
+      /*
+       * Go past the control-H.
+       */
+      i--;
+      /*
+       * Go back through any number of control-H's from prior lifetimes.
+       */
+      while((i > -EQUEUELEN) && !isprint(EVQUESUB(w,i))) {
+	 i--;
+	 }
+      if (i == -EQUEUELEN) break;
+
+      /*
+       * OK, here's the character we're actually rubbing out.  Back up.
+       */
+      c = EVQUESUB(w,i);
+      pre_x = ws->x;
+      ws->x -= TEXTWIDTH(w, &c, 1);
+      /*
+       * Physically erase the character from the queue.  This results in
+       * two control-H's present in the queue.
+       */
+      *evquesub(w,i) = '\010';
+      /*
+       * Save the backed-up position, and draw spaces through the erased.
+       */
+      i = ws->x;
+      while(ws->x < pre_x) {
+	 xdis(w, " ",1);
+	 }
+      ws->x = i;
+      break;
+      }
+    /*
+     * bell (control-G)
+     */
+    case '\007':
+      break;
+   default:
+      xdis(w, &c, 1);
+      }
+   /*
+    * turn the cursor back on
+    */
+   UpdateCursorPos(ws,wc);
+   return 0;
+   }
+
+/*
+ * wgetq - get event from pending queue
+ */
+int wgetq(wbp w, dptr res)
+   {
+   MSG m;
+   wsp ws;
+   int first = 0, i = 0, j;
+   int hascaret = 0;
+   FILE *f;
+
+   if (!w || !(ws = w->window) || !(ws->iconwin)) {
+      return -1;
+      }
+   while (1) {
+      /*
+       * grab the built up queue
+       */
+      if (!EVQUEEMPTY(ws)) {
+	 EVQUEGET(ws, *res);
+	 if (ws->hasCaret) {
+            HideCaret(ws->iconwin);
+            DestroyCaret();
+            ws->hasCaret = 0;
+            }
+	 return 1;
+	 }
+      if (ISCURSORON(w) && ws->hasCaret == 0) {
+	 CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w));
+	 SetCaretPos(ws->x, ws->y - ASCENT(w));
+	 SetCaretBlinkTime(500);
+         ShowCaret(ws->iconwin);
+	 ws->hasCaret = 1;
+         }
+      i++;
+      if (check_and_get_msg(&m) <= 0) return -1;
+      TranslateMessage(&m);
+      DispatchMessage(&m);
+      }
+   }
+
+/*
+ * determine the new size of the client
+ */
+int setheight(w, height)
+wbp w;
+int height;
+   {
+   wsp ws = w->window;
+   ws->height = height;
+   return Succeeded;
+   }
+
+/*
+ * determine new size of client
+ */
+int setwidth(w, width)
+wbp w;
+SHORT width;
+   {
+   wsp ws = w->window;
+   ws->width = width;
+   return Succeeded;
+   }
+
+int setgeometry(w, geo)
+wbp w;
+char *geo;
+   {
+   wsp ws = w->window;
+   int width = 0, height = 0;
+   int x = 0, y = 0, status;
+   if ((status = parsegeometry(geo, &x, &y, &width, &height)) == 0)
+      return Error;
+   if (status & 1) {
+      ws->width = width;
+      ws->height = height;
+      }
+   if (status & 2) {
+      ws->posx = x;
+      ws->posy = y;
+      }
+   return Succeeded;
+   }
+
+int setcanvas(w,s)
+wbp w;
+char *s;
+   {
+   int cmd;
+   wsp ws = w->window;
+   HWND stdwin = ws->win;
+
+   if (!strcmp(s, "iconic")) {
+      cmd = SW_MINIMIZE;
+      CLRTOBEHIDDEN(ws);
+      }
+   else if (!strcmp(s, "normal")) {
+      cmd = SW_RESTORE;
+      stdwin = ws->win = ws->iconwin;
+      CLRTOBEHIDDEN(ws);
+      }
+   else if (!strcmp(s, "maximal")) {
+      cmd = SW_SHOWMAXIMIZED;
+      stdwin = ws->win = ws->iconwin;
+      CLRTOBEHIDDEN(ws);
+      }
+   else if (!strcmp(s, "hidden")) {
+      cmd = SW_HIDE;
+      SETTOBEHIDDEN(ws);
+      }
+   else {
+      return Error;
+      }
+   if (stdwin)
+      ShowWindow(stdwin, cmd);
+
+   return Succeeded;
+   }
+
+int seticonicstate(w, val)
+wbp w;
+char *val;
+   {
+   int height;
+   return Failed;
+   }
+
+int seticonlabel(w, val)
+wbp w;
+char *val;
+   {
+   wsp ws = w->window;
+   if (ws->iconlabel != NULL) free(ws->iconlabel);
+   ws->iconlabel = salloc(val);
+   if (ws->win && IsIconic(ws->win))
+      SetWindowText(ws->win, ws->iconlabel);
+   return Succeeded;
+   }
+
+int seticonpos(w, val)
+wbp w;
+char *val;
+   {
+   return Failed;
+   }
+
+
+int setwindowlabel(w, val)
+wbp w;
+char *val;
+   {
+   wsp ws = w->window;
+   /*
+    * plug in the new string
+    */
+   if (ws->windowlabel != NULL)
+      free(ws->windowlabel);
+   ws->windowlabel = salloc(val);
+
+   /*
+    * if we have to update, do it
+    */
+   if (ws->win && !IsIconic(ws->win))
+      SetWindowText(ws->win, ws->windowlabel);
+   return Succeeded;
+   }
+
+int setcursor(w, on)
+wbp w;
+int on;
+   {
+   wsp ws = w->window;
+   if (on) {
+      SETCURSORON(w);
+      }
+   else {
+      CLRCURSORON(w);
+      }
+   return Succeeded;
+   }
+
+HFONT findfont(char *family, int size, int flags, int ansi)
+{
+   int weight;
+   char slant, spacing;
+
+   if (size < 0) size = DEFAULTFONTSIZE;
+
+   if (flags & FONTFLAG_MEDIUM)
+      weight = FW_MEDIUM;
+   else if ((flags & FONTFLAG_DEMI) && (flags & FONTFLAG_BOLD))
+      weight = FW_DEMIBOLD;
+   else if (flags & FONTFLAG_BOLD)
+      weight = FW_BOLD;
+   else if (flags & FONTFLAG_DEMI)
+      weight = FW_SEMIBOLD;
+   else if (flags & FONTFLAG_LIGHT)
+      weight = FW_LIGHT;
+   else
+      weight = FW_DONTCARE;
+
+   if (flags & FONTFLAG_ITALIC)
+      slant = 1;
+   else
+      slant = 0;
+
+   if (flags & FONTFLAG_PROPORTIONAL)
+      spacing = VARIABLE_PITCH;
+   else if (flags & FONTFLAG_MONO)
+      spacing = FIXED_PITCH;
+   else spacing = DEFAULT_PITCH;
+
+   return CreateFont(size, 0, 0, 0, weight, slant, 0, 0,
+		(ansi && (MAXBYTESPERCHAR==1)) ? ANSI_CHARSET:DEFAULT_CHARSET,
+		OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
+		spacing, family);
+}
+
+HFONT mkfont(char *s)
+{
+   int flags, size;
+   char family[MAXFONTWORD+1];
+   char *stdfam = NULL;
+   HFONT hf = 0;
+
+   if (parsefont(s, family, &flags, &size)) {
+      /*
+       * This is a legal Icon font spec.
+       * Check first for special "standard" family names.
+       */
+      if (!strcmp(family, "mono") || !strcmp(family, "fixed")) {
+	 stdfam = "Lucida Sans";
+	 flags |= FONTFLAG_MONO + FONTFLAG_SANS;
+	 }
+      else if (!strcmp(family, "typewriter")) {
+	 stdfam = "Courier New"; /* was "courier" */
+	 flags |= FONTFLAG_MONO + FONTFLAG_SERIF;
+	 }
+      else if (!strcmp(family, "sans")) {
+	 stdfam = "Arial"; /* was "swiss" */
+	 flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS;
+	 }
+      else if (!strcmp(family, "serif")) {
+	 stdfam = "Times New Roman";
+	 flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF;
+	 }
+      else stdfam = NULL;
+
+      if (stdfam) {
+	 /*
+	  * Standard name: first try preferred family, then generalize.
+	  * ICONFONT can be NULL, in which case Windows chooses.
+	  */
+	 hf = findfont(stdfam, size, flags, 1);
+	 if (hf == NULL)
+	    hf = findfont(getenv("ICONFONT"), size, flags, 1);
+	 }
+      else {
+	 /*
+	  * Any other name: must match as specified.
+	  */
+	 hf = findfont(family, size, flags, 0);
+	 }
+      }
+   return hf;
+}
+
+/*
+ * Set the window's font by name.
+ */
+int setfont(w, s)
+wbp w;
+char **s;
+   {
+   wsp ws = w->window;
+   wcp wc = w->context;
+   HFONT hf, oldfont;
+   TEXTMETRIC	metrics;
+   HDC tmpdc;
+
+   hf = mkfont(*s);
+   if (hf != NULL) {
+      if (wc->font->font)
+	 DeleteObject(wc->font->font);
+      wc->font->font = hf;
+      if (wc->font->name)
+         free(wc->font->name);
+      wc->font->name = salloc(*s);
+
+      tmpdc = GetDC(ws->iconwin);
+      oldfont = SelectObject(tmpdc, hf);
+      wc->font->charwidth = dc_maxcharwidth(tmpdc);
+      if (GetTextMetrics(tmpdc, &metrics) == 0) {
+         /* gettextmetrics can fail; what should we do about it? */
+         ;
+         }
+      SelectObject(tmpdc, oldfont);
+      ReleaseDC(ws->iconwin, tmpdc);
+      wc->font->ascent = metrics.tmAscent;
+      wc->font->descent = metrics.tmDescent;
+/*    wc->font->charwidth = metrics.tmMaxCharWidth; unreliable due to MS bug */
+      wc->leading = wc->font->height = metrics.tmHeight;
+      return Succeeded;
+      }
+   return Failed;
+   }
+
+/*
+ * rebind() - bind w's context to that of w2.
+ */
+int rebind(w, w2)
+wbp w, w2;
+   {
+   wsp ws = w->window;
+   /* decrement w->context->refcount?  increment w2->context->refcount? */
+   w->context = w2->context;
+   return Succeeded;
+   }
+
+void setclip(w)
+wbp w;
+   {
+   wcp wc = w->context;
+   if (wc->cliprgn)
+      DeleteObject(wc->cliprgn);
+   if (wc->clipw >= 0)
+      wc->cliprgn = CreateRectRgn(wc->clipx, wc->clipy,
+				  wc->clipx + wc->clipw,
+				  wc->clipy + wc->cliph);
+   else
+      wc->cliprgn = NULL;
+   }
+
+void unsetclip(w)
+wbp w;
+   {
+   wcp wc = w->context;
+   if (wc->cliprgn)
+      DeleteObject(wc->cliprgn);
+   wc->cliprgn = NULL;
+   }
+
+ int lowerWindow(wbp w)
+   {
+   wsp ws = w->window;
+   if (ws->win)
+      SetWindowPos(ws->win, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE);
+   return Succeeded;
+   }
+
+int raiseWindow(wbp w)
+   {
+   wsp ws = w->window;
+   if (ws->win)
+      SetWindowPos(ws->win, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE);
+   return Succeeded;
+   }
+
+int nativecolor(w, s, r, g, b)
+wbp w;
+char *s;
+long *r, *g, *b;
+   {
+   return 0;                    /* no new colors beyond those of Icon */
+   }
+/*
+ * convert an Icon linear color into an MS Windows color value
+ */
+SysColor mscolor(wbp w, long r, long g, long b)
+{
+   SysColor x;
+   double invgamma = 1.0 / w->context->gamma;
+   long int red, green, blue;
+
+   red   = 65535L * pow(r / 65535.0, invgamma);
+   green = 65535L * pow(g / 65535.0, invgamma);
+   blue  = 65535L * pow(b / 65535.0, invgamma);
+   return RGB(red >> 8, green >> 8, blue >> 8);
+}
+
+/*
+ * Set the context's fill style by name.
+ */
+int setfillstyle(w, s)
+wbp w;
+char *s;
+   {
+   wcp wc = w->context;
+
+   if (!strcmp(s, "solid")) {
+      wc->brush.lbStyle = wc->fillstyle = BS_SOLID;
+      wc->brush.lbColor = PALCLR(wc->fg);
+      }
+   else {
+      if (!strcmp(s, "masked")
+      || !strcmp(s, "stippled") || !strcmp(s, "patterned")) {
+	 wc->brush.lbStyle = wc->fillstyle = BS_PATTERN;
+	 wc->brush.lbColor = PALCLR(wc->fg);
+	 wc->brush.lbHatch = (LONG)wc->pattern;
+         wc->bkmode = TRANSPARENT;
+	 }
+      else if (!strcmp(s, "textured")
+      || !strcmp(s, "opaquestippled") || !strcmp(s, "opaquepatterned")) {
+	 wc->brush.lbStyle = wc->fillstyle = BS_PATTERN;
+	 wc->brush.lbColor = PALCLR(wc->fg);
+	 wc->brush.lbHatch = (LONG)wc->pattern;
+         wc->bkmode = OPAQUE;
+	 }
+      else {
+	 return Error;
+	 }
+      }
+   return Succeeded;
+   }
+
+/*
+ * Set the context's line style by name.
+ */
+int setlinestyle(w, s)
+wbp w;
+char *s;
+   {
+   wcp wc = w->context;
+   SHORT ltype;
+
+   if ((ltype = si_s2i(siLineTypes, s)) < 0)
+      return Error;
+   wc->pen.lopnStyle = ltype;
+   resetfg(w);
+   if(!strcmp(s, "striped")) wc->bkmode = OPAQUE;
+   else wc->bkmode = TRANSPARENT;
+   return Succeeded;
+   }
+
+/*
+ * Set the context's line width
+ */
+int setlinewidth(wbp w, LONG linewid)
+   {
+   wcp wc = w->context;
+   wc->pen.lopnWidth.x = wc->pen.lopnWidth.y =
+      wc->bgpen.lopnWidth.x = wc->bgpen.lopnWidth.y = linewid;
+   return Succeeded;
+   }
+
+
+/*
+ * Set the foreground to draw in a mutable color
+ */
+int isetfg(wbp w, int i)
+   {
+   char tmp[20];
+   wcp wc = w->context;
+   if (-i > numColors) return Failed;
+   wc->fg = (0x01000000L | -i);
+   sprintf(tmp, "%ld", -i);
+   if (wc->fgname != NULL) free(wc->fgname);
+   wc->fgname = salloc(tmp);
+   wc->pen.lopnColor = wc->fg;
+   wc->brush.lbStyle = BS_SOLID;
+   wc->brush.lbColor = wc->fg;
+   return Succeeded;
+   }
+
+/*
+ * Set the context's background color by color cell.
+ */
+int isetbg(w, i)
+wbp w;
+int i;
+   {
+   char tmp[20];
+   wcp wc = w->context;
+   if (-i > numColors) return Failed;
+   wc->bg = (0x01000000L | -i);
+   sprintf(tmp, "%ld", -i);
+   if (wc->bgname != NULL) free(wc->bgname);
+   wc->bgname = salloc(tmp);
+   wc->bgpen.lopnColor = wc->bg;
+   wc->bgbrush.lbStyle = BS_SOLID;
+   wc->bgbrush.lbColor = wc->bg;
+   return ISXORREVERSE(w) ? resetfg(w) : Succeeded;
+   }
+
+
+int getdepthDC(HDC dc)
+{
+   return GetDeviceCaps(dc, BITSPIXEL) * GetDeviceCaps(dc, PLANES);
+}
+
+int getdepth(wbp w)
+{
+   int i, j;
+   STDLOCALS(w);
+   i = GetDeviceCaps(pixdc, BITSPIXEL);
+   j = GetDeviceCaps(pixdc, PLANES);
+   FREE_STDLOCALS(w);
+   return i * j;
+}
+
+int devicecaps(wbp w, int i)
+{
+   int rv;
+   STDLOCALS(w);
+   rv = GetDeviceCaps(pixdc, i);
+   FREE_STDLOCALS(w);
+   return rv;
+}
+
+/*
+ * Reset the context's foreground color to whatever it is supposed to be.
+ */
+int resetfg(w)
+wbp w;
+   {
+   return setfg(w, w->context->fgname);
+   }
+
+int alc_rgb(wbp w, SysColor rgb)
+{
+   int i;
+   wsp ws = w->window;
+   HDC hdc;
+   PALETTEENTRY pe;
+   LOGPALETTE lp;
+   if (palette) {
+      for (i=0; i < numColors; i++) {
+         if (rgb == scp[i].c && scp[i].type == SHARED) break;
+	 }
+      if (i == numColors) {
+         numColors++;
+	 if (ResizePalette(palette, numColors) == 0) {
+	    numColors--;
+	    return Failed;
+            }
+         scp = realloc(scp, numColors * sizeof(struct wcolor));
+         if (scp == NULL) { numColors--; return Failed; }
+	 scp[numColors - 1].c = rgb;
+	 scp[numColors - 1].type = SHARED;
+	 sprintf(scp[numColors - 1].name, "%d,%d,%d",
+                 RED(rgb), GREEN(rgb), BLUE(rgb));
+         lp.palNumEntries = 1;
+	 lp.palVersion = 0x300;
+	 lp.palPalEntry[0].peFlags = 0;
+	 lp.palPalEntry[0].peRed = RED(rgb);
+	 lp.palPalEntry[0].peGreen = GREEN(rgb);
+	 lp.palPalEntry[0].peBlue = BLUE(rgb);
+         SetPaletteEntries(palette, numColors - 1, 1, lp.palPalEntry);
+	 hdc = GetDC(ws->iconwin);
+	 SelectPalette(hdc, palette, FALSE);
+	 RealizePalette(hdc);
+	 ReleaseDC(ws->iconwin, hdc);
+	 }
+      }
+   return Succeeded;
+}
+
+/*
+ * Retrieve next message, returning 0 if WM_QUIT, -1 if there is an error.
+ */
+int check_and_get_msg( MSG *pMsg )
+{
+   BOOL result;
+   if ((result = GetMessage(pMsg, NULL, 0, 0)) <= 0)
+   {
+      return (result < 0) ? -1 : 0;
+   }
+   return 1;
+}
+
+/*
+ * Set the context's foreground color
+ */
+int setfg(wbp w, char *val)
+   {
+   long r, g, b;
+   wcp wc = w->context;
+   if (parsecolor(w, val, &r, &g, &b) == Succeeded) {
+      wc->fg = mscolor(w, r, g, b);
+      if (alc_rgb(w, wc->fg) == Failed) return Failed;
+      if (!wc->fgname) wc->fgname = salloc(val);
+      else if (strcmp(wc->fgname, val)) {
+         free(wc->fgname);
+         wc->fgname = salloc(val);
+	 }
+      wc->brush.lbColor =
+	 PALCLR(ISXORREVERSE(w) ? ((wc->fg ^ wc->bg) & 0x00FFFFFF) : wc->fg);
+      wc->pen.lopnColor = wc->brush.lbColor;
+      wc->brush.lbStyle = wc->fillstyle;
+      if (wc->fillstyle == BS_PATTERN)
+	 wc->brush.lbHatch = (LONG)wc->pattern;
+      return Succeeded;
+      }
+   return Failed;
+   }
+
+/*
+ * Set the window context's background color
+ */
+int setbg(wbp w, char *val)
+   {
+   long r, g, b;
+   wcp wc = w->context;
+   if (parsecolor(w, val, &r, &g, &b) == Succeeded) {
+      wc->bg = mscolor(w, r, g, b);
+      if (alc_rgb(w, wc->bg) == Failed) return Failed;
+      if (!wc->bgname) wc->bgname = salloc(val);
+      else if (strcmp(wc->bgname, val)) {
+         free(wc->bgname);
+         wc->bgname = salloc(val);
+	 }
+      wc->bgpen.lopnColor = PALCLR(wc->bg);
+      wc->bgbrush.lbStyle = BS_SOLID;
+      wc->bgbrush.lbColor = PALCLR(wc->bg);
+      return ISXORREVERSE(w) ? resetfg(w) : Succeeded;
+      }
+   return Failed;
+   }
+
+/*
+ * Set the gamma correction factor.
+ */
+int setgamma(w, gamma)
+wbp w;
+double gamma;
+   {
+   wcp wc = w->context;
+   wc->gamma = gamma;
+   setfg(w, wc->fgname);
+   setbg(w, wc->bgname);
+   return Succeeded;
+   }
+
+/*
+ * setpointer() - define a mouse pointer shape
+ */
+int setpointer(w, val)
+wbp w;
+char *val;
+   {
+   HCURSOR c;
+   char *cval;
+   if (!strcmp(val,"arrow")) cval = IDC_ARROW;
+   else if (!strcmp(val,"cross")) cval = IDC_CROSS;
+   else if (!strcmp(val,"ibeam")) cval = IDC_IBEAM;
+   else if (!strcmp(val,"uparrow")) cval = IDC_UPARROW;
+   else if (!strcmp(val,"wait")) cval = IDC_WAIT;
+   else if (!strcmp(val,"starting")) cval = IDC_APPSTARTING;
+   else if (!strcmp(val,"icon")) cval = IDC_ICON;
+   else if (!strcmp(val,"size")) cval = IDC_SIZE;
+   else if (!strcmp(val,"sizenesw")) cval = IDC_SIZENESW;
+   else if (!strcmp(val,"sizens")) cval = IDC_SIZENS;
+   else if (!strcmp(val,"sizenwse")) cval = IDC_SIZENWSE;
+   else if (!strcmp(val,"sizewe")) cval = IDC_SIZEWE;
+   else if (!strcmp(val,"no")) cval = IDC_NO;
+   else {
+      return Failed;
+      }
+   c = LoadCursor(NULL, cval);
+   if (c == NULL) {
+     return Failed;
+     }
+   w->window->curcursor = c;
+   if (w->window->cursorname) free(w->window->cursorname);
+   w->window->cursorname = salloc(val);
+   if (! w->window->savedcursor)
+      w->window->savedcursor = SetCursor(c);
+   else (void) SetCursor(c);
+   /* should restore savedcursor when pointer moves outside our window */
+   return Succeeded;
+   }
+
+/*
+ * setdrawop() - set the drawing operation
+ */
+int setdrawop(w, val)
+wbp w;
+char *val;
+   {
+   wcp wc = w->context;
+   if (!strcmp(val,"reverse")) {
+      if (!ISXORREVERSE(w)) {
+	 SETXORREVERSE(w);
+         wc->drawop = R2_XORPEN;
+         resetfg(w);
+	 }
+      }
+   else {
+      if (ISXORREVERSE(w)) {
+	 CLRXORREVERSE(w);
+         resetfg(w);
+	 }
+      wc->drawop = si_s2i(drawops,val);
+      if (wc->drawop == -1) { wc->drawop = R2_COPYPEN; return Error; }
+      }
+   return Succeeded;
+   }
+
+setdisplay(wbp w, char *val)
+   {
+   if (strcmp(val, "MS Windows"))
+      return Failed;
+   return Succeeded;
+   }
+
+setimage(wbp w, char *val)
+   {
+   wsp ws = w->window;
+   int status;
+   ws->initialPix = loadimage(w, val, &(ws->width), &(ws->height),
+			  0, &status);
+   if (ws->initialPix == (HBITMAP) NULL) return Failed;
+   return Succeeded;
+   }
+
+setleading(w, i)
+wbp w;
+int i;
+   {
+   wcp wc = w->context;
+   wc->leading = i;
+   }
+
+void toggle_fgbg(w)
+wbp w;
+   {
+   SysColor tmp;
+   LOGPEN tpen;
+   LOGBRUSH tbrush;
+   wcp wc = w->context;
+   tmp = wc->fg;
+   wc->fg = wc->bg;
+   wc->bg = tmp;
+   tpen = wc->pen;
+   wc->pen = wc->bgpen;
+   wc->bgpen = tpen;
+   tbrush = wc->brush;
+   wc->brush = wc->bgbrush;
+   wc->bgbrush = tbrush;
+   }
+
+int getvisual(w, answer)
+wbp w;
+char *answer;
+   {
+   return Failed;
+   }
+
+/*
+ * getpos() - update the window state's notion of its current position
+ */
+int getpos(w)
+wbp w;
+   {
+   return Succeeded;
+   }
+
+void getfg(w, answer)
+wbp w;
+char *answer;
+   {
+   strcpy(answer, w->context->fgname);
+   }
+
+void getbg(w, answer)
+wbp w;
+char *answer;
+   {
+   strcpy(answer, w->context->bgname);
+   }
+
+void getlinestyle(w, answer)
+wbp w;
+char *answer;
+   {
+   wcp wc = w->context;
+   char *ptr = si_i2s(siLineTypes, wc->pen.lopnStyle);
+   if (ptr != NULL) {
+      strcpy(answer, ptr);
+      }
+   else strcpy(answer, "unknown");
+   }
+
+void getfntnam(w, answer)
+wbp w;
+char *answer;
+   {
+   strcpy(answer, w->context->font->name);
+   }
+
+void getpointername(w, answer)
+wbp w;
+char *answer;
+   {
+   char *s;
+   wsp ws = w->window;
+   strcpy(answer, w->window->cursorname);
+   }
+
+void getdisplay(wbp w, char *answer)
+   {
+   strcpy(answer, "MS Windows");
+   }
+
+void getdrawop(w, answer)
+wbp w;
+char *answer;
+   {
+   char *s;
+   if (ISXORREVERSE(w)) s = "reverse";
+   else s = si_i2s(drawops, w->context->drawop);
+   if (s) sprintf(answer, "%s", s);
+   else strcpy(answer, "unknown");
+   }
+
+void geticonic(w, answer)
+wbp w;
+char *answer;
+   {
+   getcanvas(w, answer);
+   }
+
+void getcanvas(w, answer)
+wbp w;
+char *answer;
+   {
+   wsp ws = w->window;
+   if (ws->iconwin) {
+      if (!IsWindowVisible(ws->iconwin)) sprintf(answer, "hidden");
+      else if (IsIconic(ws->iconwin)) sprintf(answer, "iconic");
+      else if (IsZoomed(ws->iconwin)) sprintf(answer, "maximal");
+      else sprintf(answer,"normal");
+      }
+   else sprintf(answer,"hidden");
+   }
+
+int geticonpos(w, val)
+wbp w;
+char *val;
+   {
+   return Failed;
+   }
+
+/*
+ * erase an area
+ */
+void eraseArea(w,x,y,width,height)
+wbp w;
+int x, y, width, height;
+   {
+   HBRUSH hb, oldbrush, oldbrush2;
+   XRectangle rect;
+   STDLOCALS(w);
+   hb = CreateBrushIndirect(&(wc->bgbrush));
+   if (stdwin) oldbrush = SelectObject(stddc, hb);
+   oldbrush2 = SelectObject(pixdc, hb);
+   rect.left = x; rect.right = x + width;
+   rect.top = y; rect.bottom = y + height;
+
+   if (stdwin) FillRect(stddc, &rect, hb);
+   FillRect(pixdc, &rect, hb);
+   if (stdwin) SelectObject(stddc, oldbrush);
+   SelectObject(pixdc, oldbrush2);
+   DeleteObject(hb);
+   FREE_STDLOCALS(w);
+   }
+
+/*
+ * copy an area
+ */
+int copyArea(w,w2,x,y,width,height,x2,y2)
+wbp w, w2;
+int x, y, width, height, x2, y2;
+   {
+   int lpad, rpad, tpad, bpad;
+   RECT r;
+   HDC srcdc, srcpixdc;
+   HBRUSH hb;
+   wsp ws1 = w->window;
+   HBITMAP oldpix;
+   STDLOCALS(w2);
+   /*
+    * setup device contexts for area copy
+    */
+   SetROP2(pixdc, R2_COPYPEN);
+   hb = CreateBrushIndirect(&(wc->bgbrush));
+   if (stdwin)
+      SetROP2(stddc, R2_COPYPEN);
+   if (w2->window == w->window) {
+      srcdc = pixdc;
+      srcpixdc = pixdc;
+      }
+   else {
+      srcdc = GetDC(w->window->iconwin);
+      srcpixdc = CreateCompatibleDC(srcdc);
+      SetROP2(srcpixdc, R2_COPYPEN);
+      }
+   oldpix = SelectObject(srcpixdc, w->window->pix);
+
+   /*
+    * copy area, write unavailable areas with bg color
+    */
+   if (x + width < 0 || y + height < 0 || x >= ws1->pixwidth || y >= ws1->pixheight) {
+      /* source is entirely offscreen, just fill with background */
+      r.left = x2; r.top = y2;
+      r.right = x2 + width; r.bottom = y2 + height;
+      if (stdwin)
+         FillRect(stddc, &r, hb);
+      FillRect(pixdc, &r, hb);
+      }
+   else {
+	 /*
+	  * Check for source partially offscreen, but copy first and
+	  * fill later in case the source and destination overlap.
+	  */
+	 lpad = rpad = tpad = bpad = 0;
+         if (x < 0) {			/* source extends past left edge */
+	    lpad = -x;
+            width -= lpad;
+            x2 += lpad;
+            x = 0;
+            }
+         if (x + width > ws1->pixwidth) {  /* source extends past right edge */
+            rpad = x + width - ws1->pixwidth;
+            width -= rpad;
+            }
+         if (y < 0) {			/* source extends above top edge */
+	    tpad = -y;
+            height -= tpad;
+            y2 += tpad;
+            y = 0;
+            }
+         if (y + height > ws1->pixheight) {  /* source extends below bottom */
+            bpad = y + height - ws1->pixheight;
+            height -= bpad;
+            }
+      if (stdwin)
+         BitBlt(stddc, x2, y2, width, height, srcpixdc, x, y, SRCCOPY);
+      BitBlt(pixdc, x2, y2, width, height, srcpixdc, x, y, SRCCOPY);
+
+	 if (lpad > 0) {
+            r.left = x2-lpad;
+	    r.top = y2-tpad;
+	    r.right = r.left + lpad;
+	    r.bottom = r.top + tpad+height+bpad;
+            if (stdwin)
+               FillRect(stddc, &r, hb);
+            FillRect(pixdc, &r, hb);
+            }
+	 if (rpad > 0) {
+            r.left = x2+width;
+	    r.top = y2-tpad;
+	    r.right = r.left + rpad;
+	    r.bottom = r.top + tpad+height+bpad;
+            if (stdwin)
+               FillRect(stddc, &r, hb);
+            FillRect(pixdc, &r, hb);
+	    }
+	 if (tpad > 0) {
+	    r.left = x2;
+	    r.top = y2-tpad;
+	    r.right = r.left + width;
+	    r.bottom = r.top + tpad;
+            if (stdwin)
+               FillRect(stddc, &r, hb);
+            FillRect(pixdc, &r, hb);
+	    }
+	 if (bpad > 0) {
+	    r.left = x2;
+	    r.top = y2+height;
+	    r.right = r.left + width;
+	    r.bottom = r.top + bpad;
+            if (stdwin)
+               FillRect(stddc, &r, hb);
+            FillRect(pixdc, &r, hb);
+	    }
+      }
+
+   /*
+    * free resources
+    */
+   SelectObject(srcpixdc, oldpix);
+   if (w2->window != w->window) {
+      ReleaseDC(w->window->iconwin, srcdc);
+      DeleteDC(srcpixdc);
+      }
+   DeleteObject(hb);
+   FREE_STDLOCALS(w2);
+   return Succeeded;
+   }
+
+int getdefault(w, prog, opt, answer)
+wbp w;
+char *prog, *opt, *answer;
+   {
+   return Failed;
+   }
+
+/*
+ * Draw a bilevel image.
+ */
+int blimage(w, x, y, width, height, ch, s, len)
+wbp w;
+int x, y, width, height, ch;
+unsigned char *s;
+word len;
+   {
+   unsigned int m, msk1, c, ix, iy;
+   long fg, bg;
+   SysColor palfg, palbg;
+   STDLOCALS(w);
+   palfg = PALCLR(wc->fg);
+   palbg = PALCLR(wc->bg);
+   /*
+    * Read the image string and set the pixel values.  Note that
+    * the hex digits in sequence fill the rows *right to left*.
+    */
+   m = width % 4;
+   if (m == 0)
+      msk1 = 8;
+   else
+      msk1 = 1 << (m - 1);              /* mask for first byte of row */
+
+   fg = wc->fg;
+   bg = wc->bg;
+   ix = width;
+   iy = 0;
+   m = msk1;
+   while (len--) {
+      if (isxdigit(c = *s++)) {         /* if hexadecimal character */
+	 if (!isdigit(c))               /* fix bottom 4 bits if necessary */
+	    c += 9;
+	 while (m > 0) {                /* set (usually) 4 pixel values */
+	    --ix;
+	    if (c & m) {
+	       SetPixel(pixdc, ix, iy, palfg);
+	       }
+	    else if (ch != TCH1) {      /* if zeroes aren't transparent */
+	       SetPixel(pixdc, ix, iy, palbg);
+	       }
+	    m >>= 1;
+	    }
+	 if (ix == 0) {                 /* if end of row */
+	    ix = width;
+	    iy++;
+	    m = msk1;
+	    }
+	 else
+	    m = 8;
+	 }
+      }
+   if (ix > 0)                          /* pad final row if incomplete */
+      while (ix < width)
+	 SetPixel(pixdc, ix++, iy, palbg);
+
+   /*
+    * Put it on the screen.
+    */
+   if (ws->win)
+      BitBlt(stddc, x, y, width, height, pixdc, x, y, SRCCOPY);
+   FREE_STDLOCALS(w);
+   return Succeeded;
+   }
+
+/*
+ * Draw a character-per-pixel image.
+ */
+int strimage(w, x, y, width, height, e, s, len, on_icon)
+wbp w;
+int x, y, width, height;
+struct palentry *e;
+unsigned char *s;
+word len;
+int on_icon;
+   {
+   HDC tempdc;
+   HBITMAP temppix;
+   register int c;
+   register unsigned int ix;
+   int v, anytransparent=0;
+   unsigned int iy, tmpw;
+   SysColor clrlist[256], xc, palbg;
+   char tmp[24];
+   BITMAPINFO *bmi;
+   BITMAPINFOHEADER *bmih = &(bmi->bmiHeader);
+   HBITMAP oldpix = 0;
+   STDLOCALS(w);
+
+   bmi = malloc(sizeof(BITMAPINFO) + 256 * sizeof(SysColor));
+   if (bmi == NULL) {
+      FREE_STDLOCALS(w);
+      return -1;
+      }
+
+   bmih = &(bmi->bmiHeader);
+   palbg = PALCLR(wc->bg);
+   if (on_icon) {
+      free(bmi);
+      FREE_STDLOCALS(w);
+      return -1;
+      }
+
+   bmih->biClrImportant = 0;
+   /*
+    * Build arrays of colors in SysColor and RGBQUAD format for use by
+    * either SetPixel or DIB.  Decide which to use based on whether
+    * there are any transparent pixels
+    */
+   for (c = 0; c < 256; c++) {
+      if (e[c].transpt) anytransparent++;
+      if (e[c].used && e[c].valid) {
+         bmih->biClrImportant++;
+	 clrlist[c] = mscolor(w, e[c].clr.red, e[c].clr.green, e[c].clr.blue);
+	 bmi->bmiColors[c].rgbBlue = BLUE(clrlist[c]);
+	 bmi->bmiColors[c].rgbRed = RED(clrlist[c]);
+	 bmi->bmiColors[c].rgbGreen = GREEN(clrlist[c]);
+         if (alc_rgb(w, clrlist[c]) == Failed) {
+            free(bmi);
+            FREE_STDLOCALS(w);
+            return -1;
+            }
+	 clrlist[c] = PALCLR(clrlist[c]);
+	 }
+      else {
+	 bmi->bmiColors[c].rgbBlue = BLUE(wc->bg);
+	 bmi->bmiColors[c].rgbRed = RED(wc->bg);
+	 bmi->bmiColors[c].rgbGreen = GREEN(wc->bg);
+         }
+      }
+
+   /*
+    * if transparent characters are not present, blast out a DIB.
+    */
+   if (anytransparent == 0) {
+      char *buf = malloc(height * (width+4)), *buf2;
+      buf2 = buf;
+      bmih->biSize = sizeof(BITMAPINFOHEADER);
+      bmih->biWidth = width;
+      bmih->biHeight = -height;
+      bmih->biPlanes = 1;
+      bmih->biBitCount = 8;
+      bmih->biCompression = BI_RGB;
+      bmih->biSizeImage = 0;
+      bmih->biXPelsPerMeter = 0;
+      bmih->biYPelsPerMeter = 0;
+      bmih->biClrUsed = 256;
+
+      ix = 0;
+      while (len--) {
+         *buf++ = *s++;
+         if (++ix >= width) {
+            while(ix % 4) {
+               buf++;
+               ix++;
+               }
+            ix = 0;
+            }
+         }
+      temppix=CreateDIBitmap(pixdc, bmih, CBM_INIT, buf2, bmi, DIB_RGB_COLORS);
+      free(buf2);
+      tempdc = CreateCompatibleDC(stddc);
+      oldpix = SelectObject(tempdc, temppix);
+      BitBlt(pixdc, x, y, width, height, tempdc, 0, 0, SRCCOPY);
+      SelectObject(tempdc, oldpix);
+      DeleteDC(tempdc);
+      DeleteObject(temppix);
+      }
+   else {
+      /*
+       * The image contains some transparent pixels.
+       * Read the image string and set the pixel values.
+       * Note that SetPixelV() fails under Win32s; so we don't use it.
+       */
+      ix = x;
+      iy = y;
+      tmpw = x + width;
+      while (len--) {
+         c = *s++;
+         v = e[c].valid;
+         if (v) {                         /* put char if valid */
+	    xc = SetPixel(pixdc, ix, iy, clrlist[c]);
+	    }
+         if (v || e[c].transpt) {        /* advance if valid or transparent */
+	    if (++ix >= tmpw) {
+	       ix = x;                             /* reset for new row */
+	       iy++;
+	       }
+	    }
+         }
+      if (ix > 0)                          /* pad final row if incomplete */
+         while (ix < width)
+	    SetPixel(pixdc, x+ix++, y+iy, palbg);
+      }
+
+   free(bmi);
+   /*
+    * Copy it from the pixmap onto the screen.
+    */
+   if (on_icon) {
+      FREE_STDLOCALS(w);
+      return -1;
+      }
+   else {
+      if (ws->win)
+	 BitBlt(stddc, x, y, width, height, pixdc, x, y, SRCCOPY);
+      }
+   FREE_STDLOCALS(w);
+   return 0;
+   }
+
+/*
+ * imqsearch(key,base,nel) - binary search hardwired for images
+ *
+ *  A binary search routine with arguments similar to qsort(3).
+ *  Returns a pointer to the item matching "key", or NULL if none.
+ *  This is called a LOT, so it is hardwired for speed.
+ *  Based on Bentley, CACM 28,7 (July, 1985), p. 676.
+ */
+
+SysColor * imqsearch (SysColor key, SysColor *base, int nel)
+{
+   int l, u, m;
+   SysColor * a;
+
+   l = 0;
+   u = nel - 1;
+   while (l <= u) {
+      m = (l + u) / 2;
+      a = base + m;
+      if (*a < key)
+         l = m + 1;
+      else if (*a > key)
+         u = m - 1;
+      else
+         return a;
+      }
+   while (a>base && key < *a) a--;
+   while (a<base+nel && key > *a) a++;
+   return a;
+}
+
+/*
+ * capture -- get an image region.
+ *
+ * Stores the specified subimage in data as 15-bit color.
+ */
+int capture(w, xx, yy, width, height, data)
+wbp w;
+int xx, yy, width, height;
+short *data;
+   {
+   SysColor px;
+   int r, g, b, x, y;
+   int wd = xx + width;
+   int ht = yy + height;
+   STDLOCALS(w);
+
+   for (y = yy; y < ht; y++) {
+      for (x = xx; x < wd; x++) {
+	 px = GetPixel(pixdc, x, y);
+	 r = RED(px) >> 3;
+	 g = GREEN(px) >> 3;
+	 b = BLUE(px) >> 3;
+	 *data++ = (r << 10) | (g << 5) | b;
+	 }
+      }
+   FREE_STDLOCALS(w);
+   return 1;
+   }
+
+int readimage(w, filename, x, y, status)
+wbp w;
+char *filename;
+int x, y, *status;
+   {
+   HBITMAP p, oldpix;
+   unsigned int width, height;
+   HDC srcdc, srcpixdc;
+
+   if (!x && !y)
+      p = loadimage(w, filename, &width, &height, 1, status);
+   else
+      p = loadimage(w, filename, &width, &height, 0, status);
+
+   if (p == (HBITMAP) NULL) {
+     return Failed;
+     }
+
+   {
+   STDLOCALS(w);
+
+   srcdc = GetDC(ws->iconwin);
+   srcpixdc = CreateCompatibleDC(srcdc);
+   oldpix = SelectObject(srcpixdc, p);
+   BitBlt(pixdc, x, y, width, height, srcpixdc, 0, 0, SRCCOPY);
+   if (stdwin)
+      BitBlt(stddc, x, y, width, height, srcpixdc, 0, 0, SRCCOPY);
+   SelectObject(srcpixdc, oldpix);
+   ReleaseDC(ws->iconwin, srcdc);
+   DeleteDC(srcpixdc);
+
+   /*
+    * Make sure previous ops on p are complete, then free it.
+    */
+   DeleteObject(p);
+   FREE_STDLOCALS(w);
+   return Succeeded;
+   }
+   }
+
+
+
+/*
+ * Initialize client for producing pixels from a window, or in this case,
+ * only create a device context once, not once per getpixel.
+ */
+int getpixel_init(w, imem)
+wbp w;
+struct imgmem *imem;
+   {
+   COLORREF *p;
+   wsp ws = w->window;
+   int i, j, x2, y2;
+   HDC stddc = GetDC(ws->iconwin), pixdc = CreateCompatibleDC(stddc);
+   HBITMAP oldpix;
+
+   if (palette) SelectPalette(pixdc, palette, FALSE);
+   oldpix = SelectObject(pixdc, ws->pix);
+
+   /* this looks like a bug for Win16 for images > 100x100 or so... */
+   imem->crp = malloc( imem->width * imem->height * sizeof(COLORREF));
+   if (imem->crp == NULL) return Failed;
+   p = imem->crp;
+   x2 = imem->x + imem->width;
+   y2 = imem->y + imem->height;
+   for(i = imem->y; i < y2; i++)
+      for(j = imem->x; j < x2; j++) {
+         if ((*p++ = GetPixel(pixdc, j, i)) == (COLORREF)-1L) {
+	    free(imem->crp);
+            SelectObject(pixdc, oldpix);
+            FREE_STDLOCALS(w);
+            return Failed;
+            }
+         }
+   SelectObject(pixdc, oldpix);
+   FREE_STDLOCALS(w);
+   return Succeeded;
+   }
+
+int getpixel_term(w, imem)
+wbp w;
+struct imgmem *imem;
+{
+   free(imem->crp);
+   return Succeeded;
+}
+
+/*
+ * Return pixel (x,y) from a window
+ */
+int getpixel(wbp w, int x, int y, long *rv, char *s, struct imgmem *imem)
+   {
+   COLORREF cr = imem->crp[(y-imem->y) * imem->width + (x-imem->x)];
+   *rv = 1;
+   sprintf(s, "%ld,%ld,%ld",
+	   (long)RED(cr)*257L, (long)GREEN(cr)*257L, (long)BLUE(cr)*257L);
+   return Succeeded;
+   }
+
+int query_pointer(w, pp)
+wbp w;
+XPoint *pp;
+   {
+   wsp ws = w->window;
+   RECT r;
+   if (ws->win) {
+      GetCursorPos(pp);
+      GetWindowRect(ws->win, &r);
+      pp->x -= r.left;
+      pp->y -= r.top;
+      return Succeeded;
+      }
+   return Failed;
+   }
+
+int query_rootpointer(pp)
+XPoint *pp;
+   {
+   GetCursorPos(pp);
+   return Succeeded;
+   }
+
+int seticonimage(w, dp)
+wbp w;
+dptr dp;
+   {
+   wsp ws = w->window;
+   return Succeeded;
+   }
+
+/*
+ * dumpimage -- write an image to a disk file.  Return 0 on failure.
+ */
+int dumpimage(wbp w, char *filename, unsigned int x, unsigned int y,
+	      unsigned int width, unsigned int height)
+   {
+   int result = 0;
+   HDIB dib;
+   HDC  destdc;
+   HBITMAP dumppix, oldpix;
+   STDLOCALS(w);
+
+   if (strcmp(".bmp", filename + strlen(filename) - 4) &&
+       strcmp(".BMP", filename + strlen(filename) - 4)) {
+      FREE_STDLOCALS(w);
+      return NoCvt;
+      }
+
+   /*
+    * extract the desired rectangle from the source bitmap
+    */
+   if (x || y || width != ws->pixwidth || height != ws->pixheight) {
+      dumppix  = CreateCompatibleBitmap(stddc, width, height);
+      destdc   = CreateCompatibleDC(stddc);
+      oldpix = SelectObject(destdc, dumppix);
+      BitBlt(destdc, 0, 0, width, height, pixdc, x, y, SRCCOPY);
+      }
+   else dumppix = ws->pix;
+   dib = BitmapToDIB(dumppix, palette);
+   if (dumppix != ws->pix) {
+      SelectObject(destdc, oldpix);
+      DeleteDC(destdc);
+      DeleteObject(dumppix);
+      }
+
+   if (dib == NULL) {
+      result = Failed;
+      }
+   else {
+      if (result = SaveDIB(dib, filename)) { /* != 0 implies error */
+	 result = Failed;
+	 }
+      else {
+         result = Succeeded;
+         }
+      DestroyDIB(dib);
+      }
+
+   FREE_STDLOCALS(w);
+   return result;
+   }
+
+
+/*
+ * loadimage
+ */
+HBITMAP loadimage(wbp w, char *filename, unsigned int *width,
+		  unsigned int *height, int atorigin, int *status)
+   {
+   HDC hdc;
+   HDIB dib;
+   HBITMAP bmap;
+   HPALETTE p2;
+   PALETTEENTRY pe;
+   LPBITMAPINFO lpbmi;
+   int j;
+   int ii,jj, kk;
+   int xx[256];
+   unsigned char * pd;
+   char *j2;
+
+   dib = LoadDIB(filename);
+   if (dib != NULL) {
+      LPSTR pdib;
+      p2 = CreateDIBPalette(dib);
+      j2 = GlobalLock(dib);
+      j = DIBNumColors(j2);
+      jj = DIBWidth(j2);
+      kk = DIBHeight(j2);
+      GlobalUnlock(dib);
+
+      if (!palette) {
+	 LOGPALETTE logpal[4]; /* (1, + space for an extra palette entry) */
+         hdc = GetDC(w->window->iconwin);
+         if ((GetDeviceCaps(hdc, RASTERCAPS) & RC_PALETTE) && (numColors ==0)){
+	    /* This window is on a device that supports palettes */
+	    numColors = 2;
+	    logpal[0].palNumEntries = 2;
+	    logpal[0].palVersion = 0x300;
+	    logpal[0].palPalEntry[0].peFlags = 0;
+	    logpal[0].palPalEntry[0].peRed = 0;
+	    logpal[0].palPalEntry[0].peGreen = 0;
+	    logpal[0].palPalEntry[0].peBlue = 0;
+	    logpal[0].palPalEntry[1].peFlags = 0;
+	    logpal[0].palPalEntry[1].peRed = 255;
+	    logpal[0].palPalEntry[1].peGreen = 255;
+	    logpal[0].palPalEntry[1].peBlue = 255;
+	    palette = CreatePalette(logpal);
+	    if (!palette) {
+	       return NULL;
+	       }
+	    if ((scp = malloc(2 * sizeof (struct wcolor))) == NULL)
+	       return NULL;
+	    scp[0].c = RGB(0,0,0);
+	    scp[0].type = SHARED;
+	    strcpy(scp[0].name, "black");
+	    scp[1].c = RGB(255,255,255);
+	    scp[1].type = SHARED;
+	    strcpy(scp[1].name, "white");
+            }
+	 else {
+	    /* this window is not on a device that supports palettes */
+	    }
+	 ReleaseDC(w->window->iconwin, hdc);
+         }
+      if (palette) {
+         if (ResizePalette(palette, numColors + j) == 0) {
+            return NULL;
+            }
+         for (ii = 0; ii < j; ii++) {
+            if (GetPaletteEntries(p2, ii, 1, &pe) == 0) {
+               return NULL;
+	       }
+            SetPaletteEntries(palette, numColors++, 1, &pe);
+            }
+         }
+      bmap = DIBToBitmap(dib, palette);
+      pdib = GlobalLock(dib);
+      *width = DIBWidth(pdib);
+      *height = DIBHeight(pdib);
+      GlobalUnlock(dib);
+      DestroyDIB(dib);
+      DeleteObject(p2);
+      *status = 0;
+      return bmap;
+      }
+   return NULL;
+   }
+
+
+char *get_mutable_name(wbp w, int mute_index)
+   {
+   char *tmp;
+   PALETTEENTRY pe;
+
+   if (-mute_index > numColors || scp[-mute_index].type != MUTABLE) {
+      return NULL;
+      }
+
+   if (GetPaletteEntries(palette, -mute_index, 1, &pe) == 0) {
+      return NULL;
+      }
+   tmp = scp[-mute_index].name;
+   sprintf(tmp, "%d", mute_index);
+   sprintf(tmp + strlen(tmp) + 1, "%d,%d,%d",
+      (pe.peRed << 8) | 0xff, (pe.peGreen << 8) | 0xff, (pe.peBlue << 8) | 0xff);
+   return tmp + strlen(tmp) + 1;
+   }
+
+int set_mutable(wbp w, int i, char *s)
+   {
+   long r, g, b;
+   UINT rv;
+   PALETTEENTRY pe;
+   if (palette == 0) return Failed;
+
+   {
+   STDLOCALS(w);
+   if (parsecolor(w, s, &r, &g, &b) != Succeeded) {
+      FREE_STDLOCALS(w);
+      return Failed;                        /* invalid color specification */
+      }
+   pe.peRed = r >> 8;
+   pe.peGreen = g >> 8;
+   pe.peBlue = b >> 8;
+   pe.peFlags = PC_RESERVED;
+   raiseWindow(w);	/* mutable won't mutate if window isn't active */
+#if 1
+   AnimatePalette(palette, -i, 1, &pe);
+   rv = SetPaletteEntries(palette, -i, 1, &pe);
+#endif
+   UnrealizeObject(palette);
+   RealizePalette(stddc);
+   AnimatePalette(palette, -i, 1, &pe);
+   FREE_STDLOCALS(w);
+}
+   return Succeeded;
+   }
+
+void free_mutable(wbp w, int mute_index)
+   {
+   }
+
+/*
+ * Allocate a mutable color
+ */
+int mutable_color(wbp w, dptr argv, int argc, int *retval)
+   {
+   long r, g, b;
+   tended char *str;
+   LOGPALETTE lp;
+   {
+   STDLOCALS(w);
+
+   if (!stddc || ((GetDeviceCaps(stddc, RASTERCAPS) & RC_PALETTE) == 0)) {
+      FREE_STDLOCALS(w);
+      return Failed;
+      }
+
+   numColors++;
+   scp = realloc(scp, numColors * sizeof(struct wcolor));
+   if (scp == NULL) {
+      FREE_STDLOCALS(w);
+      return Failed;
+      }
+   scp[numColors-1].c = -(numColors-1);
+   sprintf(scp[numColors-1].name, "%d:", -(numColors-1));
+   scp[numColors-1].type = MUTABLE;
+   if (ResizePalette(palette, numColors) == 0) {
+      FREE_STDLOCALS(w);
+      return Failed;
+      }
+
+   if (argc > 0) {                     /* set the color */
+      if (argc != 1) {
+         FREE_STDLOCALS(w);
+         return Error;
+         }
+      /*
+       * old-style check for C integer
+       */
+      else if (argv[0].dword == D_Integer) {/* check for color cell */
+	 if (IntVal(argv[0]) >= 0) {
+            FREE_STDLOCALS(w);
+	    return Failed;        /* must be negative */
+            }
+	 if (GetPaletteEntries(palette, -IntVal(argv[0]),
+	    1, lp.palPalEntry) == 0) {
+            FREE_STDLOCALS(w);
+            return Error;
+            }
+	 /* convert to linear color? */
+	 }
+      else {
+	 if (!cnv:C_string(argv[0],str)) {
+            FREE_STDLOCALS(w);
+	    ReturnErrVal(103,argv[0], Error);
+	    }
+	 if (parsecolor(w, str, &r, &g, &b) != Succeeded) {
+	    /* reduce logical palette size and count */
+            FREE_STDLOCALS(w);
+	    numColors--;
+            ResizePalette(palette, numColors);
+	    return Failed;                   /* invalid color specification */
+	    }
+	 lp.palPalEntry[0].peRed = r >> 8;
+	 lp.palPalEntry[0].peGreen = g >> 8;
+	 lp.palPalEntry[0].peBlue = b >> 8;
+	 }
+      lp.palNumEntries = 1;
+      lp.palVersion = 0x300;
+      lp.palPalEntry[0].peFlags = PC_RESERVED;
+      SetPaletteEntries(palette, numColors - 1, 1, lp.palPalEntry);
+      UnrealizeObject(palette);
+      RealizePalette(stddc);
+      }
+
+   *retval = -(numColors - 1);
+   FREE_STDLOCALS(w);
+   return Succeeded;
+   }
+   }
+
+void freecolor(wbp w, char *s)
+   {
+   }
+
+/*
+ * drawarcs() - assumes x and y are already fixed up for the bitmap
+ */
+void drawarcs(wbp wb, XArc *arcs, int narcs)
+   {
+   register XArc *arc = arcs;
+   int i, halfwidth, halfheight, x1, y1, x2, y2, right, bottom;
+   double a1_a2;
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(wb);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   for (i = 0; i < narcs; i++, arc++) {
+      halfwidth = arc->width >> 1;
+      halfheight = arc->height >> 1;
+      arc->angle1 = -arc->angle1 - arc->angle2;
+      a1_a2 = arc->angle1 + arc->angle2;
+      x1 = arc->x + halfwidth + (int)(halfwidth * cos(arc->angle1));
+      y1 = arc->y + halfheight - (int)(halfheight * sin(arc->angle1));
+      x2 = arc->x + halfwidth + (int)(halfwidth * cos(a1_a2));
+      y2 = arc->y + halfheight - (int)(halfheight * sin(a1_a2));
+      right = arc->x + arc->width + 1;
+      bottom = arc->y + arc->height + 1;
+      if (ws->win)
+	 Arc(stddc, arc->x, arc->y, right, bottom, x1, y1, x2, y2);
+      Arc(pixdc, arc->x, arc->y, right, bottom, x1, y1, x2, y2);
+      }
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+/*
+ * drawlines - Support routine for DrawLine
+ */
+void drawlines(wbinding *wb, XPoint *points, int npoints)
+   {
+   int i, diff, bheight;
+   HPEN hp, oldpen, oldpen2;
+   XPoint tmp[2];
+   STDLOCALS(wb);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   tmp[0] = points[npoints-1];
+   tmp[1] = points[npoints-2];
+   if (ws->win) {
+      SetBkMode(stddc, wc->bkmode);
+      Polyline(stddc, points, npoints);
+      Polyline(stddc, tmp, 2);
+      }
+   SetBkMode(pixdc, wc->bkmode);
+   Polyline(pixdc, points, npoints);
+   Polyline(pixdc, tmp, 2);
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+/*
+ * drawpoints() -
+ *  Parameters - the window binding for output, an array of points (assumed
+ *               to be fixed up for bitmap) and the number of points
+ */
+void drawpoints(wbinding *wb, XPoint *points, int npoints)
+   {
+   register XPoint *p, *endp;
+   SysColor palfg;
+   STDLOCALS(wb);
+   endp = points + npoints;
+   palfg = PALCLR(wc->fg);
+   if (stdwin) {
+      for(p = points; p < endp; p++) {
+         SetPixel(stddc, p->x, p->y, palfg);
+         SetPixel(pixdc, p->x, p->y, palfg);
+         }
+      }
+   else {
+      for(p = points; p < endp; p++) {
+         SetPixel(pixdc, p->x, p->y, palfg);
+         }
+      }
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+/*
+ * drawsegments() -
+ */
+void drawsegments(wbinding *wb, XSegment *segs, int nsegs)
+   {
+   int i, bheight;
+   XPoint ps[2];
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(wb);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   if (stdwin) {
+      SetBkMode(stddc, wc->bkmode);
+      for (i = 0; i < nsegs; i++) {
+	 Polyline(stddc, (POINT *)(segs+i), 2);
+	 }
+      }
+   SetBkMode(pixdc, wc->bkmode);
+   for (i = 0; i < nsegs; i++) {
+      Polyline(pixdc, (POINT *)(segs+i), 2);
+      }
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+int allowresize(w, on)
+wbp w;
+int on;
+   {
+   if (on)
+      SETRESIZABLE(w);
+   else
+      CLRRESIZABLE(w);
+   return Succeeded;
+   }
+int getselection(wbp w, char *buf)
+{
+   return Failed;
+   }
+int setselection(wbp w, char *val)
+{
+   return Failed;
+   }
+
+/*
+ * drawstrng()
+ */
+void drawstrng(wbinding *wb, int x, int y, char *s, int slen)
+   {
+   STDLOCALS(wb);
+
+   STDFONT;
+   if (stdwin) {
+      SetBkMode(stddc, TRANSPARENT);
+      if (wc->fg != RGB(0, 0, 0)) SetTextColor(stddc, PALCLR(wc->fg));
+      if (wc->bg != RGB(255, 255, 255)) SetBkColor(stddc, PALCLR(wc->bg));
+      TextOut(stddc, x, y - ASCENT(wb), s, slen);
+      }
+   SetBkMode(pixdc, TRANSPARENT);
+   if (wc->fg != RGB(0, 0, 0)) SetTextColor(pixdc, PALCLR(wc->fg));
+   if (wc->bg != RGB(255, 255, 255)) SetBkColor(pixdc, PALCLR(wc->bg));
+   TextOut(pixdc, x, y - ASCENT(wb), s, slen);
+
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+/*
+ * fillarcs
+ */
+void fillarcs(wbp wb, XArc *arcs, int narcs)
+   {
+   register XArc *arc = arcs;
+   int i, diff, bheight;
+   HBRUSH hb, oldbrush, oldbrush2;
+   POINT pts[3];
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(wb);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   hb = CreateBrushIndirect(&(wc->brush));
+   if (stdwin) oldbrush = SelectObject(stddc, hb);
+   oldbrush2 = SelectObject(pixdc, hb);
+   SetTextColor(pixdc, PALCLR(wc->fg));
+   if (stdwin) SetTextColor(stddc, PALCLR(wc->fg));
+   SetBkColor(pixdc, PALCLR(wc->bg));
+   if (stdwin) SetBkColor(stddc, PALCLR(wc->bg));
+   if (stdwin) SetBkMode(stddc, wc->bkmode);
+   SetBkMode(pixdc, wc->bkmode);
+   for (i = 0; i < narcs; i++, arc++) {
+      if (arc->angle2 >= 2 * Pi) {
+         /*
+          * from SDK reference: Ellipse() draws up to but not including
+          * the right and bottom coordinates.  Add +1 to compensate.
+          */
+	 if (stdwin)
+	    Ellipse(stddc, arc->x, arc->y,
+		    arc->x + arc->width + 1, arc->y + arc->height + 1);
+	 Ellipse(pixdc, arc->x, arc->y,
+		 arc->x + arc->width + 1, arc->y + arc->height + 1);
+	 }
+      else {
+	 arc->angle1 = -arc->angle1 - arc->angle2;
+	 pts[0].x = arc->x + (arc->width>>1);
+	 pts[0].y = arc->y + (arc->height>>1);
+	 pts[1].x = arc->x + (arc->width>>1) +
+            (int)(((arc->width + 1)>>1) * cos(arc->angle1));
+	 pts[1].y = arc->y + (arc->height>>1) -
+            (int)(((arc->height )>>1) * sin(arc->angle1));
+	 pts[2].x = arc->x + (arc->width>> 1) +
+            (int)(((arc->width + 1)>>1) * cos(arc->angle1+arc->angle2));
+	 pts[2].y = arc->y + (arc->height>>1) -
+            (int)(((arc->height )>>1) * sin(arc->angle1+arc->angle2));
+	 if (stdwin) {
+	    Pie(stddc, arc->x, arc->y,
+		arc->x + arc->width + 1, arc->y + arc->height + 1,
+		pts[1].x, pts[1].y, pts[2].x, pts[2].y);
+	    }
+	 Pie(pixdc, arc->x, arc->y,
+	     arc->x + arc->width + 1, arc->y + arc->height + 1,
+		pts[1].x, pts[1].y, pts[2].x, pts[2].y);
+	 }
+      }
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   if (stdwin) SelectObject(stddc, oldbrush);
+   SelectObject(pixdc, oldbrush2);
+   DeleteObject(hb);
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+/*
+ * fillrectangles
+ */
+void fillrectangles(wbp wb, XRectangle *recs, int nrecs)
+   {
+   int i, diff, bheight;
+   HBRUSH hb, oldbrush, oldbrush2;
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(wb);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   hb = CreateBrushIndirect(&(wc->brush));
+   if (stdwin) oldbrush = SelectObject(stddc, hb);
+   oldbrush2 = SelectObject(pixdc, hb);
+   SetTextColor(pixdc, PALCLR(wc->fg));
+   if (stdwin) SetTextColor(stddc, PALCLR(wc->fg));
+   SetBkColor(pixdc, PALCLR(wc->bg));
+   if (stdwin) SetBkColor(stddc, PALCLR(wc->bg));
+   if (stdwin) SetBkMode(stddc, wc->bkmode);
+   SetBkMode(pixdc, wc->bkmode);
+   for (i = 0; i < nrecs; i++) {
+      recs[i].right += recs[i].left;
+      recs[i].bottom += recs[i].top;
+      if (stdwin) FillRect(stddc, (recs+i), hb);
+      FillRect(pixdc, (recs+i), hb);
+      }
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   if (stdwin) SelectObject(stddc, oldbrush);
+   SelectObject(pixdc, oldbrush2);
+   DeleteObject(hb);
+   FREE_STDLOCALS(wb);
+   return;
+   }
+
+
+/*
+ * drawrectangles - draw nrecs # of rectangles in array recs to binding w
+ */
+void drawrectangles(wbp w, XRectangle *recs, int nrecs)
+   {
+   register XRectangle *r;
+   LOGBRUSH lb;
+   HBRUSH hb, oldbrush, oldbrush2;
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(w);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   lb.lbStyle = BS_NULL;
+   hb = CreateBrushIndirect(&lb);
+   if (stdwin) oldbrush = SelectObject(stddc, hb);
+   oldbrush2 = SelectObject(pixdc, hb);
+   for (r = recs; r < recs + nrecs; r++) {
+      /*
+       * from SDK reference: Rectangle() draws up to but not including
+       * the right and bottom coordinates.  Add +1 to compensate.
+       */
+      r->right += r->left + 1;
+      r->bottom += r->top + 1;
+      if (stdwin) Rectangle(stddc, r->left, r->top, r->right, r->bottom);
+      Rectangle(pixdc, r->left, r->top, r->right, r->bottom);
+      }
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   if (stdwin) SelectObject(stddc, oldbrush);
+   SelectObject(pixdc, oldbrush2);
+   DeleteObject(hb);
+   FREE_STDLOCALS(w);
+   return;
+   }
+
+/*
+ * fillpolygon
+ */
+void fillpolygon(wbp w, XPoint *pts, int npts)
+   {
+   HBRUSH hb, oldbrush;
+   HPEN hp, oldpen, oldpen2;
+   STDLOCALS(w);
+   if (stdwin) SetBkMode(stddc, wc->bkmode);
+   SetBkMode(pixdc, wc->bkmode);
+   hp = CreatePenIndirect(&(wc->pen));
+   if (stdwin) oldpen = SelectObject(stddc, hp);
+   oldpen2 = SelectObject(pixdc, hp);
+   hb = CreateBrushIndirect(&(wc->brush));
+   if (stdwin) {
+      oldbrush = SelectObject(stddc, hb);
+      Polygon(stddc, pts, npts);
+      SelectObject(stddc, oldbrush);
+      }
+   oldbrush = SelectObject(pixdc, hb);
+   Polygon(pixdc, pts, npts);
+   SelectObject(pixdc, oldbrush);
+   DeleteObject(hb);
+   if (stdwin) SelectObject(stddc, oldpen);
+   SelectObject(pixdc, oldpen2);
+   DeleteObject(hp);
+   FREE_STDLOCALS(w);
+   }
+
+LONG NumWindows = 0;
+
+
+/*
+ * allocate a context.  Can't be called until w has a display and window.
+ */
+wcp alc_context(w)
+wbp w;
+   {
+   int i;
+   wcp wc;
+
+   GRFX_ALLOC(wc, _wcontext);
+
+   wc->bkmode = OPAQUE;        /* at present, only used in line drawing */
+   wc->fg = RGB(0,0,0);
+   wc->bg = RGB(255,255,255);
+   wc->fgname = salloc("black");
+   wc->bgname = salloc("white");
+   wc->pen.lopnStyle = PS_SOLID;
+   wc->pen.lopnWidth.x = wc->pen.lopnWidth.y = 1;
+   wc->pen.lopnColor = PALCLR(wc->fg);
+   wc->bgpen.lopnStyle = PS_SOLID;
+   wc->bgpen.lopnWidth.x = wc->bgpen.lopnWidth.y = 1;
+   wc->bgpen.lopnColor = PALCLR(wc->bg);
+   wc->fillstyle = BS_SOLID;
+   wc->brush.lbStyle = BS_SOLID;
+   wc->brush.lbColor = PALCLR(wc->fg);
+   wc->bgbrush.lbStyle = BS_SOLID;
+   wc->bgbrush.lbColor = PALCLR(wc->bg);
+   wc->gamma = GammaCorrection;
+   wc->drawop = R2_COPYPEN;
+   wc->font = (wfp)alloc(sizeof (struct _wfont));
+   wc->font->name = salloc("fixed");
+   wc->font->font = CreateFont(16,0,0,0,FW_NORMAL,0,0,0,
+	 ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET),
+	 OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,
+	 DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN,
+	 getenv("ICONFONT"));
+
+   wc->font->charwidth = 8; /* looks like a bug */
+   wc->leading = 16;
+
+   GRFX_LINK(wc, wcntxts);
+   return wc;
+   }
+
+/*
+ * allocate a context, cloning attributes from an existing context
+ */
+wcp clone_context(w)
+wbp w;
+   {
+   wcp wc, wc2 = w->context;
+   wsp ws = w->window;
+   wbinding tmp;
+   int i;
+
+   GRFX_ALLOC(wc, _wcontext);
+
+   tmp.window = ws;
+   tmp.context = wc;
+   /*
+    * copy over some stuff
+    */
+   wc->clipx = wc2->clipx;
+   wc->clipy = wc2->clipy;
+   wc->clipw = wc2->clipw;
+   wc->cliph = wc2->cliph;
+   if (wc2->cliprgn)
+      wc->cliprgn = CreateRectRgn(wc->clipx,wc->clipy,
+			wc->clipx+wc->clipw,
+			wc->clipy+wc->cliph);
+   wc->dx = wc2->dx;
+   wc->dy = wc2->dy;
+   wc->bits = wc2->bits;
+   /*
+    * clone needs to make a copy of the pattern
+    *   if (wc2->pattern) {
+    *      wc->pattern = copy+somehow(wc2->pattern);
+    *      if (wc2->patternname)
+    *         wc->patternname = salloc(wc2->patternname);
+    *      }
+    */
+
+   wc->bkmode = wc2->bkmode;
+   wc->fg = wc2->fg;
+   wc->bg = wc2->bg;
+   wc->fgname = salloc(wc2->fgname);
+   wc->bgname = salloc(wc2->bgname);
+   wc->pen = wc2->pen;
+   if (ISXORREVERSEW(wc)) {
+      wc->brush.lbColor = PALCLR((wc->fg ^ wc->bg) & 0x00FFFFFF);
+      }
+   else {
+      wc->brush.lbColor = PALCLR(wc->fg);
+      }
+   wc->bgpen = wc2->bgpen;
+   wc->fillstyle = wc2->fillstyle;
+   wc->brush.lbStyle = wc->fillstyle;
+   wc->bgbrush.lbStyle = wc->fillstyle;
+   wc->bgbrush.lbColor = PALCLR(wc->bg);
+   wc->gamma = wc2->gamma;
+   wc->drawop = wc2->drawop;
+   wc->font = (wfp)alloc(sizeof (struct _wfont));
+   wc->font->name = salloc("fixed");
+   wc->font->font = CreateFont(13,0,0,0,FW_NORMAL,0,0,0,
+	 ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET),
+	 OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,
+	 DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN,
+	 getenv("ICONFONT"));
+   wc->leading = wc2->leading;
+   setfont(&tmp, &(wc2->font->name));
+
+   GRFX_LINK(wc, wcntxts);
+   return wc;
+   }
+
+/*
+ * allocate a window state structure
+ */
+wsp alc_winstate()
+   {
+   int i;
+   wsp ws;
+
+   GRFX_ALLOC(ws, _wstate);
+   ws->bits = 1024;                             /* echo ON; others OFF */
+   ws->filep = nulldesc;
+   ws->listp = nulldesc;
+   ws->cursorname = salloc("arrow");
+   ws->curcursor = LoadCursor(NULL, IDC_ARROW);
+   GRFX_LINK(ws, wstates);
+   return ws;
+   }
+
+/*
+ * free a window state
+ */
+int free_window(ws)
+wsp ws;
+   {
+   int i;
+   ws->refcount--;
+   if(ws->refcount == 0) {
+      if (ws->win) /* && IsWindowVisible(ws->win))*/
+	 DestroyWindow(ws->win);
+/*      ws->win = 0;*/
+      if (ws->iconwin && ws->iconwin != ws->win) {
+         if (IsWindowVisible(ws->iconwin))
+	    DestroyWindow(ws->iconwin);
+         else DestroyWindow(ws->iconwin);
+	 }
+/*      ws->iconwin = 0;*/
+/*      while (ws->win)
+	 if (pollevent() == -1) return -1;
+*/
+      if (ws->windowlabel) free(ws->windowlabel);
+      if (ws->iconlabel) free(ws->iconlabel);
+      if (ws->pix)
+	 DeleteObject(ws->pix);
+      ws->pix = 0;
+      if (ws->iconpix)
+	 DeleteObject(ws->iconpix);
+      ws->iconpix = 0;
+      if (ws->initialPix)
+	 DeleteObject(ws->initialPix);
+      ws->initialPix = 0;
+      /* need to enumerate and specifically free each string */
+      if (ws->menuMap) {
+	 for(i=0;i<ws->nmMapElems;i++) free(ws->menuMap[i]);
+         free(ws->menuMap);
+         ws->menuMap = 0;
+	 }
+      free(ws->cursorname);
+      if (ws->child) {
+         for(i=0;i<ws->nChildren;i++) {
+            free(ws->child[i].id);
+            if (ws->child[i].font) DeleteObject(ws->child[i].font);
+	    }
+         free(ws->child);
+	 }
+      ws->child = 0;
+      GRFX_UNLINK(ws, wstates);
+      }
+   return 0;
+   }
+
+/*
+ * free a window context
+ */
+void free_context(wc)
+wcp wc;
+   {
+   wc->refcount--;
+   if(wc->refcount == 0) {
+      if (wc->cliprgn)
+	 DeleteObject(wc->cliprgn);
+      wc->cliprgn = 0;
+      if (wc->pattern)
+	 DeleteObject(wc->pattern);
+      wc->pattern = 0;
+      if (wc->patternname)
+	 free(wc->patternname);
+      wc->patternname = 0;
+      if (wc->fgname) free(wc->fgname);
+      wc->fgname = 0;
+      if (wc->bgname) free(wc->bgname);
+      wc->bgname = 0;
+      if (wc->font) {
+	 if (wc->font->font)
+	    DeleteObject(wc->font->font);
+	 wc->font->font = 0;
+	 if (wc->font->name)
+	    free(wc->font->name);
+	 wc->font->name = 0;
+	 free(wc->font);
+	 }
+      wc->font = 0;
+      GRFX_UNLINK(wc, wcntxts);
+      }
+   }
+
+int walert(wbp w, int volume)
+   {
+   MessageBeep(0);
+   }
+
+int patbits[] = {
+  0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+  0xFE,0xFF,0xEF,0xFF,0xFE,0xFF,0xEF,0xFF,
+  0x77,0xDD,0x77,0xDD,0x77,0xDD,0x77,0xDD,
+  0x55,0xAA,0x55,0xAA,0x55,0xAA,0x55,0xAA,
+  0x11,0x44,0x11,0x44,0x11,0x44,0x11,0x44,
+  0x01,0x00,0x10,0x00,0x01,0x00,0x10,0x00,
+  0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
+
+  0x10,0x10,0x10,0x10,0x10,0x10,0x10,0x10,
+  0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01,
+  0x00,0x00,0x00,0xFF,0x00,0x00,0x00,0x00,
+  0x10,0x10,0x10,0xFF,0x10,0x10,0x10,0x10,
+  0x82,0x44,0x28,0x10,0x28,0x44,0x82,0x01,
+
+  0x0F,0x0F,0x0F,0x0F,0xF0,0xF0,0xF0,0xF0,
+  0x1B,0x18,0x81,0xB1,0x36,0x06,0x60,0x63,
+  0x02,0x02,0x05,0xF8,0x20,0x20,0x50,0x8F,
+  0x03,0x84,0x48,0x30,0x03,0x84,0x48,0x30,
+};
+
+/*
+ * SetPattern
+ */
+int SetPattern(w, name, len)
+wbp w;
+char *name;
+int len;
+   {
+   int width, nbits;
+   int i, j;
+   int symbol;
+   C_integer v, bits[MAXXOBJS];
+   HBITMAP p;
+   char data[MAXXOBJS];
+   char *buf = data;
+   wcp wc = w->context;
+
+   if (wc->patternname != NULL)
+      free(wc->patternname);
+   wc->patternname = malloc(len+1);
+   strncpy(wc->patternname, name, len);
+   wc->patternname[len] = '\0';
+
+   /*
+    * If the pattern starts with a number it is a width , bits encoding
+    */
+   if ((len > 0) && isdigit(name[0])) {
+      nbits = MAXXOBJS;
+      switch (parsepattern(name, len, &width, &nbits, bits)) {
+      case Failed:
+	 return Failed;
+      case Error:
+	 ReturnErrNum(145, Error);
+	 }
+      if (w->window->iconwin == NULL) return Succeeded;
+      return SetPatternBits(w, width, bits, nbits);
+      }
+
+   /*
+    * Otherwise, it is a named pattern.  Find the symbol id.
+    */
+   if ((symbol = si_s2i(siPatternSyms, wc->patternname)) >= 0) {
+      if (w->window->iconwin == NULL) return Succeeded;
+      for(i = 0; i < 8; i++) {
+	 v = reversebits(~(patbits[symbol * 8 + i]));
+	 *buf++ = v;
+	 }
+      p = CreateBitmapFromData(data);
+      if (wc->pattern)
+	 DeleteObject(wc->pattern);
+      wc->pattern = p;
+      if (wc->fillstyle == BS_PATTERN) {
+	 wc->brush.lbStyle = BS_PATTERN;
+	 wc->brush.lbColor = PALCLR(wc->fg);
+	 wc->brush.lbHatch = (LONG)p;
+	 }
+      return Succeeded;
+      }
+   ReturnErrNum(145, Error);
+   }
+
+/*
+ * Create an 8x8 bitmap from some data
+ */
+HBITMAP CreateBitmapFromData(char *data)
+{
+   WORD *wBits = alloc(8 * sizeof(WORD));
+   HBITMAP rv;
+   int i;
+   static BITMAP bitmap = { 0, 8, 8, 2, 1, 1};
+   for (i = 0; i < 8; i++)
+      wBits[i] = data[i];
+   bitmap.bmBits = (LPSTR) wBits;
+   rv = CreateBitmapIndirect(&bitmap);
+   free(wBits);
+   return rv;
+}
+
+
+int SetPatternBits(w, width, bits, nbits)
+wbp w;
+int width;
+C_integer *bits;
+int nbits;
+   {
+   C_integer v;
+   int i, j, k;
+   HBITMAP p;
+   char data[MAXXOBJS];
+   char *buf = data;
+   wcp wc = w->context;
+
+   if (width != nbits)
+      return Failed;
+
+   if (width == 8) {
+      for(i = 0; i < nbits; i++) {
+         v = bits[i];
+	 *buf++ = reversebits(~v);
+	 }
+      }
+   else if (width == 4) {
+      for(k=0; k < 2; k++) /* do twice to get 8 rows */
+      for(i = 0; i < nbits; i++) {
+         v = widenbits(bits[i]);
+	 *buf++ = reversebits(~v);
+	 }
+      }
+   else return Failed;
+
+   p = CreateBitmapFromData(data);
+   if (wc->pattern)
+      DeleteObject(wc->pattern);
+   wc->pattern = p;
+   if (wc->fillstyle == BS_PATTERN) {
+      wc->brush.lbStyle = BS_PATTERN;
+      wc->brush.lbColor = PALCLR(wc->fg);
+      wc->brush.lbHatch = (LONG)p;
+      }
+   return Succeeded;
+   }
+
+int widenbits(int c)
+{
+   int rv = c;
+   if (c & 1) rv |= 16;
+   if (c & 2) rv |= 32;
+   if (c & 4) rv |= 64;
+   if (c & 8) rv |= 128;
+   return rv;
+}
+
+int reversebits(int c)
+{
+  int rv = 0;
+  if (c & 1) rv |= 128;
+  if (c & 2) rv |= 64;
+  if (c & 4) rv |= 32;
+  if (c & 8) rv |= 16;
+  if (c & 16) rv |= 8;
+  if (c & 32) rv |= 4;
+  if (c & 64) rv |= 2;
+  if (c & 128) rv |= 1;
+  return rv;
+}
+
+int pixmap_init(w)
+wbp w;
+   {
+   wsp ws = w->window;
+   resizePixmap(w, ws->width, ws->height);
+   return Succeeded;
+   }
+
+
+int do_config(w, status)
+wbp w;
+int status;
+   {
+   wsp ws = w->window;
+   int wid = ws->width, ht = ws->height;
+   int posx = ws->posx, posy = ws->posy;
+   if (! resizePixmap(w, wid, ht))
+      return Failed;
+   if (ws->win) {
+      pollevent();
+      if (status == 3) {
+	 SetWindowPos(ws->win, ws->win,
+		      posx,
+		      posy,
+		      wid, ht, SWP_NOZORDER);
+	 }
+      else if (status == 2) {
+	 SetWindowPos(ws->win, ws->win, 0, 0,
+		      wid, ht, SWP_NOMOVE|SWP_NOZORDER);
+         }
+      else if (status == 1)
+	 SetWindowPos(ws->win, ws->win,
+		      posx,
+		      posy,
+		      0, 0, SWP_NOSIZE|SWP_NOZORDER);
+      }
+   else if (ws->iconwin) {
+      if (status == 3) {
+	 SetWindowPos(ws->iconwin, ws->iconwin,
+		      posx,
+		      posy,
+		      wid, ht, SWP_NOZORDER);
+	 }
+      else if (status == 2) {
+	 SetWindowPos(ws->iconwin, ws->iconwin, 0, 0,
+		      wid, ht, SWP_NOMOVE|SWP_NOZORDER);
+         }
+      else if (status == 1)
+	 SetWindowPos(ws->iconwin, ws->iconwin,
+		      posx,
+		      posy,
+		      0, 0, SWP_NOSIZE|SWP_NOZORDER);
+      }
+   return Succeeded;
+   }
+
+DWORD playMIDIfile(HWND hWndNotify, LPSTR s)
+{
+   UINT wDeviceID;
+   DWORD dwReturn;
+   MCI_OPEN_PARMS mciOpenParms;
+   MCI_PLAY_PARMS mciPlayParms;
+   MCI_STATUS_PARMS mciStatusParms;
+   MCI_SEQ_SET_PARMS mciSeqSetParms;
+
+   mciOpenParms.lpstrDeviceType = "sequencer";
+   mciOpenParms.lpstrElementName = s;
+   if (dwReturn = mciSendCommand((UINT)NULL, MCI_OPEN,
+				 MCI_OPEN_TYPE | MCI_OPEN_ELEMENT,
+				 (DWORD)(LPVOID) &mciOpenParms)) {
+      return dwReturn;
+      }
+   wDeviceID = mciOpenParms.wDeviceID;
+
+   /* attempt to select the MIDI mapper */
+   mciSeqSetParms.dwPort = MIDI_MAPPER;
+   if (dwReturn = mciSendCommand(wDeviceID, MCI_SET, MCI_SEQ_SET_PORT,
+				 (DWORD)(LPVOID) &mciSeqSetParms)) {
+      /* could not select the MIDI mapper; play anyway */
+      }
+
+   mciPlayParms.dwCallback = (DWORD) hWndNotify;
+   if (dwReturn = mciSendCommand(wDeviceID, MCI_PLAY, MCI_NOTIFY,
+         (DWORD)(LPVOID) &mciPlayParms)) {
+      mciSendCommand(wDeviceID, MCI_CLOSE, 0, (DWORD)NULL);
+      return dwReturn;
+      }
+
+   return 0L;
+}
+
+
+int playmedia(wbp w, char *s)
+{
+   if (strstr(s, ".wav") || strstr(s, ".WAV")) {
+      sndPlaySound((LPSTR) s, SND_ASYNC);
+      return Succeeded;
+      }
+   else if (strstr(s, ".mid") || strstr(s, ".MID") ||
+            strstr(s, ".rmi") || strstr(s, ".RMI")) {
+      if (playMIDIfile(w->window->win, (LPSTR) s) == 0)
+         return Succeeded;
+      }
+   /*
+    * Interpret as an MCI command string
+    */
+   else {
+      if (mciSendString(s, NULL, 0, 0L)) return Failed;
+      return Succeeded;
+      }
+}
+
+/*
+ * UpdateCursorPos
+ */
+void UpdateCursorPos(wsp ws, wcp wc)
+{
+   if (ISCURSORONW(ws)) {
+      if (ws->hasCaret) {
+         }
+      CreateCaret(ws->iconwin, NULL, FWIDTHC(wc), FHEIGHTC(wc));
+      SetCaretBlinkTime(500);
+      SetCaretPos(ws->x, ws->y - ASCENTC(wc));
+      ShowCaret(ws->iconwin);
+      ws->hasCaret = 1;
+      }
+}
+
+int resizePixmap(wbp w, int width, int height)
+   {
+   HDC hdc, hdc2, hdc3;
+   HBITMAP newpix, oldpix, oldpix2;
+   HBRUSH hb;
+   LOGBRUSH lb;
+   XRectangle rect;
+   wsp ws = w->window;
+   int x = ws->pixwidth, y = ws->pixheight;
+   if (ISEXPOSED(w)) {
+      if (ws->pixwidth >= width && ws->pixheight >= height) {
+         return 1;
+         }
+      ws->pixheight = max(ws->pixheight, height);
+      ws->pixwidth = max(ws->pixwidth, width);
+      }
+   else {
+      ws->pixwidth = width;
+      ws->pixheight = height;
+      }
+   hdc = GetDC(ws->iconwin);
+   newpix = CreateCompatibleBitmap (hdc, ws->pixwidth, ws->pixheight);
+   if (ws->pix) {
+      hdc2 = CreateCompatibleDC(hdc);
+      oldpix = SelectObject(hdc2, ws->pix);
+      }
+   hdc3 = CreateCompatibleDC(hdc);
+   oldpix2 = SelectObject(hdc3, newpix);
+   if (palette) {
+      SelectPalette(hdc, palette, FALSE);
+      if (ws->pix) SelectPalette(hdc2, palette, FALSE);
+      SelectPalette(hdc3, palette, FALSE);
+      RealizePalette(hdc);
+      if (ws->pix) RealizePalette(hdc2);
+      RealizePalette(hdc3);
+      }
+   lb.lbStyle = BS_SOLID;
+   lb.lbColor = PALCLR(w->context->bg);
+   hb = CreateBrushIndirect(&lb);
+   /*
+    * initialize the new pixmap, including areas not in the old pixmap.
+    */
+   rect.left = 0; rect.right = ws->pixwidth;
+   rect.top = 0; rect.bottom = ws->pixheight;
+   FillRect(hdc3, &rect, hb);
+   if (ws->win)
+      FillRect(hdc, &rect, hb);
+
+   if (ws->pix) BitBlt(hdc3, 0, 0, x - 2, y - 1, hdc2, 0, 0, SRCCOPY);
+   if (ws->win)
+      BitBlt(hdc, 0, 0, ws->pixwidth, ws->pixheight, hdc3, 0, 0, SRCCOPY);
+   SelectObject(hdc3, oldpix2);
+   DeleteDC(hdc3);
+   if (ws->pix) {
+      SelectObject(hdc2, oldpix);
+      DeleteDC(hdc2);
+      }
+   ReleaseDC(ws->iconwin, hdc);
+   if (ws->pix) DeleteObject(ws->pix);
+   DeleteObject(hb);
+   ws->pix = newpix;
+   return 1;
+   }
+
+/*
+ * CreateWinDC - create a device context for drawing on the window
+ *  In addition, select objects specified by flags.
+ */
+HDC CreateWinDC(wbp w)
+   {
+   wsp ws = w->window;
+   wcp wc = w->context;
+   HDC hdc = GetDC(ws->iconwin);
+   if (numColors > 0) {
+      SelectPalette(hdc, palette, FALSE);
+/*      UnrealizeObject(palette); */
+      RealizePalette(hdc);
+      if (numRealized < numColors) {
+         numRealized = numColors;
+         if (RealizePalette(hdc) == 0) /* noop */;
+         }
+      }
+   SetROP2(hdc, wc->drawop);
+   if (wc->clipw >= 0){
+      SelectClipRgn(hdc, wc->cliprgn);
+      }
+   return hdc;
+   }
+
+HDC CreatePixDC(wbp w, HDC hdc)
+   {
+   wsp ws = w->window;
+   wcp wc = w->context;
+   HBITMAP oldpix;
+   HDC hdc2 = CreateCompatibleDC(hdc);
+   if (numColors > 0) {
+      SelectPalette(hdc2, palette, FALSE);
+      RealizePalette(hdc2);
+      }
+/*   ws->initialPix = */ ws->theOldPix = SelectObject(hdc2, ws->pix);
+   SetROP2(hdc2, wc->drawop);
+   if (wc->clipw >= 0){
+      SelectClipRgn(hdc2, wc->cliprgn);
+      }
+   return hdc2;
+   }
+
+int dc_maxcharwidth(HDC dc)
+{
+  int i, m = -1, x;
+  char s[2];
+  s[1] = '\0';
+  for (i=0; i<256; i++) {
+    s[0] = i;
+    x = dc_textwidth(dc, s, 1);
+    if (x > m) m = x;
+  }
+  return m;
+}
+
+/*
+ * compute a text width for a current device context (typically pixdc)
+ */
+int dc_textwidth(HDC dc, char *s, int n)
+{
+   SIZE sz;
+   /*
+    * GetTextExtentPoint32(dc, s, n, &sz) gives incorrect behavior
+    *  under Win32s
+    */
+   GetTextExtentPoint(dc, s, n, &sz);
+   return (int)sz.cx;
+}
+
+int sysScrollWidth()
+{
+   return GetSystemMetrics(SM_CXVSCROLL);
+}
+
+int sysFontHeight(wbp w)
+{
+   TEXTMETRIC tm;
+   int rv;
+   wsp ws = w->window;
+   HDC dc = GetDC(ws->iconwin);
+   HFONT oldfont = SelectObject(dc, GetStockObject(SYSTEM_FIXED_FONT));
+   GetTextMetrics(dc, &tm);
+   SelectObject(dc, oldfont);
+   ReleaseDC(ws->iconwin, dc);
+   return tm.tmHeight + tm.tmExternalLeading;
+}
+
+int sysTextWidth(wbp w, char *s, int n)
+{
+   int rv;
+   wsp ws = w->window;
+   HDC dc = GetDC(ws->iconwin);
+   HFONT oldfont;
+   oldfont = SelectObject(dc, GetStockObject(SYSTEM_FIXED_FONT));
+   rv = dc_textwidth(dc, s, n);
+   SelectObject(dc, oldfont);
+   ReleaseDC(ws->iconwin, dc);
+   return rv;
+}
+
+int textWidth(wbp w, char *s, int n)
+   {
+   int rv;
+   wsp ws = w->window;
+   HDC stddc = GetDC(ws->iconwin);
+   HFONT oldfont = SelectObject(stddc, w->context->font->font);
+   rv = dc_textwidth(stddc, s, n);
+   SelectObject(stddc, oldfont);
+   ReleaseDC(ws->iconwin, stddc);
+   return rv;
+   }
+
+void warpPointer(w, x, y)
+wbp w;
+int x, y;
+   {
+   wsp ws = w->window;
+   SetCursorPos(ws->posx + x, ws->posy + y);
+   }
+
+/*
+ * free all Windows resources allocated by this instantiation of iconx
+ */
+void wfreersc()
+{
+   wbp w;
+   extern struct palentry *palsetup_palette;
+   while (wbndngs != NULL) {
+      w = wbndngs;
+      wbndngs = wbndngs->next;
+      free(w);
+      }
+   while (wstates != NULL) {
+      wstates->refcount = 1;
+      free_window(wstates);
+      }
+   while (wcntxts != NULL) {
+      wcntxts->refcount = 1;
+      free_context(wcntxts);
+      }
+   if (palette) {
+      DeleteObject(palette);
+      palette = 0;
+      }
+   if (palsetup_palette) {
+      free(palsetup_palette);
+      palsetup_palette = 0;
+      }
+   if (scp) {
+      free(scp);
+      scp = 0;
+      }
+   if (wlhead)
+      wlfree();
+   mciSendCommand(MCI_ALL_DEVICE_ID, MCI_CLOSE, 0, (DWORD)NULL);
+}
+
+
+/*
+ * Native Windows UI facilities
+ */
+void makebutton(wsp ws, childcontrol *cc, char *s)
+{
+   cc->type = CHILD_BUTTON;
+   cc->font = 0;
+   cc->id = salloc(s);
+   cc->win = CreateWindow("button", cc->id,
+	         WS_CHILD | WS_VISIBLE | BS_PUSHBUTTON,
+		 0, 0, 0, 0, ws->iconwin, (HMENU)ws->nChildren, mswinInstance,
+		 NULL);
+}
+
+void makescrollbar(wsp ws, childcontrol *cc, char *s, int i1, int i2)
+{
+   cc->type = CHILD_SCROLLBAR;
+   cc->id = salloc(s);
+   cc->font = 0;
+   cc->win = CreateWindow("scrollbar", cc->id,
+            WS_CHILD | WS_VISIBLE | SBS_VERT, 0, 0, 0, 0,
+	    ws->iconwin, (HMENU)ws->nChildren, mswinInstance, NULL);
+   SetScrollRange(cc->win, SB_CTL, i1, i2, FALSE);
+}
+
+int nativemenubar(wbp w, int total, int argc, dptr argv, int warg, dptr d)
+{
+   wsp ws;
+   tended struct b_list *hp;
+   HMENU tempMenu, tempMenu2 = NULL;
+   tended char *s, *s2;
+   int r, i;
+   ws = w->window;
+
+   if (ws->nmMapElems)
+      tempMenu2 = ws->menuBar;
+
+   ws->menuBar = CreateMenu();
+   ws->nmMapElems = total;
+   total = 0;
+   while (warg < argc){
+      /*
+       * each argument must be a list of strings
+       */
+      hp = (struct b_list *)BlkLoc(argv[warg]);
+      r = hp->size;
+      /*
+       * Construct a Windows menu corresponding to the Icon list
+       */
+      tempMenu = CreateMenu();
+      for(i=0; i < r; i++) {
+         c_get(hp, d);
+         if (!is:string(*d)) return Error;
+         if (!cnv:C_string(*d, s)) return Error;
+         s = strdup(s);
+         if (i == 0) s2=s;
+         else
+            AppendMenu(tempMenu, MF_STRING, total, s);
+         ws->menuMap[total++] = s;
+         c_put(&(argv[warg]), d);
+         }
+      AppendMenu(ws->menuBar, MF_POPUP, (unsigned int)tempMenu, s2);
+      warg++;
+      }
+   /*
+    * Insert the menu into the window
+    */
+   if (ws->win) SetMenu(ws->win, ws->menuBar);
+   if (tempMenu2) {
+      int i, n = GetMenuItemCount(tempMenu2);
+      for (i=0; i < n; i++) {
+         DestroyMenu(GetSubMenu(tempMenu2, i));
+         }
+      DestroyMenu(tempMenu2);
+      }
+   return Succeeded;
+}
+
+void makeeditregion(wbp w, childcontrol *cc, char *s)
+{
+   wsp ws = w->window;
+   cc->type = CHILD_EDIT;
+   cc->id = salloc(s);
+   cc->win = CreateWindow("edit", NULL,
+		WS_CHILD | WS_VISIBLE | WS_HSCROLL | WS_VSCROLL |
+		WS_BORDER | ES_LEFT | ES_MULTILINE |
+		ES_AUTOHSCROLL | ES_AUTOVSCROLL,
+		0, 0, 0, 0, ws->iconwin,
+		(HMENU) ws->nChildren, mswinInstance, NULL);
+   setchildfont(cc, w->context->font->name);
+}
+
+void cleareditregion(childcontrol *cc)
+{
+   SendMessage(cc->win, WM_CLEAR, 0, 0);
+}
+
+void copyeditregion(childcontrol *cc)
+{
+   SendMessage(cc->win, WM_COPY, 0, 0);
+}
+
+void cuteditregion(childcontrol *cc)
+{
+   SendMessage(cc->win, WM_CUT, 0, 0);
+}
+
+void pasteeditregion(childcontrol *cc)
+{
+   SendMessage(cc->win, WM_PASTE, 0, 0);
+}
+
+int undoeditregion(childcontrol *cc)
+{
+   if (!SendMessage(cc->win, WM_UNDO, 0, 0)) return Failed;
+   return Succeeded;
+}
+
+int modifiededitregion(childcontrol *cc)
+{
+   if (!SendMessage(cc->win, EM_GETMODIFY, 0, 0)) return Failed;
+   return Succeeded;
+}
+
+int setmodifiededitregion(childcontrol *cc, int i)
+{
+   SendMessage(cc->win, EM_SETMODIFY, i, 0);
+   return Succeeded;
+}
+
+void geteditregion(childcontrol *cc, dptr d)
+{
+   int y = GetWindowTextLength(cc->win);
+   char *s2 = alcstr(NULL, y + 1);
+   GetWindowText(cc->win, s2, y+1);
+   StrLoc(*d) = s2;
+   StrLen(*d) = y;
+}
+
+void seteditregion(childcontrol *cc, char *s2)
+{
+   SetWindowText(cc->win, s2);
+}
+
+
+void movechild(childcontrol *cc,
+	       C_integer x, C_integer y, C_integer width, C_integer height)
+{
+   MoveWindow(cc->win, x, y, width, height, TRUE);
+}
+
+int setchildfont(childcontrol *cc, char *fontname)
+{
+   HFONT hf;
+   RECT rect;
+   if (hf = mkfont(fontname)) {
+      SendMessage(cc->win, WM_SETFONT, (WPARAM)hf, 0);
+      if (cc->font) DeleteObject(cc->font);
+      cc->font = hf;
+      GetClientRect(cc->win, &rect);
+      InvalidateRect(cc->win, &rect, TRUE);
+      return Succeeded;
+      }
+   return Failed;
+}
+
+void setfocusonchild(wsp ws, childcontrol *cc, int width, int height)
+{
+   if (width || height) {
+      SetFocus(cc->win);
+      ws->focusChild = cc->win;
+      }
+   else ws->focusChild = 0;
+}
+
+void setchildselection(wsp ws, childcontrol *cc, int x, int y)
+{
+   int iLine = SendMessage(cc->win, EM_LINEFROMCHAR, x-1,0);
+   int topLine = SendMessage(cc->win, EM_GETFIRSTVISIBLELINE, 0, 0);
+   if (topLine != iLine) {
+      SendMessage(cc->win, EM_LINESCROLL, 0, iLine-topLine);
+      }
+   SendMessage(cc->win, EM_SETSEL, x - 1, y - 1);
+   SetFocus(cc->win);
+   ws->focusChild = cc->win;
+}
+
+CHOOSEFONT cf;
+LOGFONT lf;
+
+int nativefontdialog(wbp w, char *buf, int flags, int fheight)
+{
+   strcpy(lf.lfFaceName, buf);
+   lf.lfHeight = fheight;
+   lf.lfWidth = 0;
+   lf.lfEscapement = 0;
+   if (!strcmp(lf.lfFaceName, "mono") || !strcmp(lf.lfFaceName, "fixed")){
+      strcpy(lf.lfFaceName, "Lucida Sans Typewriter");
+      flags |= FONTFLAG_MONO + FONTFLAG_SANS;
+      }
+   else if (!strcmp(lf.lfFaceName, "typewriter")) {
+      strcpy(lf.lfFaceName, "courier");
+      flags |= FONTFLAG_MONO + FONTFLAG_SERIF;
+      }
+   else if (!strcmp(lf.lfFaceName, "sans")) {
+      strcpy(lf.lfFaceName, "swiss");
+      flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS;
+      }
+   else if (!strcmp(lf.lfFaceName, "serif")) {
+      strcpy(lf.lfFaceName, "roman");
+      flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF;
+      }
+
+   if (flags & FONTFLAG_BOLD) lf.lfWeight = FW_BOLD;
+   else
+      lf.lfWeight = FW_DONTCARE;
+   if (flags & FONTFLAG_ITALIC) lf.lfItalic = 1;
+   lf.lfUnderline = lf.lfStrikeOut = 0;
+   lf.lfCharSet =
+	 ((MAXBYTESPERCHAR==1)?ANSI_CHARSET:DEFAULT_CHARSET);
+   lf.lfOutPrecision = OUT_DEFAULT_PRECIS;
+   lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
+   lf.lfQuality = DEFAULT_QUALITY;
+   if (FONTFLAG_PROPORTIONAL)
+      lf.lfPitchAndFamily = VARIABLE_PITCH;
+   else if (FONTFLAG_MONO)
+      lf.lfPitchAndFamily = FIXED_PITCH;
+   else
+      lf.lfPitchAndFamily = DEFAULT_PITCH;
+   if (!strcmp(lf.lfFaceName, "swiss")) lf.lfPitchAndFamily |= FF_SWISS;
+   else if (!strcmp(lf.lfFaceName, "roman"))
+      lf.lfPitchAndFamily |= FF_ROMAN;
+   else
+      lf.lfPitchAndFamily |= FF_DONTCARE;
+
+   memset(&cf, 0, sizeof(CHOOSEFONT));
+   cf.lStructSize = sizeof(CHOOSEFONT);
+   cf.hwndOwner   = w->window->iconwin;
+   cf.lpLogFont = &lf;
+   cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_INITTOLOGFONTSTRUCT;
+   cf.rgbColors = RGB(0,0,0);
+   cf.nFontType = SCREEN_FONTTYPE;
+   if (ChooseFont(&cf) == 0) return Failed;
+   sprintf(buf, "%s,%d%s%s", lf.lfFaceName,
+           ((lf.lfHeight > 0) ? lf.lfHeight : -lf.lfHeight),
+           (lf.lfItalic ? ",italic" : ""),
+	   ((lf.lfWeight > 500) ? ",bold" : ""));
+   return Succeeded;
+}
+
+/*
+ * common dialog functions
+ */
+COLORREF aclrCust[16];
+CHOOSECOLOR cc;
+
+char *nativecolordialog(wbp w, long r, long g, long b, char *buf)
+{
+   aclrCust[0] = RGB(255,255,255);
+   aclrCust[1] = RGB(239,239,239);
+   aclrCust[2] = RGB(223,223,223);
+   aclrCust[3] = RGB(207,207,207);
+   aclrCust[4] = RGB(191,191,191);
+   aclrCust[5] = RGB(175,175,175);
+   aclrCust[6] = RGB(159,159,159);
+   aclrCust[7] = RGB(143,143,143);
+   aclrCust[8] = RGB(127,127,127);
+   aclrCust[9] = RGB(111,111,111);
+   aclrCust[10] = RGB(95,95,95);
+   aclrCust[11] = RGB(79,79,79);
+   aclrCust[12] = RGB(63,63,63);
+   aclrCust[13] = RGB(47,47,47);
+   aclrCust[14] = RGB(31,31,31);
+   aclrCust[15] = RGB(15,15,15);
+   memset(&cc, 0, sizeof(CHOOSECOLOR));
+   cc.lStructSize = sizeof(CHOOSECOLOR);
+   cc.hwndOwner   = w->window->iconwin;
+   cc.lpCustColors = aclrCust;
+   cc.rgbResult = mscolor(w, r, g, b);
+   cc.Flags = CC_FULLOPEN | CC_RGBINIT;
+   if (ChooseColor(&cc) == 0) {
+      return NULL;
+      }
+   sprintf(buf, "%d,%d,%d", (RED(cc.rgbResult)<<8) | 0xFF,
+      (GREEN(cc.rgbResult) << 8) | 0xFF,
+      (BLUE(cc.rgbResult) << 8) | 0xFF);
+   return buf;
+}
+
+
+
+
+char *nativeselectdialog(wbp w, struct b_list *L, char *s)
+{
+   int i, j, okflag=0, yesnoflag=0, cancelflag=0, retryflag=0, otherflag=0;
+   tended struct b_list *hp = L;
+   tended char *s1 = NULL;
+   tended struct descrip d, d2;
+   char s3[8];
+   wsp ws = w->window;
+   int lsize;
+
+   if (hp == NULL) {
+      okflag = 1;
+      }
+   else {
+      BlkLoc(d2) = (union block *)hp;
+      d2.dword = D_List;
+      lsize  = hp->size;
+
+      for(i=0; i < lsize; i++) {
+         c_get(hp, &d);
+         if (!cnv:C_string(d, s1)) return NULL;
+         for(j=0; j<8; j++) {
+            s3[j] = tolower(s1[j]);
+            if (s3[j] == '\0') break;
+            }
+         if (!strcmp(s3, "ok")) okflag = 1;
+         else if (!strcmp(s3, "okay")) okflag = 1;
+         else if (!strcmp(s3, "no")) yesnoflag = MB_YESNO;
+         else if (!strcmp(s3, "yes")) yesnoflag = MB_YESNO;
+         else if (!strcmp(s3, "cancel")) cancelflag++;
+         else if (!strcmp(s3, "retry")) retryflag = MB_RETRYCANCEL;
+         else { otherflag++; return NULL; }
+         c_put(&d2, &d);
+         }
+      }
+   /*
+    * validate flags
+    */
+   if (okflag && yesnoflag) return NULL;
+   if (okflag && retryflag) return NULL;
+   if (yesnoflag && retryflag) return NULL;
+   if (retryflag && !cancelflag) return NULL;
+
+   if (cancelflag) {
+      if (okflag) {
+         okflag = MB_OKCANCEL;
+         }
+      else if (yesnoflag) yesnoflag = MB_YESNOCANCEL;
+      }
+    else if (okflag) okflag = MB_OK;
+
+   j = MessageBox((ws->focusChild ? ws->focusChild :
+		  (ws->win ? ws->win : ws->iconwin)),
+           s, " ",
+          okflag | yesnoflag | retryflag
+          | (strchr(s, '!') ? MB_ICONEXCLAMATION :
+	     (strchr(s, '?') ? MB_ICONQUESTION : MB_ICONASTERISK)));
+
+   switch (j) {
+   case IDOK: return "Okay";
+   case IDCANCEL: return "Cancel";
+   case IDYES: return "Yes";
+   case IDNO: return "No";
+   case IDRETRY: return "Retry";
+   default: return NULL;
+      }
+}
+
+OPENFILENAME ofn;
+
+char *nativeopendialog(wbp w, char *s1, char *s2, char *s3, int i, int j)
+{
+   char buf[128], buf2[64];
+
+   memset(&ofn, 0, sizeof(OPENFILENAME));
+   ofn.lStructSize = sizeof(OPENFILENAME);
+   ofn.hwndOwner   = w->window->iconwin;
+   ofn.lpstrFilter = s3;
+   ofn.nFilterIndex = j;
+   strcpy(buf, s2);
+   ofn.lpstrFile = buf;
+   ofn.nMaxFile = sizeof(buf);
+   ofn.lpstrTitle = s1;
+   ofn.lpstrFileTitle = buf2;
+   ofn.nMaxFileTitle = sizeof(buf2);
+   ofn.lpstrInitialDir = NULL;
+   ofn.Flags = OFN_SHOWHELP | OFN_PATHMUSTEXIST;
+   if (GetOpenFileName(&ofn) == 0) return NULL;
+   return ofn.lpstrFile;
+}
+
+
+char *nativesavedialog(wbp w, char *s1, char *s2, char *s3, int i, int j)
+{
+   char buf[128], buf2[64];
+   /*
+    * Use the standard dialog to obtain a filename.
+    */
+   memset(&ofn, 0, sizeof(OPENFILENAME));
+   ofn.lStructSize = sizeof(OPENFILENAME);
+   ofn.hwndOwner   = w->window->iconwin;
+   ofn.lpstrFilter = s3;
+   ofn.nFilterIndex = j;
+   strcpy(buf, s2);
+   ofn.lpstrFile = buf;
+   ofn.nMaxFile = sizeof(buf);
+   ofn.lpstrTitle = s1;
+   ofn.lpstrFileTitle = buf2;
+   ofn.nMaxFileTitle = sizeof(buf2);
+   ofn.lpstrInitialDir = NULL;
+   ofn.Flags = OFN_SHOWHELP | OFN_PATHMUSTEXIST;
+   if (GetSaveFileName(&ofn) == 0) return NULL;
+   return ofn.lpstrFile;
+}
+
+/*
+ * flush a window - noop under Windows
+ */
+void wflush(w)
+wbp w;
+   {
+   }
+
+#endif					/* Graphics */
diff --git a/src/runtime/rstruct.r b/src/runtime/rstruct.r
new file mode 100644
index 0000000..22ab704
--- /dev/null
+++ b/src/runtime/rstruct.r
@@ -0,0 +1,665 @@
+/*
+ * File: rstruct.r
+ *  Contents: addmem, cpslots, cplist, cpset, hmake, hchain, hfirst, hnext,
+ *  hgrow, hshrink, memb
+ */
+
+/*
+ * addmem - add a new set element block in the correct spot in
+ *  the bucket chain.
+ */
+
+void addmem(ps,pe,pl)
+union block **pl;
+struct b_set *ps;
+struct b_selem *pe;
+   {
+   ps->size++;
+   if (*pl != NULL )
+      pe->clink = *pl;
+   *pl = (union block *) pe;
+   }
+
+/*
+ * cpslots(dp1, slotptr, i, j) - copy elements of sublist dp1[i:j]
+ *  into an array of descriptors.
+ */
+
+void cpslots(dp1, slotptr, i, j)
+dptr dp1, slotptr;
+word i, j;
+   {
+   word size;
+   tended struct b_list *lp1;
+   tended struct b_lelem *bp1;
+   /*
+    * Get pointers to the list and list elements for the source list
+    *  (bp1, lp1).
+    */
+   lp1 = (struct b_list *) BlkLoc(*dp1);
+   bp1 = (struct b_lelem *) lp1->listhead;
+   size = j - i;
+
+   /*
+    * Locate the block containing element i in the source list.
+    */
+   if (size > 0) {
+      while (i > bp1->nused) {
+         i -= bp1->nused;
+         bp1 = (struct b_lelem *) bp1->listnext;
+         }
+      }
+
+   /*
+    * Copy elements from the source list into the sublist, moving to
+    *  the next list block in the source list when all elements in a
+    *  block have been copied.
+    */
+   while (size > 0) {
+      j = bp1->first + i - 1;
+      if (j >= bp1->nslots)
+         j -= bp1->nslots;
+      *slotptr++ = bp1->lslots[j];
+      if (++i > bp1->nused) {
+         i = 1;
+         bp1 = (struct b_lelem *) bp1->listnext;
+         }
+      size--;
+      }
+   }
+
+
+/*
+ * cplist(dp1,dp2,i,j) - copy sublist dp1[i:j] into dp2.
+ */
+
+int cplist(dp1, dp2, i, j)
+dptr dp1, dp2;
+word i, j;
+   {
+   word size, nslots;
+   tended struct b_list *lp2;
+   tended struct b_lelem *bp2;
+
+   /*
+    * Calculate the size of the sublist.
+    */
+   size = nslots = j - i;
+   if (nslots == 0)
+      nslots = MinListSlots;
+
+   Protect(lp2 = (struct b_list *) alclist(size), return Error);
+   Protect(bp2 = (struct b_lelem *)alclstb(nslots,(word)0,size), return Error);
+   lp2->listhead = lp2->listtail = (union block *) bp2;
+#ifdef ListFix
+   bp2->listprev = bp2->listnext = (union block *) lp2;
+#endif					/* ListFix */
+
+   cpslots(dp1, bp2->lslots, i, j);
+
+   /*
+    * Fix type and location fields for the new list.
+    */
+   dp2->dword = D_List;
+   BlkLoc(*dp2) = (union block *) lp2;
+   EVValD(dp2, E_Lcreate);
+   return Succeeded;
+   }
+
+#ifdef TableFix
+/*
+ * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries.
+ */
+int cpset(dp1, dp2, n)
+dptr dp1, dp2;
+word n;
+   {
+   int i = cphash(dp1, dp2, n, T_Set);
+   EVValD(dp2, E_Screate);
+   return i;
+   }
+
+int cptable(dp1, dp2, n)
+dptr dp1, dp2;
+word n;
+   {
+   int i = cphash(dp1, dp2, n, T_Table);
+   BlkLoc(*dp2)->table.defvalue = BlkLoc(*dp1)->table.defvalue;
+   EVValD(dp2, E_Tcreate);
+   return i;
+   }
+
+int cphash(dp1, dp2, n, tcode)
+dptr dp1, dp2;
+word n;
+int tcode;
+   {
+   union block *src;
+   tended union block *dst;
+   tended struct b_slots *seg;
+   tended struct b_selem *ep, *prev;
+   struct b_selem *se;
+   register word slotnum;
+   register int i;
+
+   /*
+    * Make a new set organized like dp1, with room for n elements.
+    */
+   dst = hmake(tcode, BlkLoc(*dp1)->set.mask + 1, n);
+   if (dst == NULL)
+      return Error;
+   /*
+    * Copy the header and slot blocks.
+    */
+   src = BlkLoc(*dp1);
+   dst->set.size = src->set.size;	/* actual set size */
+   dst->set.mask = src->set.mask;	/* hash mask */
+   for (i = 0; i < HSegs && src->set.hdir[i] != NULL; i++)
+      memcpy((char *)dst->set.hdir[i], (char *)src->set.hdir[i],
+         src->set.hdir[i]->blksize);
+   /*
+    * Work down the chain of element blocks in each bucket
+    *	and create identical chains in new set.
+    */
+   for (i = 0; i < HSegs && (seg = dst->set.hdir[i]) != NULL; i++)
+      for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
+	 prev = NULL;
+         for (ep = (struct b_selem *)seg->hslots[slotnum];
+	      ep != NULL && BlkType(ep) != T_Table;
+	      ep = (struct b_selem *)ep->clink) {
+	    if (tcode == T_Set) {
+               Protect(se = alcselem(&ep->setmem, ep->hashnum), return Error);
+               se->clink = ep->clink;
+	       }
+	    else {
+	       Protect(se = (struct b_selem *)alctelem(), return Error);
+	       *(struct b_telem *)se = *(struct b_telem *)ep; /* copy table entry */
+	       if (BlkType(se->clink) == T_Table)
+		  se->clink = dst;
+	       }
+	    if (prev == NULL)
+		seg->hslots[slotnum] = (union block *)se;
+	    else
+		prev->clink = (union block *)se;
+	    prev = se;
+            }
+         }
+   dp2->dword = tcode | D_Typecode | F_Ptr;
+   BlkLoc(*dp2) = dst;
+   if (TooSparse(dst))
+      hshrink(dst);
+   return Succeeded;
+   }
+#else					/* TableFix */
+/*
+ * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries.
+ */
+int cpset(dp1, dp2, n)
+dptr dp1, dp2;
+word n;
+   {
+   union block *src;
+   tended union block *dst;
+   tended struct b_slots *seg;
+   tended struct b_selem *ep, *prev;
+   struct b_selem *se;
+   register word slotnum;
+   register int i;
+
+   /*
+    * Make a new set organized like dp1, with room for n elements.
+    */
+   dst = hmake(T_Set, BlkLoc(*dp1)->set.mask + 1, n);
+   if (dst == NULL)
+      return Error;
+   /*
+    * Copy the header and slot blocks.
+    */
+   src = BlkLoc(*dp1);
+   dst->set.size = src->set.size;	/* actual set size */
+   dst->set.mask = src->set.mask;	/* hash mask */
+   for (i = 0; i < HSegs && src->set.hdir[i] != NULL; i++)
+      memcpy((char *)dst->set.hdir[i], (char *)src->set.hdir[i],
+         src->set.hdir[i]->blksize);
+   /*
+    * Work down the chain of element blocks in each bucket
+    *	and create identical chains in new set.
+    */
+   for (i = 0; i < HSegs && (seg = dst->set.hdir[i]) != NULL; i++)
+      for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
+	 prev = NULL;
+         for (ep = (struct b_selem *)seg->hslots[slotnum];
+	       ep != NULL; ep = (struct b_selem *)ep->clink) {
+            Protect(se = alcselem(&ep->setmem, ep->hashnum), return Error);
+	    if (prev == NULL)
+		seg->hslots[slotnum] = (union block *)se;
+	    else
+		prev->clink = (union block *)se;
+            se->clink = ep->clink;
+	    prev = se;
+            }
+         }
+   dp2->dword = D_Set;
+   BlkLoc(*dp2) = dst;
+   if (TooSparse(dst))
+      hshrink(dst);
+   Desc_EVValD(dst, E_Screate, D_Set);
+   return Succeeded;
+   }
+#endif					/* TableFix */
+
+/*
+ * hmake - make a hash structure (Set or Table) with a given number of slots.
+ *  If *nslots* is zero, a value appropriate for *nelem* elements is chosen.
+ *  A return of NULL indicates allocation failure.
+ */
+union block *hmake(tcode, nslots, nelem)
+int tcode;
+word nslots, nelem;
+   {
+   word seg, t, blksize, elemsize;
+   tended union block *blk;
+   struct b_slots *segp;
+
+   if (nslots == 0)
+      nslots = (nelem + MaxHLoad - 1) / MaxHLoad;
+   for (seg = t = 0; seg < (HSegs - 1) && (t += segsize[seg]) < nslots; seg++)
+      ;
+   nslots = ((word)HSlots) << seg;	/* ensure legal power of 2 */
+   if (tcode == T_Table) {
+      blksize = sizeof(struct b_table);
+      elemsize = sizeof(struct b_telem);
+      }
+   else {	/* T_Set */
+      blksize = sizeof(struct b_set);
+      elemsize = sizeof(struct b_selem);
+      }
+   if (!reserve(Blocks, (word)(blksize + (seg + 1) * sizeof(struct b_slots)
+      + (nslots - HSlots * (seg + 1)) * sizeof(union block *)
+      + nelem * elemsize))) return NULL;
+   Protect(blk = alchash(tcode), return NULL);
+   for (; seg >= 0; seg--) {
+      Protect(segp = alcsegment(segsize[seg]), return NULL);
+      blk->set.hdir[seg] = segp;
+#ifdef TableFix
+      if (tcode == T_Table) {
+	 int j;
+	 for (j = 0; j < segsize[seg]; j++)
+	    segp->hslots[j] = blk;
+         }
+#endif					/* TableFix */
+      }
+   blk->set.mask = nslots - 1;
+   return blk;
+   }
+
+/*
+ * hchain - return a pointer to the word that points to the head of the hash
+ *  chain for hash number hn in hashed structure s.
+ */
+
+/*
+ * lookup table for log to base 2; must have powers of 2 through (HSegs-1)/2.
+ */
+static unsigned char log2h[] = {
+   0,1,2,2, 3,3,3,3, 4,4,4,4, 4,4,4,4, 5,5,5,5, 5,5,5,5, 5,5,5,5, 5,5,5,5,
+   6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6,
+   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,
+   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,
+   8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
+   8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
+   8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
+   8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
+   };
+
+union block **hchain(pb, hn)
+union block *pb;
+register uword hn;
+   {
+   register struct b_set *ps;
+   register word slotnum, segnum, segslot;
+
+   ps = (struct b_set *)pb;
+   slotnum = hn & ps->mask;
+   if (slotnum >= HSlots * sizeof(log2h))
+      segnum = log2h[slotnum >> (LogHSlots + HSegs/2)] + HSegs/2;
+   else
+      segnum = log2h[slotnum >> LogHSlots];
+   segslot = hn & (segsize[segnum] - 1);
+   return &ps->hdir[segnum]->hslots[segslot];
+   }
+
+/*
+ * hgfirst - initialize for generating set or table, and return first element.
+ */
+
+union block *hgfirst(bp, s)
+union block *bp;
+struct hgstate *s;
+   {
+   int i;
+
+   s->segnum = 0;				/* set initial state */
+   s->slotnum = -1;
+   s->tmask = bp->table.mask;
+   for (i = 0; i < HSegs; i++)
+      s->sghash[i] = s->sgmask[i] = 0;
+   return hgnext(bp, s, (union block *)0);	/* get and return first value */
+   }
+
+/*
+ * hgnext - return the next element of a set or table generation sequence.
+ *
+ *  We carefully generate each element exactly once, even if the hash chains
+ *  are split between calls.  We do this by recording the state of things at
+ *  the time of the split and checking past history when starting to process
+ *  a new chain.
+ *
+ *  Elements inserted or deleted between calls may or may not be generated.
+ *
+ *  We assume that no structure *shrinks* after its initial creation; they
+ *  can only *grow*.
+ */
+
+union block *hgnext(bp, s, ep)
+union block *bp;
+struct hgstate *s;
+union block *ep;
+   {
+   int i;
+   word d, m;
+   uword hn;
+
+   /*
+    * Check to see if the set or table's hash buckets were split (once or
+    *  more) since the last call.  We notice this unless the next entry
+    *  has same hash value as the current one, in which case we defer it
+    *  by doing nothing now.
+    */
+#ifdef TableFix
+   if (bp->table.mask != s->tmask &&
+	  (ep->selem.clink == NULL || BlkType(ep->telem.clink) == T_Table ||
+	  ep->telem.clink->telem.hashnum != ep->telem.hashnum)) {
+#else					/* TableFix */
+   if (bp->table.mask != s->tmask &&
+	  (ep->selem.clink == NULL ||
+	  ep->telem.clink->telem.hashnum != ep->telem.hashnum)) {
+#endif					/* TableFix */
+      /*
+       * Yes, they did split.  Make a note of the current state.
+       */
+      hn = ep->telem.hashnum;
+      for (i = 1; i < HSegs; i++)
+         if ((((word)HSlots) << (i - 1)) > s->tmask) {
+	 /*
+	  * For the newly created segments only, save the mask and
+	  *  hash number being processed at time of creation.
+	  */
+	 s->sgmask[i] = s->tmask;
+	 s->sghash[i] = hn;
+         }
+      s->tmask = bp->table.mask;
+      /*
+       * Find the next element in our original segment by starting
+       *  from the beginning and skipping through the current hash
+       *  number.  We can't just follow the link from the current
+       *  element, because it may have moved to a new segment.
+       */
+      ep = bp->table.hdir[s->segnum]->hslots[s->slotnum];
+#ifdef TableFix
+      while (ep != NULL && BlkType(ep) != T_Table &&
+	     ep->telem.hashnum <= hn)
+#else					/* TableFix */
+      while (ep != NULL && ep->telem.hashnum <= hn)
+#endif					/* TableFix */
+         ep = ep->telem.clink;
+      }
+
+   else {
+      /*
+       * There was no split, or else if there was we're between items
+       *  that have identical hash numbers.  Find the next element in
+       *  the current hash chain.
+       */
+#ifdef TableFix
+      if (ep != NULL && BlkType(ep) != T_Table)	/* NULL on very first call */
+#else					/* TableFix */
+      if (ep != NULL)			/* already NULL on very first call */
+#endif					/* TableFix */
+         ep = ep->telem.clink;		/* next element in chain, if any */
+   }
+
+   /*
+    * If we don't yet have an element, search successive slots.
+    */
+#ifdef TableFix
+   while (ep == NULL || BlkType(ep) == T_Table) {
+#else					/* TableFix */
+   while (ep == NULL) {
+#endif					/* TableFix */
+      /*
+       * Move to the next slot and pick the first entry.
+       */
+      s->slotnum++;
+      if (s->slotnum >= segsize[s->segnum]) {
+	 s->slotnum = 0;		/* need to move to next segment */
+	 s->segnum++;
+	 if (s->segnum >= HSegs || bp->table.hdir[s->segnum] == NULL)
+	    return 0;			/* return NULL at end of set/table */
+         }
+      ep = bp->table.hdir[s->segnum]->hslots[s->slotnum];
+      /*
+       * Check to see if parts of this hash chain were already processed.
+       *  This could happen if the elements were in a different chain,
+       *  but a split occurred while we were suspended.
+       */
+      for (i = s->segnum; (m = s->sgmask[i]) != 0; i--) {
+         d = (word)(m & s->slotnum) - (word)(m & s->sghash[i]);
+         if (d < 0)			/* if all elements processed earlier */
+            ep = NULL;			/* skip this slot */
+         else if (d == 0) {
+            /*
+             * This chain was split from its parent while the parent was
+             *  being processed.  Skip past elements already processed.
+             */
+#ifdef TableFix
+            while (ep != NULL && BlkType(ep) != T_Table &&
+		   ep->telem.hashnum <= s->sghash[i])
+#else					/* TableFix */
+            while (ep != NULL && ep->telem.hashnum <= s->sghash[i])
+#endif					/* TableFix */
+               ep = ep->telem.clink;
+            }
+         }
+      }
+
+   /*
+    * Return the element.
+    */
+#ifdef TableFix
+   if (ep && BlkType(ep) == T_Table) ep = NULL;
+#endif					/* TableFix */
+   return ep;
+   }
+
+/*
+ * hgrow - split a hashed structure (doubling the buckets) for faster access.
+ */
+
+void hgrow(bp)
+union block *bp;
+   {
+   register union block **tp0, **tp1, *ep;
+   register word newslots, slotnum, segnum;
+   tended struct b_set *ps;
+   struct b_slots *seg, *newseg;
+   union block **curslot;
+
+   ps = (struct b_set *) bp;
+   if (ps->hdir[HSegs-1] != NULL)
+      return;				/* can't split further */
+   newslots = ps->mask + 1;
+   Protect(newseg = alcsegment(newslots), return);
+#ifdef TableFix
+   if (BlkType(bp) == T_Table) {
+      int j;
+      for(j=0; j<newslots; j++) newseg->hslots[j] = bp;
+      }
+#endif					/* TableFix */
+
+   curslot = newseg->hslots;
+   for (segnum = 0; (seg = ps->hdir[segnum]) != NULL; segnum++)
+      for (slotnum = 0; slotnum < segsize[segnum]; slotnum++)  {
+         tp0 = &seg->hslots[slotnum];	/* ptr to tail of old slot */
+         tp1 = curslot++;		/* ptr to tail of new slot */
+#ifdef TableFix
+         for (ep = *tp0;
+	      ep != NULL && BlkType(ep) != T_Table;
+	      ep = ep->selem.clink) {
+#else					/* TableFix */
+         for (ep = *tp0; ep != NULL; ep = ep->selem.clink) {
+#endif					/* TableFix */
+            if ((ep->selem.hashnum & newslots) == 0) {
+               *tp0 = ep;		/* element does not move */
+               tp0 = &ep->selem.clink;
+               }
+            else {
+               *tp1 = ep;		/* element moves to new slot */
+               tp1 = &ep->selem.clink;
+               }
+            }
+#ifdef TableFix
+         if ( BlkType(bp) == T_Table )
+	    *tp0 = *tp1 = bp;
+         else
+            *tp0 = *tp1 = NULL;
+#else					/* TableFix */
+         *tp0 = *tp1 = NULL;
+#endif					/* TableFix */
+         }
+   ps->hdir[segnum] = newseg;
+   ps->mask = (ps->mask << 1) | 1;
+   }
+
+/*
+ * hshrink - combine buckets in a set or table that is too sparse.
+ *
+ *  Call this only for newly created structures.  Shrinking an active structure
+ *  can wreak havoc on suspended generators.
+ */
+void hshrink(bp)
+union block *bp;
+   {
+   register union block **tp, *ep0, *ep1;
+   int topseg, curseg;
+   word slotnum;
+   tended struct b_set *ps;
+   struct b_slots *seg;
+   union block **uppslot;
+
+   ps = (struct b_set *)bp;
+   topseg = 0;
+   for (topseg = 1; topseg < HSegs && ps->hdir[topseg] != NULL; topseg++)
+      ;
+   topseg--;
+   while (TooSparse(ps)) {
+      uppslot = ps->hdir[topseg]->hslots;
+      ps->hdir[topseg--] = NULL;
+      for (curseg = 0; (seg = ps->hdir[curseg]) != NULL; curseg++)
+         for (slotnum = 0; slotnum < segsize[curseg]; slotnum++)  {
+            tp = &seg->hslots[slotnum];		/* tail pointer */
+            ep0 = seg->hslots[slotnum];		/* lower slot entry pointer */
+            ep1 = *uppslot++;			/* upper slot entry pointer */
+#ifdef TableFix
+            while (ep0 != NULL && BlkType(ep0) != T_Table &&
+		   ep1 != NULL && BlkType(ep1) != T_Table)
+#else					/* TableFix */
+            while (ep0 != NULL && ep1 != NULL)
+#endif					/* TableFix */
+               if (ep0->selem.hashnum < ep1->selem.hashnum) {
+                  *tp = ep0;
+                  tp = &ep0->selem.clink;
+                  ep0 = ep0->selem.clink;
+                  }
+               else {
+                  *tp = ep1;
+                  tp = &ep1->selem.clink;
+                  ep1 = ep1->selem.clink;
+                  }
+#ifdef TableFix
+            while (ep0 != NULL && BlkType(ep0) != T_Table) {
+#else					/* TableFix */
+            while (ep0 != NULL) {
+#endif					/* TableFix */
+               *tp = ep0;
+               tp = &ep0->selem.clink;
+               ep0 = ep0->selem.clink;
+               }
+#ifdef TableFix
+            while (ep1 != NULL && BlkType(ep1) != T_Table) {
+#else					/* TableFix */
+            while (ep1 != NULL) {
+#endif					/* TableFix */
+               *tp = ep1;
+               tp = &ep1->selem.clink;
+               ep1 = ep1->selem.clink;
+               }
+            }
+      ps->mask >>= 1;
+      }
+   }
+
+/*
+ * memb - sets res flag to 1 if x is a member of a set or table, or to 0 if not.
+ *  Returns a pointer to the word which points to the element, or which
+ *  would point to it if it were there.
+ */
+
+union block **memb(pb, x, hn, res)
+union block *pb;
+dptr x;
+register uword hn;
+int *res;				/* pointer to integer result flag */
+   {
+   struct b_set *ps;
+   register union block **lp;
+   register struct b_selem *pe;
+   register uword eh;
+
+   ps = (struct b_set *)pb;
+   lp = hchain(pb, hn);
+   /*
+    * Look for x in the hash chain.
+    */
+   *res = 0;
+#ifdef TableFix
+   while ((pe = (struct b_selem *)*lp) != NULL && BlkType(pe) != T_Table) {
+#else					/* TableFix */
+   while ((pe = (struct b_selem *)*lp) != NULL) {
+#endif					/* TableFix */
+      eh = pe->hashnum;
+      if (eh > hn)			/* too far - it isn't there */
+         return lp;
+      else if ((eh == hn) && (equiv(&pe->setmem, x)))  {
+         *res = 1;
+         return lp;
+         }
+      /*
+       * We haven't reached the right hashnumber yet or
+       *  the element isn't the right one so keep looking.
+       */
+      lp = &(pe->clink);
+      }
+   /*
+    *  At end of chain - not there.
+    */
+   return lp;
+   }
diff --git a/src/runtime/rsys.r b/src/runtime/rsys.r
new file mode 100644
index 0000000..f4bdfc1
--- /dev/null
+++ b/src/runtime/rsys.r
@@ -0,0 +1,252 @@
+/*
+ * File: rsys.r
+ *  Contents: getstrg, host, longread, putstr
+ */
+
+/*
+ * getstrg - read a line into buf from file fbp.  At most maxi characters
+ *  are read.  getstrg returns the length of the line, not counting the
+ *  newline.  Returns -1 if EOF and -2 if length was limited by maxi.
+ *  Discards \r before \n in translated mode.  [[ Needs ferror() check. ]]
+ */
+
+int getstrg(buf, maxi, fbp)
+register char *buf;
+int maxi;
+struct b_file *fbp;
+   {
+   register int c, l;
+   FILE *fd;
+
+   fd = fbp->fd;
+
+   #ifdef XWindows
+      if (isatty(fileno(fd))) wflushall();
+   #endif				/* XWindows */
+
+   l = 0;
+   while (1) {
+
+      #ifdef Graphics
+         /* insert non-blocking read/code to service windows here */
+      #endif				/* Graphics */
+
+      if ((c = fgetc(fd)) == '\n')	/* \n terminates line */
+	 break;
+      if (c == '\r' && (fbp->status & Fs_Untrans) == 0) {
+	 /* \r terminates line in translated mode */
+	 if ((c = fgetc(fd)) != '\n')	/* consume following \n */
+	     ungetc(c, fd);		/* (put back if not \n) */
+	 break;
+	 }
+      if (c == EOF) {
+	 if (l > 0) return l;
+	 else return -1;
+         }
+      if (++l > maxi) {
+	 ungetc(c, fd);
+	 return -2;
+	 }
+      *buf++ = c;
+      }
+   return l;
+   }
+
+/*
+ * iconhost - return some sort of host name into the buffer pointed at
+ *  by hostname.  This code accommodates several different host name
+ *  fetching schemes.
+ */
+void iconhost(hostname)
+char *hostname;
+   {
+   /*
+    * Use the uname system call.  (POSIX)
+    */
+   struct utsname utsn;
+   uname(&utsn);
+   strcpy(hostname,utsn.nodename);
+   }
+
+/*
+ * Read a long string in shorter parts. (Standard read may not handle long
+ *  strings.)
+ */
+word longread(s,width,len,fd)
+FILE *fd;
+int width;
+char *s;
+long len;
+{
+   tended char *ts = s;
+   long tally = 0;
+   long n = 0;
+
+#ifdef XWindows
+   if (isatty(fileno(fd))) wflushall();
+#endif					/* XWindows */
+
+   while (len > 0) {
+      n = fread(ts, width, (int)((len < MaxIn) ? len : MaxIn), fd);
+      if (n <= 0) {
+         return tally;
+	 }
+      tally += n;
+      ts += n;
+      len -= n;
+      }
+   return tally;
+   }
+
+/*
+ * Print string referenced by descriptor d. Note, d must not move during
+ *   a garbage collection.
+ */
+
+int putstr(f, d)
+register FILE *f;
+dptr d;
+   {
+   register char *s;
+   register word l;
+
+   l = StrLen(*d);
+   if (l == 0)
+      return  Succeeded;
+   s = StrLoc(*d);
+   if (longwrite(s,l,f) < 0)
+      return Failed;
+   else
+      return Succeeded;
+   }
+
+/*
+ * idelay(n) - delay for n milliseconds
+ */
+int idelay(n)
+int n;
+   {
+   #if MSWIN
+      Sleep(n);
+      return Succeeded;
+   #else				/* MSWIN */
+      struct timeval t;
+      t.tv_sec = n / 1000;
+      t.tv_usec = (n % 1000) * 1000;
+      select(1, NULL, NULL, NULL, &t);
+      return Succeeded;
+   #endif				/* MSWIN */
+   }
+
+#ifdef KeyboardFncs
+
+/*
+ * Documentation notwithstanding, the Unix versions of the keyboard functions
+ * read from standard input and not necessarily from the keyboard (/dev/tty).
+ */
+#define STDIN 0
+
+/*
+ * int getch() -- read character without echoing
+ * int getche() -- read character with echoing
+ *
+ * Read and return a character from standard input in non-canonical
+ * ("cbreak") mode.  Return -1 for EOF.
+ *
+ * Reading is done even if stdin is not a tty;
+ * the tty get/set functions are just rejected by the system.
+ */
+
+int rchar(int with_echo);
+
+int getch(void)		{ return rchar(0); }
+int getche(void)	{ return rchar(1); }
+
+int rchar(int with_echo)
+{
+   struct termios otty, tty;
+   char c;
+   int n;
+
+   tcgetattr(STDIN, &otty);		/* get current tty attributes */
+
+   tty = otty;
+   tty.c_lflag &= ~ICANON;
+   if (with_echo)
+      tty.c_lflag |= ECHO;
+   else
+      tty.c_lflag &= ~ECHO;
+   tcsetattr(STDIN, TCSANOW, &tty);	/* set temporary attributes */
+
+   n = read(STDIN, &c, 1);		/* read one char from stdin */
+
+   tcsetattr(STDIN, TCSANOW, &otty);	/* reset tty to original state */
+
+   if (n == 1)				/* if read succeeded */
+      return c & 0xFF;
+   else
+      return -1;
+}
+
+/*
+ * kbhit() -- return nonzero if characters are available for getch/getche.
+ */
+int kbhit(void)
+{
+   struct termios otty, tty;
+   fd_set fds;
+   struct timeval tv;
+   int rv;
+
+   tcgetattr(STDIN, &otty);		/* get current tty attributes */
+
+   tty = otty;
+   tty.c_lflag &= ~ICANON;		/* disable input batching */
+   tcsetattr(STDIN, TCSANOW, &tty);	/* set attribute temporarily */
+
+   FD_ZERO(&fds);			/* initialize fd struct */
+   FD_SET(STDIN, &fds);			/* set STDIN bit */
+   tv.tv_sec = tv.tv_usec = 0;		/* set immediate return */
+   rv = select(STDIN + 1, &fds, NULL, NULL, &tv);
+
+   tcsetattr(STDIN, TCSANOW, &otty);	/* reset tty to original state */
+
+   return rv;				/* return result */
+}
+
+#endif					/* KeyboardFncs */
+
+#ifdef FAttrib
+/*
+ * make_mode takes mode_t type (an integer) input and returns the
+ * file permission in the format of a string.
+*/
+char *make_mode (mode_t st_mode)
+{
+   char *buf;
+
+   if ( (buf = (char *) malloc(sizeof(char)*11)) == NULL ) {
+      fprintf(stderr,"fatal malloc error\n");
+      return NULL;
+   }
+
+   if ( st_mode & S_IFIFO )      buf[0] = 'f';
+   else if ( st_mode & S_IFCHR ) buf[0] = 'c';
+   else if ( st_mode & S_IFDIR ) buf[0] = 'd';
+   else if ( st_mode & S_IFREG ) buf[0] = '-';
+   else			         buf[0] = '\?';
+
+   if (st_mode & S_IREAD)  buf[1] = 'r';  else buf[1] = '-';
+   if (st_mode & S_IWRITE) buf[2] = 'w';  else buf[2] = '-';
+   if (st_mode & S_IEXEC)  buf[3] = 'x';  else buf[3] = '-';
+   if (st_mode & S_IREAD)  buf[4] = 'r';  else buf[4] = '-';
+   if (st_mode & S_IWRITE) buf[5] = 'w';  else buf[5] = '-';
+   if (st_mode & S_IEXEC)  buf[6] = 'x';  else buf[6] = '-';
+   if (st_mode & S_IREAD)  buf[7] = 'r';  else buf[7] = '-';
+   if (st_mode & S_IWRITE) buf[8] = 'w';  else buf[8] = '-';
+   if (st_mode & S_IEXEC)  buf[9] = 'x';  else buf[9] = '-';
+
+   buf[10] = '\0';
+   return buf;
+}
+#endif					/* FAttrib */
diff --git a/src/runtime/rwindow.r b/src/runtime/rwindow.r
new file mode 100644
index 0000000..752baa2
--- /dev/null
+++ b/src/runtime/rwindow.r
@@ -0,0 +1,1727 @@
+/*
+ * File: rwindow.r
+ *  non window-system-specific window support routines
+ */
+
+#ifdef Graphics
+
+static	int	setpos          (wbp w, char *s);
+static	int	sicmp		(siptr sip1, siptr sip2);
+
+int canvas_serial, context_serial;
+
+#ifndef MultiThread
+struct descrip amperX = {D_Integer};
+struct descrip amperY = {D_Integer};
+struct descrip amperCol = {D_Integer};
+struct descrip amperRow = {D_Integer};
+struct descrip amperInterval = {D_Integer};
+struct descrip lastEventWin = {D_Null};
+int lastEvFWidth = 0, lastEvLeading = 0, lastEvAscent = 0;
+uword xmod_control, xmod_shift, xmod_meta;
+#endif					/* MultiThread */
+
+
+/*
+ * subscript the already-processed-events "queue" to index i.
+ * used in "cooked mode" I/O to determine, e.g. how far to backspace.
+ */
+char *evquesub(w,i)
+wbp w;
+int i;
+   {
+   wsp ws = w->window;
+   int j = ws->eQback+i;
+
+   if (i < 0) {
+      if (j < 0) j+= EQUEUELEN;
+      else if (j > EQUEUELEN) j -= EQUEUELEN;
+      return &(ws->eventQueue[j]);
+      }
+   else {
+      /* "this isn't getting called in the forwards direction!\n" */
+      return NULL;
+      }
+   }
+
+
+/*
+ * get event from window, assigning to &x, &y, and &interval
+ *
+ * returns 0 for success, -1 if window died or EOF, -2 for malformed queue
+ */
+int wgetevent(w,res)
+wbp w;
+dptr res;
+   {
+   struct descrip xdesc, ydesc;
+   uword i;
+
+   if (wstates != NULL && wstates->next != NULL		/* if multiple windows*/
+   && (BlkLoc(w->window->listp)->list.size == 0)) {	/* & queue is empty */
+      while (BlkLoc(w->window->listp)->list.size == 0) {
+         #ifdef WinGraphics
+	    if (ISCURSORON(w) && w->window->hasCaret == 0) {
+	       wsp ws = w->window;
+	       CreateCaret(ws->iconwin, NULL, FWIDTH(w), FHEIGHT(w));
+	       SetCaretBlinkTime(500);
+	       SetCaretPos(ws->x, ws->y - ASCENT(w));
+	       ShowCaret(ws->iconwin);
+	       ws->hasCaret = 1;
+	       }
+         #endif				/* WinGraphics */
+	 if (pollevent() < 0)				/* poll all windows */
+	    break;					/* break on error */
+         idelay(POLLSLEEP);
+	 }
+      }
+
+   if (wgetq(w,res) == -1)
+      return -1;					/* window died */
+
+   if (BlkLoc(w->window->listp)->list.size < 2)
+      return -2;					/* malformed queue */
+
+   wgetq(w,&xdesc);
+   wgetq(w,&ydesc);
+
+   if (xdesc.dword != D_Integer || ydesc.dword != D_Integer)
+      return -2;			/* bad values on queue */
+
+   IntVal(amperX) = IntVal(xdesc) & 0xFFFF;		/* &x */
+   if (IntVal(amperX) >= 0x8000)
+      IntVal(amperX) -= 0x10000;
+   IntVal(amperY) = IntVal(ydesc) & 0xFFFF;		/* &y */
+   if (IntVal(amperY) >= 0x8000)
+      IntVal(amperY) -= 0x10000;
+   IntVal(amperX) -= w->context->dx;
+   IntVal(amperY) -= w->context->dy;
+   MakeInt(1 + XTOCOL(w,IntVal(amperX)), &(amperCol));	/* &col */
+   MakeInt(YTOROW(w,IntVal(amperY)) , &(amperRow));	/* &row */
+
+   xmod_control = IntVal(xdesc) & EQ_MOD_CONTROL;	/* &control */
+   xmod_meta = IntVal(xdesc) & EQ_MOD_META;		/* &meta */
+   xmod_shift = IntVal(xdesc) & EQ_MOD_SHIFT;		/* &shift */
+
+   i = (((uword) IntVal(ydesc)) >> 16) & 0xFFF;		/* mantissa */
+   i <<= 4 * ((((uword) IntVal(ydesc)) >> 28) & 0x7);	/* scale it */
+   IntVal(amperInterval) = i;				/* &interval */
+   return 0;
+   }
+
+/*
+ * get event from window (drop mouse events), no echo
+ *
+ * return: 1 = success, -1 = window died, -2 = malformed queue, -3 = EOF
+ */
+int wgetchne(w,res)
+wbp w;
+dptr res;
+   {
+   int i;
+
+   while (1) {
+      i = wgetevent(w,res);
+      if (i != 0)
+	 return i;
+      if (is:string(*res)) {
+#ifdef WinGraphics
+         if (*StrLoc(*res) == '\032') return -3; /* control-Z gives EOF */
+#endif					/* WinGraphics */
+         return 1;
+	 }
+      }
+   }
+
+/*
+ * get event from window (drop mouse events), with echo
+ *
+ * returns 1 for success, -1 if window died, -2 for malformed queue, -3 for EOF
+ */
+int wgetche(w,res)
+wbp w;
+dptr res;
+   {
+   int i;
+   i = wgetchne(w,res);
+   if (i != 1)
+      return i;
+   i = *StrLoc(*res);
+   if ((0 <= i) && (i <= 127) && (ISECHOON(w))) {
+      wputc(i, w);
+      if (i == '\r') wputc((int)'\n', w); /* CR -> CR/LF */
+      }
+   return 1;
+   }
+
+/*
+ * Get a window that has an event pending (queued)
+ */
+wsp getactivewindow()
+   {
+   static LONG next = 0;
+   LONG i, j, nwindows = 0;
+   wsp ptr, ws, stdws = NULL;
+   extern FILE *ConsoleBinding;
+
+   if (wstates == NULL) return NULL;
+   for(ws = wstates; ws; ws=ws->next) nwindows++;
+   if (ConsoleBinding) stdws = ((wbp)ConsoleBinding)->window;
+   /*
+    * make sure we are still in bounds
+    */
+   next %= nwindows;
+   /*
+    * position ptr on the next window to get events from
+    */
+   for (ptr = wstates, i = 0; i < next; i++, ptr = ptr->next);
+   /*
+    * Infinite loop, checking for an event somewhere, sleeping awhile
+    * each iteration.
+    */
+   for (;;) {
+      /*
+       * Check for any new pending events.
+       */
+      switch (pollevent()) {
+      case -1: ReturnErrNum(141, NULL);
+      case 0: return NULL;
+	 }
+      /*
+       * go through windows, looking for one with an event pending
+       */
+      for (ws = ptr, i = 0, j = next + 1; i < nwindows;
+	   (ws = (ws->next) ? ws->next : wstates), i++, j++)
+	 if (ws != stdws && BlkLoc(ws->listp)->list.size > 0) {
+	    next = j;
+	    return ws;
+	    }
+      /*
+       * couldn't find a pending event - wait awhile
+       */
+      idelay(POLLSLEEP);
+      }
+   }
+
+/*
+ * wlongread(s,elsize,nelem,f) -- read string from window for reads(w)
+ *
+ * returns length(>=0) for success, -1 if window died, -2 for malformed queue
+ *  -3 on EOF
+ */
+int wlongread(s, elsize, nelem, f)
+char *s;
+int elsize, nelem;
+FILE *f;
+   {
+   int c;
+   tended char *ts = s;
+   struct descrip foo;
+   long l = 0, bytes = elsize * nelem;
+
+   while (l < bytes) {
+     c = wgetche((wbp)f, &foo);
+     if (c == -3 && l > 0)
+	return l;
+     if (c < 0)
+	return c;
+     c = *StrLoc(foo);
+     switch(c) {
+       case '\177':
+       case '\010':
+         if (l > 0) { ts--; l--; }
+         break;
+       default:
+         *ts++ = c; l++;
+         break;
+       }
+     }
+   return l;
+   }
+
+/*
+ * wgetstrg(s,maxlen,f) -- get string from window for read(w) or !w
+ *
+ * returns length(>=0) for success, -1 if window died, -2 for malformed queue
+ *  -3 for EOF, -4 if length was limited by maxi
+ */
+int wgetstrg(s, maxlen, f)
+char *s;
+long  maxlen;
+FILE *f;
+   {
+   int c;
+   tended char *ts = s;
+   long l = 0;
+   struct descrip foo;
+
+   while (l < maxlen) {
+      c = wgetche((wbp)f,&foo);
+      if (c == -3 && l > 0)
+	 return l;
+      if (c < 0)
+	 return c;
+      c = *StrLoc(foo);
+      switch(c) {
+        case '\177':
+        case '\010':
+          if (l > 0) { ts--; l--; }
+          break;
+        case '\r':
+        case '\n':
+          return l;
+        default:
+          *ts++ = c; l++;
+          break;
+        }
+      }
+   return -4;
+   }
+
+
+/*
+ * Assignment side-effects for &x,&y,&row,&col
+ */
+int xyrowcol(dx)
+dptr dx;
+{
+   if (VarLoc(*dx) == &amperX) { /* update &col too */
+      wbp w;
+      if (!is:file(lastEventWin) ||
+          ((BlkLoc(lastEventWin)->file.status & Fs_Window) == 0) ||
+          ((BlkLoc(lastEventWin)->file.status & (Fs_Read|Fs_Write)) == 0)) {
+         MakeInt(1 + IntVal(amperX)/lastEvFWidth, &amperCol);
+	 }
+      else {
+         w = (wbp)BlkLoc(lastEventWin)->file.fd;
+         MakeInt(1 + XTOCOL(w, IntVal(amperX)), &amperCol);
+         }
+      }
+   else if (VarLoc(*dx) == &amperY) { /* update &row too */
+      wbp w;
+      if (!is:file(lastEventWin) ||
+          ((BlkLoc(lastEventWin)->file.status & Fs_Window) == 0) ||
+          ((BlkLoc(lastEventWin)->file.status & (Fs_Read|Fs_Write)) == 0)) {
+         MakeInt(IntVal(amperY) / lastEvLeading + 1, &amperRow);
+         }
+      else {
+         w = (wbp)BlkLoc(lastEventWin)->file.fd;
+         MakeInt(YTOROW(w, IntVal(amperY)), &amperRow);
+         }
+      }
+   else if (VarLoc(*dx) == &amperCol) { /* update &x too */
+      wbp w;
+      if (!is:file(lastEventWin) ||
+          ((BlkLoc(lastEventWin)->file.status & Fs_Window) == 0) ||
+          ((BlkLoc(lastEventWin)->file.status & (Fs_Read|Fs_Write)) == 0)) {
+         MakeInt((IntVal(amperCol) - 1) * lastEvFWidth, &amperX);
+         }
+      else {
+         w = (wbp)BlkLoc(lastEventWin)->file.fd;
+         MakeInt(COLTOX(w, IntVal(amperCol)), &amperX);
+         }
+      }
+   else if (VarLoc(*dx) == &amperRow) { /* update &y too */
+      wbp w;
+      if (!is:file(lastEventWin) ||
+          ((BlkLoc(lastEventWin)->file.status & Fs_Window) == 0) ||
+          ((BlkLoc(lastEventWin)->file.status & (Fs_Read|Fs_Write)) == 0)) {
+         MakeInt((IntVal(amperRow)-1) * lastEvLeading + lastEvAscent, &amperY);
+         }
+      else {
+         w = (wbp)BlkLoc(lastEventWin)->file.fd;
+         MakeInt(ROWTOY(w, IntVal(amperRow)), &amperY);
+         }
+      }
+   return 0;
+   }
+
+
+/*
+ * Enqueue an event, encoding time interval and key state with x and y values.
+ */
+void qevent(ws,e,x,y,t,f)
+wsp ws;		/* canvas */
+dptr e;		/* event code (descriptor pointer) */
+int x, y;	/* x and y values */
+uword t;	/* ms clock value */
+long f;		/* modifier key flags */
+   {
+   dptr q = &(ws->listp);	/* a window's event queue (Icon list value) */
+   struct descrip d;
+   uword ivl, mod;
+   int expo;
+
+   mod = 0;				/* set modifier key bits */
+   if (f & ControlMask) mod |= EQ_MOD_CONTROL;
+   if (f & Mod1Mask)    mod |= EQ_MOD_META;
+   if (f & ShiftMask)   mod |= EQ_MOD_SHIFT;
+
+   if (t != ~(uword)0) {		/* if clock value supplied */
+      if (ws->timestamp == 0)		/* if first time */
+	 ws->timestamp = t;
+      if (t < ws->timestamp)		/* if clock went backwards */
+	 t = ws->timestamp;
+      ivl = t - ws->timestamp;		/* calc interval in milliseconds */
+      ws->timestamp = t;		/* save new clock value */
+      expo = 0;
+      while (ivl >= 0x1000) {		/* if too big */
+	 ivl >>= 4;			/* reduce significance */
+	 expo += 0x1000;		/* bump exponent */
+	 }
+      ivl += expo;			/* combine exponent with mantissa */
+      }
+   else
+      ivl = 0;				/* report 0 if interval unknown */
+
+   c_put(q, e);
+   d.dword = D_Integer;
+   IntVal(d) = mod | (x & 0xFFFF);
+   c_put(q, &d);
+   IntVal(d) = (ivl << 16) | (y & 0xFFFF);
+   c_put(q, &d);
+   }
+
+/*
+ * setpos() - set (move) canvas position on the screen
+ */
+static int setpos(w,s)
+wbp w;
+char *s;
+   {
+   char *s2, tmp[32];
+   int posx, posy;
+
+   s2 = s;
+   while (isspace(*s2)) s2++;
+   if (!isdigit(*s2) && (*s2 != '-')) return Error;
+   posx = atol(s2);
+   if (*s2 == '-') s2++;
+   while (isdigit(*s2)) s2++;
+   if (*s2 == '.') {
+      s2++;
+      while (isdigit(*s2)) s2++;
+      }
+   if (*s2++ != ',') return Error;
+   if (!isdigit(*s2) && (*s2 != '-')) return Error;
+   posy = atol(s2);
+   if (*s2 == '-') s2++;
+   while (isdigit(*s2)) s2++;
+   if (*s2 == '.') {
+      s2++;
+      while (isdigit(*s2)) s2++;
+      }
+   if (*s2) return Error;
+   if (posx < 0) {
+      if (posy < 0) sprintf(tmp,"%d%d",posx,posy);
+      else sprintf(tmp,"%d+%d",posx,posy);
+      }
+   else {
+      if (posy < 0) sprintf(tmp,"+%d%d",posx,posy);
+      else sprintf(tmp,"+%d+%d",posx,posy);
+      }
+   return setgeometry(w,tmp);
+   }
+
+/*
+ * setsize() - set canvas size
+ */
+int setsize(w,s)
+wbp w;
+char *s;
+   {
+   char *s2, tmp[32];
+   int width, height;
+
+   s2 = s;
+   while (isspace(*s2)) s2++;
+   if (!isdigit(*s2) && (*s2 != '-')) return Error;
+   width = atol(s2);
+   if (*s2 == '-') s2++;
+   while (isdigit(*s2)) s2++;
+   if (*s2 == '.') {
+      s2++;
+      while (isdigit(*s2)) s2++;
+      }
+   if (*s2++ != ',') return Error;
+   height = atol(s2);
+   if (*s2 == '-') s2++;
+   while (isdigit(*s2)) s2++;
+   if (*s2 == '.') {
+      s2++;
+      while (isdigit(*s2)) s2++;
+      }
+   if (*s2) return Error;
+   sprintf(tmp,"%dx%d",width,height);
+   return setgeometry(w,tmp);
+   }
+
+
+
+/*
+ * put a string out to a window using the current attributes
+ */
+void wputstr(w,s,len)
+wbp w;
+char *s;
+int len;
+   {
+   char *s2 = s;
+   wstate *ws = w->window;
+   /* turn off the cursor */
+   hidecrsr(ws);
+
+   while (len > 0) {
+      /*
+       * find a chunk of printable text
+       */
+#ifdef WinGraphics
+      while (len > 0) {
+	 if (IsDBCSLeadByte(*s2)) {
+	    s2++; s2++; len--; len--;
+	    }
+	 else if (isprint(*s2)) {
+	    s2++; len--;
+	    }
+	 else break;
+	 }
+#else					/* WinGraphics */
+      while (isprint(*s2) && len > 0) {
+	 s2++; len--;
+	 }
+#endif					/* WinGraphics */
+      /*
+       * if a chunk was parsed, write it out
+       */
+      if (s2 != s)
+         xdis(w, s, s2 - s);
+      /*
+       * put the 'unprintable' character, if didn't just hit the end
+       */
+      if (len-- > 0) {
+         wputc(*s2++, w);
+         }
+    s = s2;
+    }
+
+  /* show the cursor again */
+  UpdateCursorPos(ws, w->context);
+  showcrsr(ws);
+  return;
+}
+
+/*
+ * mapping from recognized style attributes to flag values
+ */
+stringint fontwords[] = {
+   { 0,			17 },		/* number of entries */
+   { "bold",		FONTATT_WEIGHT	| FONTFLAG_BOLD },
+   { "condensed",	FONTATT_WIDTH	| FONTFLAG_CONDENSED },
+   { "demi",		FONTATT_WEIGHT	| FONTFLAG_DEMI },
+   { "demibold",	FONTATT_WEIGHT	| FONTFLAG_DEMI | FONTFLAG_BOLD },
+   { "extended",	FONTATT_WIDTH	| FONTFLAG_EXTENDED },
+   { "italic",		FONTATT_SLANT	| FONTFLAG_ITALIC },
+   { "light",		FONTATT_WEIGHT	| FONTFLAG_LIGHT },
+   { "medium",		FONTATT_WEIGHT	| FONTFLAG_MEDIUM },
+   { "mono",		FONTATT_SPACING	| FONTFLAG_MONO },
+   { "narrow",		FONTATT_WIDTH	| FONTFLAG_NARROW },
+   { "normal",		FONTATT_WIDTH	| FONTFLAG_NORMAL },
+   { "oblique",		FONTATT_SLANT	| FONTFLAG_OBLIQUE },
+   { "proportional",	FONTATT_SPACING	| FONTFLAG_PROPORTIONAL },
+   { "roman",		FONTATT_SLANT	| FONTFLAG_ROMAN },
+   { "sans",		FONTATT_SERIF	| FONTFLAG_SANS },
+   { "serif",		FONTATT_SERIF	| FONTFLAG_SERIF },
+   { "wide",		FONTATT_WIDTH	| FONTFLAG_WIDE },
+};
+
+/*
+ * parsefont - extract font family name, style attributes, and size
+ *
+ * these are window system independent values, so they require
+ *  further translation into window system dependent values.
+ *
+ * returns 1 on an OK font name
+ * returns 0 on a "malformed" font (might be a window-system fontname)
+ */
+int parsefont(s, family, style, size)
+char *s;
+char family[MAXFONTWORD+1];
+int *style;
+int *size;
+   {
+   char c, *a, attr[MAXFONTWORD+1];
+   int tmp;
+
+   /*
+    * set up the defaults
+    */
+   *family = '\0';
+   *style = 0;
+   *size = -1;
+
+   /*
+    * now, scan through the raw and break out pieces
+    */
+   for (;;) {
+
+      /*
+       * find start of next comma-separated attribute word
+       */
+      while (isspace(*s) || *s == ',')	/* trim leading spaces & empty words */
+         s++;
+      if (*s == '\0')			/* stop at end of string */
+         break;
+
+      /*
+       * copy word, converting to lower case to implement case insensitivity
+       */
+      for (a = attr; (c = *s) != '\0' && c != ','; s++) {
+         if (isupper(c))
+            c = tolower(c);
+         *a++ = c;
+         if (a - attr >= MAXFONTWORD)
+            return 0;			/* too long */
+         }
+
+      /*
+       * trim trailing spaces and terminate word
+       */
+      while (isspace(a[-1]))
+         a--;
+      *a = '\0';
+
+      /*
+       * interpret word as family name, size, or style characteristic
+       */
+      if (*family == '\0')
+         strcpy(family, attr);		/* first word is the family name */
+
+      else if (sscanf(attr, "%d%c", &tmp, &c) == 1 && tmp > 0) {
+         if (*size != -1 && *size != tmp)
+            return 0;			/* if conflicting sizes given */
+         *size = tmp;			/* integer value is a size */
+         }
+
+      else {				/* otherwise it's a style attribute */
+         tmp = si_s2i(fontwords, attr);	/* look up in table */
+         if (tmp != -1) {		/* if recognized */
+            if ((tmp & *style) != 0 && (tmp & *style) != tmp)
+               return 0;		/* conflicting attribute */
+            *style |= tmp;
+            }
+         }
+      }
+
+   /* got to end of string; it's OK if it had at least a font family */
+   return (*family != '\0');
+   }
+
+/*
+ * parsepattern() - parse an encoded numeric stipple pattern
+ */
+int parsepattern(s, len, width, nbits, bits)
+char *s;
+int len;
+int *width, *nbits;
+C_integer *bits;
+   {
+   C_integer v;
+   int i, j, hexdigits_per_row, maxbits = *nbits;
+
+   /*
+    * Get the width
+    */
+   if (sscanf(s, "%d,", width) != 1) return Error;
+   if (*width < 1) return Failed;
+
+   /*
+    * skip over width
+    */
+   while ((len > 0) && isdigit(*s)) {
+      len--; s++;
+      }
+   if ((len <= 1) || (*s != ',')) return Error;
+   len--; s++;					/* skip over ',' */
+
+   if (*s == '#') {
+      /*
+       * get remaining bits as hex constant
+       */
+      s++; len--;
+      if (len == 0) return Error;
+      hexdigits_per_row = *width / 4;
+      if (*width % 4) hexdigits_per_row++;
+      *nbits = len / hexdigits_per_row;
+      if (len % hexdigits_per_row) (*nbits)++;
+      if (*nbits > maxbits) return Failed;
+      for (i = 0; i < *nbits; i++) {
+         v = 0;
+	 for (j = 0; j < hexdigits_per_row; j++, len--, s++) {
+	    if (len == 0) break;
+	    v <<= 4;
+	    if (isdigit(*s)) v += *s - '0';
+	    else switch (*s) {
+	    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+	       v += *s - 'a' + 10; break;
+	    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+	       v += *s - 'A' + 10; break;
+	    default: return Error;
+	       }
+	    }
+	 *bits++ = v;
+	 }
+      }
+   else {
+      if (*width > 32) return Failed;
+      /*
+       * get remaining bits as comma-separated decimals
+       */
+      v = 0;
+      *nbits = 0;
+      while (len > 0) {
+	 while ((len > 0) && isdigit(*s)) {
+	    v = v * 10 + *s - '0';
+	    len--; s++;
+	    }
+	 (*nbits)++;
+	 if (*nbits > maxbits) return Failed;
+	 *bits++ = v;
+	 v = 0;
+
+	 if (len > 0) {
+	    if (*s == ',') { len--; s++; }
+	    else {
+	       ReturnErrNum(205, Error);
+	       }
+	    }
+	 }
+      }
+   return Succeeded;
+   }
+
+/*
+ * parsegeometry - parse a string of the form: intxint[+-]int[+-]int
+ * Returns:
+ *  0 on bad value, 1 if size is set, 2 if position is set, 3 if both are set
+ */
+int parsegeometry(buf, x, y, width, height)
+char *buf;
+SHORT *x, *y, *width, *height;
+   {
+   int retval = 0;
+   if (isdigit(*buf)) {
+      retval++;
+      if ((*width = atoi(buf)) <= 0) return 0;
+      while (isdigit(*++buf));
+      if (*buf++ != 'x') return 0;
+      if ((*height = atoi(buf)) <= 0) return 0;
+      while (isdigit(*++buf));
+      }
+
+   if (*buf == '+' || *buf == '-') {
+      retval += 2;
+      *x = atoi(buf);
+      buf++; /* skip over +/- */
+      while (isdigit(*buf)) buf++;
+
+      if (*buf != '+' && *buf != '-') return 0;
+      *y = atoi(buf);
+      buf++; /* skip over +/- */
+      while (isdigit(*buf)) buf++;
+      if (*buf) return 0;
+      }
+   return retval;
+   }
+
+
+/* return failure if operation returns either failure or error */
+#define AttemptAttr(operation) if ((operation) != Succeeded) return Failed;
+
+/* does string (already checked for "on" or "off") say "on"? */
+#define ATOBOOL(s) (s[1]=='n')
+
+/*
+ * Attribute manipulation
+ *
+ * wattrib() - get/set a single attribute in a window, return the result attr
+ *  string.
+ */
+int wattrib(w, s, len, answer, abuf)
+wbp w;
+char *s;
+long len;
+dptr answer;
+char * abuf;
+   {
+   char val[128], *valptr;
+   struct descrip d;
+   char *mid, *midend, c;
+   int r, a;
+   C_integer tmp;
+   long lenattr, lenval;
+   double gamma;
+   SHORT new_height, new_width;
+   wsp ws = w->window;
+   wcp wc = w->context;
+
+   valptr = val;
+   /*
+    * catch up on any events pending - mainly to update pointerx, pointery
+    */
+   if (pollevent() == -1)
+      fatalerr(141,NULL);
+
+   midend = s + len;
+   for (mid = s; mid < midend; mid++)
+      if (*mid == '=') break;
+
+   if (mid < midend) {
+      /*
+       * set an attribute
+       */
+      lenattr = mid - s;
+      lenval  = len - lenattr - 1;
+      mid++;
+
+      strncpy(abuf, s, lenattr);
+      abuf[lenattr] = '\0';
+      strncpy(val, mid, lenval);
+      val[lenval] = '\0';
+      StrLen(d) = strlen(val);
+      StrLoc(d) = val;
+
+      switch (a = si_s2i(attribs, abuf)) {
+      case A_LINES: case A_ROWS: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 if ((new_height = tmp) < 1)
+	    return Failed;
+	 new_height = ROWTOY(w, new_height);
+	 new_height += MAXDESCENDER(w);
+	 if (setheight(w, new_height) == Failed) return Failed;
+	 break;
+         }
+      case A_COLUMNS: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 if ((new_width = tmp) < 1)
+	    return Failed;
+	 new_width = COLTOX(w, new_width + 1);
+	 if (setwidth(w, new_width) == Failed) return Failed;
+	 break;
+         }
+      case A_HEIGHT: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+         if ((new_height = tmp) < 1) return Failed;
+	 if (setheight(w, new_height) == Failed) return Failed;
+	 break;
+         }
+      case A_WIDTH: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+         if ((new_width = tmp) < 1) return Failed;
+	 if (setwidth(w, new_width) == Failed) return Failed;
+	 break;
+         }
+      case A_SIZE: {
+	 AttemptAttr(setsize(w, val));
+	 break;
+	 }
+      case A_GEOMETRY: {
+	 AttemptAttr(setgeometry(w, val));
+	 break;
+         }
+      case A_RESIZE: {
+	 if (strcmp(val, "on") & strcmp(val, "off"))
+	    return Failed;
+         allowresize(w, ATOBOOL(val));
+	 break;
+         }
+      case A_ROW: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->y = ROWTOY(w, tmp) + wc->dy;
+	 break;
+	 }
+      case A_COL: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->x = COLTOX(w, tmp) + wc->dx;
+	 break;
+	 }
+      case A_CANVAS: {
+	 AttemptAttr(setcanvas(w,val));
+	 break;
+	 }
+      case A_ICONIC: {
+	 AttemptAttr(seticonicstate(w,val));
+	 break;
+	 }
+      case A_ICONIMAGE: {
+	 if (!val[0]) return Failed;
+	 AttemptAttr(seticonimage(w, &d));
+         break;
+	 }
+      case A_ICONLABEL: {
+	 AttemptAttr(seticonlabel(w, val));
+	 break;
+	 }
+      case A_ICONPOS: {
+	 AttemptAttr(seticonpos(w,val));
+	 break;
+	 }
+      case A_LABEL:
+      case A_WINDOWLABEL: {
+	 AttemptAttr(setwindowlabel(w, val));
+	 break;
+         }
+      case A_CURSOR: {
+	 int on_off;
+	 if (strcmp(val, "on") & strcmp(val, "off"))
+	    return Failed;
+	 on_off = ATOBOOL(val);
+         setcursor(w, on_off);
+	 break;
+         }
+      case A_FONT: {
+	 AttemptAttr(setfont(w, &valptr));
+	 break;
+         }
+      case A_PATTERN: {
+	 AttemptAttr(SetPattern(w, val, strlen(val)));
+         break;
+	 }
+      case A_POS: {
+	 AttemptAttr(setpos(w, val));
+	 break;
+	 }
+      case A_POSX: {
+	 char tmp[20];
+	 sprintf(tmp,"%s,%d",val,ws->posy);
+	 AttemptAttr(setpos(w, tmp));
+	 break;
+	 }
+      case A_POSY: {
+	 char tmp[20];
+	 sprintf(tmp,"%d,%s",ws->posx,val);
+	 AttemptAttr(setpos(w, tmp));
+         break;
+	 }
+      case A_FG: {
+	 if (cnv:C_integer(d, tmp) && tmp < 0) {
+	    if (isetfg(w, tmp) != Succeeded) return Failed;
+	    }
+	 else {
+	    if (setfg(w, val) != Succeeded) return Failed;
+	    }
+	 break;
+         }
+      case A_BG: {
+	 if (cnv:C_integer(d, tmp) && tmp < 0) {
+	    if (isetbg(w, tmp) != Succeeded) return Failed;
+	    }
+	 else {
+	    if (setbg(w, val) != Succeeded) return Failed;
+	    }
+	 break;
+         }
+      case A_GAMMA: {
+         if (sscanf(val, "%lf%c", &gamma, &c) != 1 || gamma <= 0.0)
+            return Failed;
+         if (setgamma(w, gamma) != Succeeded)
+            return Failed;
+         break;
+         }
+      case A_FILLSTYLE: {
+	 AttemptAttr(setfillstyle(w, val));
+	 break;
+	 }
+      case A_LINESTYLE: {
+	 AttemptAttr(setlinestyle(w, val));
+	 break;
+	 }
+      case A_LINEWIDTH: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 if (setlinewidth(w, tmp) == Error)
+	    return Failed;
+	 break;
+	 }
+      case A_POINTER: {
+	 AttemptAttr(setpointer(w, val));
+	 break;
+         }
+      case A_DRAWOP: {
+	 AttemptAttr(setdrawop(w, val));
+	 break;
+         }
+      case A_DISPLAY: {
+	 AttemptAttr(setdisplay(w,val));
+	 break;
+         }
+      case A_X: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->x = tmp + wc->dx;
+         UpdateCursorPos(ws, wc);	/* tell system where to blink it */
+	 break;
+	 }
+      case A_Y: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->y = tmp + wc->dy;
+         UpdateCursorPos(ws, wc);	/* tell system where to blink it */
+	 break;
+	 }
+      case A_DX: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 wc->dx = tmp;
+         UpdateCursorPos(ws, wc);	/* tell system where to blink it */
+	 break;
+	 }
+      case A_DY: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 wc->dy = tmp;
+         UpdateCursorPos(ws, wc);	/* tell system where to blink it */
+	 break;
+	 }
+      case A_LEADING: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 setleading(w, tmp);
+         break;
+         }
+      case A_IMAGE: {
+         /* first try GIF; then try platform-dependent format */
+         r = readGIF(val, 0, &ws->initimage);
+         if (r == Succeeded) {
+            setwidth(w, ws->initimage.width);
+            setheight(w, ws->initimage.height);
+            }
+         else
+            r = setimage(w, val);
+	 AttemptAttr(r);
+         break;
+         }
+      case A_ECHO: {
+	 if (strcmp(val, "on") & strcmp(val, "off"))
+	    return Failed;
+	 if (ATOBOOL(val)) SETECHOON(w);
+	 else CLRECHOON(w);
+	 break;
+         }
+      case A_CLIPX:
+      case A_CLIPY:
+      case A_CLIPW:
+      case A_CLIPH: {
+	 if (!*val) {
+	    wc->clipx = wc->clipy = 0;
+	    wc->clipw = wc->cliph = -1;
+	    unsetclip(w);
+	    }
+	 else {
+	    if (!cnv:C_integer(d, tmp))
+	       return Failed;
+	    if (wc->clipw < 0) {
+	       wc->clipx = wc->clipy = 0;
+	       wc->clipw = ws->width;
+	       wc->cliph = ws->height;
+	       }
+	    switch (a) {
+	       case A_CLIPX:  wc->clipx = tmp;  break;
+	       case A_CLIPY:  wc->clipy = tmp;  break;
+	       case A_CLIPW:  wc->clipw = tmp;  break;
+	       case A_CLIPH:  wc->cliph = tmp;  break;
+	       }
+	    setclip(w);
+	    }
+	 break;
+	 }
+      case A_REVERSE: {
+	 if (strcmp(val, "on") && strcmp(val, "off"))
+	    return Failed;
+	 if ((!ATOBOOL(val) && ISREVERSE(w)) ||
+	     (ATOBOOL(val) && !ISREVERSE(w))) {
+	    toggle_fgbg(w);
+	    ISREVERSE(w) ? CLRREVERSE(w) : SETREVERSE(w);
+	    }
+	 break;
+         }
+      case A_POINTERX: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->pointerx = tmp + wc->dx;
+	 warpPointer(w, ws->pointerx, ws->pointery);
+	 break;
+	 }
+      case A_POINTERY: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->pointery = tmp + wc->dy;
+	 warpPointer(w, ws->pointerx, ws->pointery);
+	 break;
+	 }
+      case A_POINTERCOL: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->pointerx = COLTOX(w, tmp) + wc->dx;
+	 warpPointer(w, ws->pointerx, ws->pointery);
+	 break;
+	 }
+      case A_POINTERROW: {
+	 if (!cnv:C_integer(d, tmp))
+	    return Failed;
+	 ws->pointery = ROWTOY(w, tmp) + wc->dy;
+	 warpPointer(w, ws->pointerx, ws->pointery);
+	 break;
+	 }
+      /*
+       * remaining valid attributes are error #147
+       */
+      case A_DEPTH:
+      case A_DISPLAYHEIGHT:
+      case A_DISPLAYWIDTH:
+      case A_FHEIGHT:
+      case A_FWIDTH:
+      case A_ASCENT:
+      case A_DESCENT:
+         ReturnErrNum(147, Error);
+      /*
+       * invalid attribute
+       */
+      default:
+	 ReturnErrNum(145, Error);
+	 }
+      strncpy(abuf, s, len);
+      abuf[len] = '\0';
+      }
+   else {
+      int a;
+      /*
+       * get an attribute
+       */
+      strncpy(abuf, s, len);
+      abuf[len] = '\0';
+      switch (a=si_s2i(attribs, abuf)) {
+      case A_IMAGE:
+         ReturnErrNum(147, Error);
+      case A_VISUAL:
+	 if (getvisual(w, abuf) == Failed) return Failed;
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_DEPTH:
+	 MakeInt(SCREENDEPTH(w), answer);
+	 break;
+      case A_DISPLAY:
+	 getdisplay(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ASCENT:
+	 MakeInt(ASCENT(w), answer);
+	 break;
+      case A_DESCENT:
+	 MakeInt(DESCENT(w), answer);
+	 break;
+      case A_FHEIGHT:
+	 MakeInt(FHEIGHT(w), answer);
+	 break;
+      case A_FWIDTH:
+	 MakeInt(FWIDTH(w), answer);
+	 break;
+      case A_ROW:
+	 MakeInt(YTOROW(w, ws->y - wc->dy), answer);
+	 break;
+      case A_COL:
+	 MakeInt(1 + XTOCOL(w, ws->x - wc->dx), answer);
+	 break;
+      case A_POINTERROW: {
+	 XPoint xp;
+	 query_pointer(w, &xp);
+	 MakeInt(YTOROW(w, xp.y - wc->dy), answer);
+	 break;
+	 }
+      case A_POINTERCOL: {
+	 XPoint xp;
+	 query_pointer(w, &xp);
+	 MakeInt(1 + XTOCOL(w, xp.x - wc->dx), answer);
+	 break;
+	 }
+      case A_LINES:
+      case A_ROWS:
+	 MakeInt(YTOROW(w,ws->height - DESCENT(w)), answer);
+	 break;
+      case A_COLUMNS:
+	 MakeInt(XTOCOL(w,ws->width), answer);
+	 break;
+      case A_POS: case A_POSX: case A_POSY:
+	 if (getpos(w) == Failed)
+	    return Failed;
+	 switch (a) {
+	 case A_POS:
+	    sprintf(abuf, "%d,%d", ws->posx, ws->posy);
+	    MakeStr(abuf, strlen(abuf), answer);
+	    break;
+	 case A_POSX:
+	    MakeInt(ws->posx, answer);
+	    break;
+	 case A_POSY:
+	    MakeInt(ws->posy, answer);
+	    break;
+	    }
+	 break;
+      case A_FG:
+	 getfg(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_BG:
+	 getbg(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+         break;
+      case A_GAMMA:
+         Protect(BlkLoc(*answer) = (union block *)alcreal(wc->gamma),
+            return Error);
+         answer->dword = D_Real;
+         break;
+      case A_FILLSTYLE:
+         sprintf(abuf, "%s",
+            (wc->fillstyle == FS_SOLID) ? "solid" :
+            (wc->fillstyle == FS_STIPPLE) ? "masked" : "textured");
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_LINESTYLE:
+	 getlinestyle(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_LINEWIDTH:
+	 MakeInt(LINEWIDTH(w), answer);
+	 break;
+      case A_HEIGHT: { MakeInt(ws->height, answer); break; }
+      case A_WIDTH: { MakeInt(ws->width, answer); break; }
+      case A_SIZE:
+	 sprintf(abuf, "%d,%d", ws->width, ws->height);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_RESIZE:
+	 sprintf(abuf,"%s",(ISRESIZABLE(w)?"on":"off"));
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_DISPLAYHEIGHT:
+	 MakeInt(DISPLAYHEIGHT(w), answer);
+	 break;
+      case A_DISPLAYWIDTH:
+	 MakeInt(DISPLAYWIDTH(w), answer);
+	 break;
+      case A_CURSOR:
+	 sprintf(abuf,"%s",(ISCURSORON(w)?"on":"off"));
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ECHO:
+	 sprintf(abuf,"%s",(ISECHOON(w)?"on":"off"));
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_REVERSE:
+	 sprintf(abuf,"%s",(ISREVERSE(w)?"on":"off"));
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_FONT:
+	 getfntnam(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_X:  MakeInt(ws->x - wc->dx, answer); break;
+      case A_Y:  MakeInt(ws->y - wc->dy, answer); break;
+      case A_DX: MakeInt(wc->dx, answer); break;
+      case A_DY: MakeInt(wc->dy, answer); break;
+      case A_LEADING: MakeInt(LEADING(w), answer); break;
+      case A_POINTERX: {
+	 XPoint xp;
+	 query_pointer(w, &xp);
+	 MakeInt(xp.x - wc->dx, answer);
+	 break;
+	 }
+      case A_POINTERY: {
+	 XPoint xp;
+	 query_pointer(w, &xp);
+	 MakeInt(xp.y - wc->dy, answer);
+	 break;
+	 }
+      case A_POINTER:
+	 getpointername(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_DRAWOP:
+	 getdrawop(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_GEOMETRY:
+	 if (getpos(w) == Failed) return Failed;
+         if (ws->win)
+           sprintf(abuf, "%dx%d+%d+%d",
+		   ws->width, ws->height, ws->posx, ws->posy);
+         else
+           sprintf(abuf, "%dx%d", ws->pixwidth, ws->pixheight);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_CANVAS:
+	 getcanvas(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ICONIC:
+	 geticonic(w, abuf);
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ICONIMAGE:
+	 if (ICONFILENAME(w) != NULL)
+	    sprintf(abuf, "%s", ICONFILENAME(w));
+	 else *abuf = '\0';
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ICONLABEL:
+	 if (ICONLABEL(w) != NULL)
+	    sprintf(abuf, "%s", ICONLABEL(w));
+	 else return Failed;
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_LABEL:
+      case A_WINDOWLABEL:
+	 if (WINDOWLABEL(w) != NULL)
+	    sprintf(abuf,"%s", WINDOWLABEL(w));
+	 else return Failed;
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+      case A_ICONPOS: {
+	 switch (geticonpos(w,abuf)) {
+	    case Failed: return Failed;
+	    case Error:  return Failed;
+	    }
+	 MakeStr(abuf, strlen(abuf), answer);
+	 break;
+	 }
+      case A_PATTERN: {
+	 s = w->context->patternname;
+	 if (s != NULL)
+	    MakeStr(s, strlen(s), answer);
+	 else
+	    MakeStr("black", 5, answer);
+	 break;
+	 }
+      case A_CLIPX:
+	 if (wc->clipw >= 0)
+	    MakeInt(wc->clipx, answer);
+	 else
+	    *answer = nulldesc;
+	 break;
+      case A_CLIPY:
+	 if (wc->clipw >= 0)
+	    MakeInt(wc->clipy, answer);
+	 else
+	    *answer = nulldesc;
+	 break;
+      case A_CLIPW:
+	 if (wc->clipw >= 0)
+	    MakeInt(wc->clipw, answer);
+	 else
+	    *answer = nulldesc;
+	 break;
+      case A_CLIPH:
+	 if (wc->clipw >= 0)
+	    MakeInt(wc->cliph, answer);
+	 else
+	    *answer = nulldesc;
+	 break;
+      default:
+	 ReturnErrNum(145, Error);
+	 }
+   }
+   wflush(w);
+   return Succeeded;
+   }
+
+/*
+ * rectargs -- interpret rectangle arguments uniformly
+ *
+ *  Given an arglist and the index of the next x value, rectargs sets
+ *  x/y/width/height to explicit or defaulted values.  These result values
+ *  are in canonical form:  Width and height are nonnegative and x and y
+ *  have been corrected by dx and dy.
+ *
+ *  Returns index of bad argument, if any, or -1 for success.
+ */
+int rectargs(w, argc, argv, i, px, py, pw, ph)
+wbp w;
+int argc;
+dptr argv;
+int i;
+C_integer *px, *py, *pw, *ph;
+   {
+   int defw, defh;
+   wcp wc = w->context;
+   wsp ws = w->window;
+
+   /*
+    * Get x and y, defaulting to -dx and -dy.
+    */
+   if (i >= argc)
+      *px = -wc->dx;
+   else if (!def:C_integer(argv[i], -wc->dx, *px))
+      return i;
+
+   if (++i >= argc)
+      *py = -wc->dy;
+   else if (!def:C_integer(argv[i], -wc->dy, *py))
+      return i;
+
+   *px += wc->dx;
+   *py += wc->dy;
+
+   /*
+    * Get w and h, defaulting to extend to the edge
+    */
+   defw = ws->width - *px;
+   defh = ws->height - *py;
+
+   if (++i >= argc)
+      *pw = defw;
+   else if (!def:C_integer(argv[i], defw, *pw))
+      return i;
+
+   if (++i >= argc)
+      *ph = defh;
+   else if (!def:C_integer(argv[i], defh, *ph))
+      return i;
+
+   /*
+    * Correct negative w/h values.
+    */
+   if (*pw < 0)
+      *px -= (*pw = -*pw);
+   if (*ph < 0)
+      *py -= (*ph = -*ph);
+
+   return -1;
+   }
+
+/*
+ * docircles -- draw or file circles.
+ *
+ *  Helper for DrawCircle and FillCircle.
+ *  Returns index of bad argument, or -1 for success.
+ */
+int docircles(w, argc, argv, fill)
+wbp w;
+int argc;
+dptr argv;
+int fill;
+   {
+   XArc arc;
+   int i, dx, dy;
+   double x, y, r, theta, alpha;
+
+   dx = w->context->dx;
+   dy = w->context->dy;
+
+   for (i = 0; i < argc; i += 5) {	/* for each set of five args */
+
+      /*
+       * Collect arguments.
+       */
+      if (i + 2 >= argc)
+         return i + 2;			/* missing y or r */
+      if (!cnv:C_double(argv[i], x))
+         return i;
+      if (!cnv:C_double(argv[i + 1], y))
+         return i + 1;
+      if (!cnv:C_double(argv[i + 2], r))
+         return i + 2;
+      if (i + 3 >= argc)
+         theta = 0.0;
+      else if (!def:C_double(argv[i + 3], 0.0, theta))
+         return i + 3;
+      if (i + 4 >= argc)
+         alpha = 2 * Pi;
+      else if (!def:C_double(argv[i + 4], 2 * Pi, alpha))
+         return i + 4;
+
+      /*
+       * Put in canonical form: r >= 0, -2*pi <= theta < 0, alpha >= 0.
+       */
+      if (r < 0) {			/* ensure positive radius */
+         r = -r;
+         theta += Pi;
+         }
+      if (alpha < 0) {			/* ensure positive extent */
+         theta += alpha;
+         alpha = -alpha;
+         }
+
+      theta = fmod(theta, 2 * Pi);
+      if (theta > 0)			/* normalize initial angle */
+         theta -= 2 * Pi;
+
+      /*
+       * Build the Arc descriptor.
+       */
+      arc.x = x + dx - r;
+      arc.y = y + dy - r;
+      ARCWIDTH(arc) = 2 * r;
+      ARCHEIGHT(arc) = 2 * r;
+
+      arc.angle1 = ANGLE(theta);
+      if (alpha >= 2 * Pi)
+         arc.angle2 = EXTENT(2 * Pi);
+      else
+         arc.angle2 = EXTENT(alpha);
+
+      /*
+       * Draw or fill the arc.
+       */
+      if (fill) {			/* {} required due to form of macros */
+         fillarcs(w, &arc, 1);
+         }
+      else {
+         drawarcs(w, &arc, 1);
+         }
+      }
+   return -1;
+   }
+
+
+/*
+ * genCurve - draw a smooth curve through a set of points.  Algorithm from
+ *  Barry, Phillip J., and Goldman, Ronald N. (1988).
+ *  A Recursive Evaluation Algorithm for a class of Catmull-Rom Splines.
+ *  Computer Graphics 22(4), 199-204.
+ */
+void genCurve(w, p, n, helper)
+wbp w;
+XPoint *p;
+int n;
+void (*helper)	(wbp, XPoint [], int);
+   {
+   int    i, j, steps;
+   float  ax, ay, bx, by, stepsize, stepsize2, stepsize3;
+   float  x, dx, d2x, d3x, y, dy, d2y, d3y;
+   XPoint *thepoints = NULL;
+   long npoints = 0;
+
+   for (i = 3; i < n; i++) {
+      /*
+       * build the coefficients ax, ay, bx and by, using:
+       *                             _              _   _    _
+       *   i                 i    1 | -1   3  -3   1 | | Pi-3 |
+       *  Q (t) = T * M   * G   = - |  2  -5   4  -1 | | Pi-2 |
+       *               CR    Bs   2 | -1   0   1   0 | | Pi-1 |
+       *                            |_ 0   2   0   0_| |_Pi  _|
+       */
+
+      ax = p[i].x - 3 * p[i-1].x + 3 * p[i-2].x - p[i-3].x;
+      ay = p[i].y - 3 * p[i-1].y + 3 * p[i-2].y - p[i-3].y;
+      bx = 2 * p[i-3].x - 5 * p[i-2].x + 4 * p[i-1].x - p[i].x;
+      by = 2 * p[i-3].y - 5 * p[i-2].y + 4 * p[i-1].y - p[i].y;
+
+      /*
+       * calculate the forward differences for the function using
+       * intervals of size 0.1
+       */
+#ifndef abs
+#define abs(x) ((x)<0?-(x):(x))
+#endif
+#ifndef max
+#define max(x,y) ((x>y)?x:y)
+#endif
+
+      steps = max(abs(p[i-1].x - p[i-2].x), abs(p[i-1].y - p[i-2].y)) + 10;
+      if (steps+4 > npoints) {
+         if (thepoints != NULL) free(thepoints);
+	 thepoints = malloc((steps+4) * sizeof(XPoint));
+	 npoints = steps+4;
+         }
+
+      stepsize = 1.0/steps;
+      stepsize2 = stepsize * stepsize;
+      stepsize3 = stepsize * stepsize2;
+
+      x = thepoints[0].x = p[i-2].x;
+      y = thepoints[0].y = p[i-2].y;
+      dx = (stepsize3*0.5)*ax + (stepsize2*0.5)*bx + (stepsize*0.5)*(p[i-1].x-p[i-3].x);
+      dy = (stepsize3*0.5)*ay + (stepsize2*0.5)*by + (stepsize*0.5)*(p[i-1].y-p[i-3].y);
+      d2x = (stepsize3*3) * ax + stepsize2 * bx;
+      d2y = (stepsize3*3) * ay + stepsize2 * by;
+      d3x = (stepsize3*3) * ax;
+      d3y = (stepsize3*3) * ay;
+
+      /* calculate the points for drawing the curve */
+
+      for (j = 0; j < steps; j++) {
+	 x = x + dx;
+	 y = y + dy;
+	 dx = dx + d2x;
+	 dy = dy + d2y;
+	 d2x = d2x + d3x;
+	 d2y = d2y + d3y;
+         thepoints[j + 1].x = (int)x;
+         thepoints[j + 1].y = (int)y;
+         }
+      helper(w, thepoints, steps + 1);
+      }
+   if (thepoints != NULL) {
+      free(thepoints);
+      thepoints = NULL;
+      }
+   }
+
+static void curveHelper(wbp w, XPoint *thepoints, int n)
+   {
+   /*
+    * Could use drawpoints(w, thepoints, n)
+    *  but that ignores the linewidth and linestyle attributes...
+    * Might make linestyle work a little better by "compressing" straight
+    *  sections produced by genCurve into single drawline points.
+    */
+   drawlines(w, thepoints, n);
+   }
+
+/*
+ * draw a smooth curve through the array of points
+ */
+void drawCurve(w, p, n)
+wbp w;
+XPoint *p;
+int n;
+   {
+   genCurve(w, p, n, curveHelper);
+   }
+
+/*
+ * Compare two unsigned long values for qsort or qsearch.
+ */
+int ulcmp(p1, p2)
+pointer p1, p2;
+   {
+   register unsigned long u1 = *(unsigned int *)p1;
+   register unsigned long u2 = *(unsigned int *)p2;
+
+   if (u1 < u2)
+      return -1;
+   else
+      return (u1 > u2);
+   }
+
+/*
+ * the next section consists of code to deal with string-integer
+ * (stringint) symbols.  See graphics.h.
+ */
+
+/*
+ * string-integer comparison, for qsearch()
+ */
+static int sicmp(sip1,sip2)
+siptr sip1, sip2;
+{
+  return strcmp(sip1->s, sip2->s);
+}
+
+/*
+ * string-integer lookup function: given a string, return its integer
+ */
+int si_s2i(sip,s)
+siptr sip;
+char *s;
+{
+  stringint key;
+  siptr p;
+  key.s = s;
+
+  p = (siptr)qsearch((char *)&key,(char *)(sip+1),sip[0].i,sizeof(key),sicmp);
+  if (p) return p->i;
+  return -1;
+}
+
+/*
+ * string-integer inverse function: given an integer, return its string
+ */
+char *si_i2s(sip,i)
+siptr sip;
+int i;
+{
+  register siptr sip2 = sip+1;
+  for(;sip2<=sip+sip[0].i;sip2++) if (sip2->i == i) return sip2->s;
+  return NULL;
+}
+
+
+/*
+ * And now, the stringint data.
+ * Convention: the 0'th element of a stringint array contains the
+ * NULL string, and an integer count of the # of elements in the array.
+ */
+
+stringint attribs[] = {
+   { 0,			NUMATTRIBS},
+   {"ascent",		A_ASCENT},
+   {"bg",		A_BG},
+   {"canvas",		A_CANVAS},
+   {"ceol",		A_CEOL},
+   {"cliph",		A_CLIPH},
+   {"clipw",		A_CLIPW},
+   {"clipx",		A_CLIPX},
+   {"clipy",		A_CLIPY},
+   {"col",		A_COL},
+   {"columns",		A_COLUMNS},
+   {"cursor",		A_CURSOR},
+   {"depth",		A_DEPTH},
+   {"descent",		A_DESCENT},
+   {"display",		A_DISPLAY},
+   {"displayheight",	A_DISPLAYHEIGHT},
+   {"displaywidth",	A_DISPLAYWIDTH},
+   {"drawop",		A_DRAWOP},
+   {"dx",		A_DX},
+   {"dy",		A_DY},
+   {"echo",		A_ECHO},
+   {"fg",		A_FG},
+   {"fheight",		A_FHEIGHT},
+   {"fillstyle",	A_FILLSTYLE},
+   {"font",		A_FONT},
+   {"fwidth",		A_FWIDTH},
+   {"gamma",		A_GAMMA},
+   {"geometry",		A_GEOMETRY},
+   {"height",		A_HEIGHT},
+   {"iconic",		A_ICONIC},
+   {"iconimage",	A_ICONIMAGE},
+   {"iconlabel",	A_ICONLABEL},
+   {"iconpos",		A_ICONPOS},
+   {"image",		A_IMAGE},
+   {"label",		A_LABEL},
+   {"leading",		A_LEADING},
+   {"lines",		A_LINES},
+   {"linestyle",	A_LINESTYLE},
+   {"linewidth",	A_LINEWIDTH},
+   {"pattern",		A_PATTERN},
+   {"pointer",		A_POINTER},
+   {"pointercol",	A_POINTERCOL},
+   {"pointerrow",	A_POINTERROW},
+   {"pointerx",		A_POINTERX},
+   {"pointery",		A_POINTERY},
+   {"pos",		A_POS},
+   {"posx",		A_POSX},
+   {"posy",		A_POSY},
+   {"resize",		A_RESIZE},
+   {"reverse",		A_REVERSE},
+   {"row",		A_ROW},
+   {"rows",		A_ROWS},
+   {"size",		A_SIZE},
+   {"visual",		A_VISUAL},
+   {"width",		A_WIDTH},
+   {"windowlabel",	A_WINDOWLABEL},
+   {"x",		A_X},
+   {"y",		A_Y},
+};
+
+
+/*
+ * There are more, X-specific stringint arrays in ../common/xwindow.c
+ */
+
+#endif					/* Graphics */
diff --git a/src/runtime/rwinrsc.r b/src/runtime/rwinrsc.r
new file mode 100644
index 0000000..a9091be
--- /dev/null
+++ b/src/runtime/rwinrsc.r
@@ -0,0 +1,49 @@
+/*
+ * File: rwinrsc.r
+ *  Icon graphics interface resources
+ *
+ * Resources are allocated through a layer of internal management
+ * routines in order to handle aliasing and resource sharing.
+ */
+#ifdef Graphics
+
+/*
+ * global variables.
+ */
+
+wcp wcntxts = NULL;
+wsp wstates = NULL;
+wbp wbndngs = NULL;
+int win_highwater = -1;
+
+#ifdef XWindows
+#include "rxrsc.ri"
+#endif					/* XWindows */
+
+/*
+ * allocate a window binding structure
+ */
+wbp alc_wbinding()
+   {
+   wbp w;
+
+   GRFX_ALLOC(w, _wbinding);
+   GRFX_LINK(w, wbndngs);
+   return w;
+   }
+
+/*
+ * free a window binding.
+ */
+void free_binding(w)
+wbp w;
+   {
+   w->refcount--;
+   if(w->refcount == 0) {
+      if (w->window) free_window(w->window);
+      if (w->context) free_context(w->context);
+      GRFX_UNLINK(w, wbndngs);
+      }
+   }
+
+#endif					/* Graphics */
diff --git a/src/runtime/rwinsys.r b/src/runtime/rwinsys.r
new file mode 100644
index 0000000..084607e
--- /dev/null
+++ b/src/runtime/rwinsys.r
@@ -0,0 +1,17 @@
+/*
+ * File: rwinsys.r
+ *  Window-system-specific window support routines.
+ *  This file simply includes an appropriate r*win.ri file.
+ */
+
+#ifdef Graphics
+
+   #ifdef XWindows
+      #include "rxwin.ri"
+   #endif				/* XWindows */
+
+   #ifdef WinGraphics
+      #include "rmswin.ri"
+   #endif				/* WinGraphics */
+
+#endif					/* Graphics */
diff --git a/src/runtime/rxrsc.ri b/src/runtime/rxrsc.ri
new file mode 100644
index 0000000..c99edeb
--- /dev/null
+++ b/src/runtime/rxrsc.ri
@@ -0,0 +1,995 @@
+/*
+ * File: rxrsc.ri - X Window specific resource allocation/deallocation
+ *
+ * Resources are allocated through a layer of internal management
+ * routines in order to handle aliasing and resource sharing.
+ */
+
+static int rgbhash[5000];	/* rgb hash table */
+
+wdp wdsplys;
+
+wfp findfont(wbp w, char *fam, int size, int flags);
+int okfont(char *spec, int size, int flags);
+int fontcmp(char *font1, char *font2, int size, int flags);
+
+/* check for color match */
+#define CMATCH(cp, rr, gg, bb) \
+   ((cp)->r == (rr) && (cp)->g == (gg) && (cp->b) == (bb) && \
+   (cp)->type == SHARED && (cp)->refcount > 0)
+
+/*
+ * Allocate a color given linear r, g, b. Colors are shared on a
+ * per-display basis, but they are often freed on a per-window basis,
+ * so they are remembered in two structures.
+ */
+wclrp alc_rgb(w,s,r,g,b,is_iconcolor)
+wbp w;
+char *s;
+unsigned int r,g,b;
+int is_iconcolor;
+   {
+   wclrp cp;
+   LinearColor lc;
+   XColor color;
+   int h, i;
+   int *numColors;
+   short *theColors;
+   STDLOCALS(w);
+
+   /*
+    * handle black and white specially (no allocation)
+    */
+   if ((r == 0) && (g == 0) && (b == 0))
+      return wd->colrptrs[0];
+   if ((r == 65535) && (g == 65535) && (b == 65535))
+      return wd->colrptrs[1];
+
+   if (is_iconcolor) {
+      if (ws->iconColors == NULL) {
+	 ws->iconColors = (short *)calloc(WMAXCOLORS, sizeof(short));
+	 if (ws->iconColors == NULL) return NULL;
+	 }
+      numColors = &(ws->numiColors);
+      theColors = ws->iconColors;
+      }
+   else {
+      if (ws->theColors == NULL) {
+	 ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short));
+	 if (ws->theColors == NULL) return NULL;
+	 }
+      numColors = &(ws->numColors);
+      theColors = ws->theColors;
+      }
+
+   /*
+    * Change into server-dependent R G B
+    */
+   lc.red = r;
+   lc.green = g;
+   lc.blue = b;
+   color = xcolor(w, lc);
+   r = color.red;
+   g = color.green;
+   b = color.blue;
+   h = (503 * r + 509 * g + 499 * b) % ElemCount(rgbhash);
+
+   /*
+    * Search for the color in w's display
+    */
+   if (wd->visual->class == TrueColor) {
+      /*
+       * TrueColor entries are linked on hash chains.
+       */
+      i = rgbhash[h];
+      while (i != 0 && !CMATCH(wd->colrptrs[i],r,g,b))
+         i = wd->colrptrs[i]->next;
+      if (i == 0)
+         i = wd->numColors;		/* indicate not found */
+      }
+   else {
+      /*
+       * Search linearly through the list of colors.
+       */
+      for (i = 2; i < wd->numColors; i++)
+         if (CMATCH(wd->colrptrs[i],r,g,b))
+            break;
+      }
+
+   if (i >= wd->numColors) {
+      int j;
+      /*
+       * color not found, must allocate
+       */
+      if (!XAllocColor(stddpy, wd->cmap, &color)) {
+	 /* try again with a virtual colormap (but not for an icon) */
+	 if (is_iconcolor || !go_virtual(w) ||
+	     !XAllocColor(stddpy, wd->cmap, &color))
+            return NULL;
+         }
+
+      j = alc_centry(wd);
+      if (j == 0)
+         return NULL;
+      cp = wd->colrptrs[j];
+      cp->next = rgbhash[h];
+      rgbhash[h] = j;
+      strcpy(cp->name, s);
+      /*
+       * Store server color as requested in color table.
+       */
+      cp->r = r;
+      cp->g = g;
+      cp->b = b;
+      cp->c = color.pixel;
+      cp->type = SHARED;
+      /*
+       * Remember in window color list, too, if not TrueColor visual.
+       */
+      if (wd->visual->class != TrueColor && *numColors < WMAXCOLORS)
+         theColors[(*numColors)++] = j;
+      return cp;
+      }
+   else {
+      /* color is found, alias it and put it in the window color table */
+      int k;
+      for(k=0; k < *numColors; k++){
+         if (theColors[k] == i) {
+	    /* already there, no further action needed */
+	    return wd->colrptrs[i];
+            }
+         }
+      wd->colrptrs[i]->refcount++;
+      /*
+       * Remember in window color list, too, if not TrueColor visual.
+       */
+      if (wd->visual->class != TrueColor && *numColors < WMAXCOLORS)
+         theColors[(*numColors)++] = i;
+      return wd->colrptrs[i];
+      }
+   }
+
+/*
+ * allocate a color entry, return index
+ */
+int alc_centry(wd)
+wdp wd;
+{
+   int j;
+
+   if (wd->visual->class == TrueColor) {
+      /*
+       * TrueColor entries are never freed, so skip the search.
+       */
+      j = wd->numColors;
+      }
+   else {
+      /*
+       * Look for allocated but unused entry (beyond reserved entries 0 and 1)
+       */
+      for (j = 2; j < wd->numColors; j++) {
+         if (wd->colrptrs[j]->refcount == 0) {
+            wd->colrptrs[j]->refcount = 1;
+            return j;
+            }
+         }
+      } 
+
+   /*
+    * No unused entry found.  Make sure there's room for another pointer.
+    */
+   if (wd->numColors == wd->cpSize) {
+      j = 2 * wd->cpSize;			/* double the array size */
+      wd->colrptrs = realloc(wd->colrptrs, j * sizeof(struct wcolor *));
+      if (wd->colrptrs == NULL)
+         ReturnErrNum(305, 0);
+      wd->cpSize = j;
+      }
+   /*
+    * Now allocate a new entry.
+    */
+   j = wd->numColors;
+   wd->colrptrs[j] = calloc(1, sizeof(struct wcolor));
+   if (wd->colrptrs[j] == NULL)
+      ReturnErrNum(305, 0);
+   wd->colrptrs[j]->refcount = 1;
+   wd->numColors++;
+   return j;
+}
+
+/*
+ * allocate by named color and return Icon color pointer.
+ *  This is used by setfg and setbg.
+ */
+wclrp alc_color(w,s)
+wbp w;
+char *s;
+   {
+   wclrp rv;
+   long r, g, b;
+
+   /*
+    * convert color to an r,g,b triple
+    */
+   if (parsecolor(w, s, &r, &g, &b) != Succeeded)
+      return 0;
+
+   /*
+    * return Icon color structure, allocated & reference counted in display
+    */
+   Protect(rv = alc_rgb(w, s, r, g, b, 0), return 0);
+   return rv;
+   }
+
+/*
+ * copy color entries to reflect pixel transmission via CopyArea()
+ * (assumes w1 and w2 are on the same display)
+ */
+void copy_colors(w1, w2)
+wbp w1, w2;
+   {
+   wsp ws1 = w1->window, ws2 = w2 -> window;
+   wdp wd = ws1->display;
+   int i1, i2, j;
+
+   for (i1 = 0; i1 < ws1->numColors; i1++) {
+      j = ws1->theColors[i1];
+      if (wd->colrptrs[j]->refcount > 0 && wd->colrptrs[j]->type != MUTABLE) {
+	 for (i2 = 0; i2 < ws2->numColors; i2++) {
+	    if (j == ws2->theColors[i2])
+	       break;
+	    }
+	 if (i2 >= ws2->numColors) {
+	    /* need to add this color */
+	    wd->colrptrs[j]->refcount++;
+	    if (ws2->display->visual->class != TrueColor
+	    && ws2->numColors < WMAXCOLORS) {
+	       if (ws2->theColors == NULL)
+		  ws2->theColors = (short *)calloc(WMAXCOLORS, sizeof(short));
+	       if (ws2->theColors == NULL)
+		  break; /* unlikely bug; should fail or something */
+	       ws2->theColors[ws2->numColors++] = j;
+	       }
+	    /* else cannot record it -- table full, or unneeded for TrueColor */
+	    }
+	 }
+      }
+   }
+
+/*
+ * free a single color allocated by a given window
+ */
+void free_xcolor(w,c)
+wbp w;
+unsigned long c;
+   {
+   int i;
+   STDLOCALS(w);
+
+   for (i = 0; i < ws->numColors; i++) {
+      if (wd->colrptrs[ws->theColors[i]]->c == c) break;
+      }
+   if (i >= ws->numColors) {
+      /* "free_xcolor couldn't find the color in the window\n" */
+      /* (for TrueColor visuals, this is normal) */
+      }
+   else {
+      if (--(wd->colrptrs[ws->theColors[i]]->refcount) == 0) {
+	 XFreeColors(stddpy, wd->cmap, &c, 1, 0);
+	 ws->numColors--;
+	 if (ws->numColors != i)
+	    ws->theColors[i] = ws->theColors[ws->numColors];
+         }
+      }
+   }
+
+/*
+ * free the colors allocated by a given window.  extent indicates how much
+ * to free.  extent == 0 implies window colors except black, white,
+ * fg, bg, wbg, and mutable colors.  extent == 1 implies free icon colors.
+ * extent == 2 implies free window AND fg/bg/wbg (window is closed)
+ */
+void free_xcolors(w, extent)
+wbp w;
+int extent;
+   {
+   int i;
+   unsigned long toFree[WMAXCOLORS];
+   int freed = 0;
+   int *numColors;
+   int numSaved;
+   short *theColors;
+   STDLOCALS(w);
+
+   numColors = (extent==1 ? &(ws->numiColors) : &(ws->numColors));
+   theColors = (extent==1 ? ws->iconColors : ws->theColors);
+
+   numSaved = 0;
+   for (i = *numColors-1; i >= 0; i--) {
+      int j = theColors[i];
+
+      if (j < 2)		/* black & white are permanent residents */
+	 continue;
+      /*
+       * don't free fg, bg, or mutable color
+       */
+      if (((extent==0) && (wd->colrptrs[j] == w->context->fg)) ||
+	  ((extent==0) && (wd->colrptrs[j] == w->context->bg)) ||
+	  (wd->colrptrs[j]->type == MUTABLE)) {
+	     theColors[numSaved++] = j;
+	     continue;
+	     }
+
+#ifdef FreeColorFix
+      /*
+       * don't free ANY context's fg or bg
+       */
+      {
+      wcp wc; int numhits = 0;
+      for(wc=wcntxts; wc; wc=wc->next) {
+	 if ((wc->fg == wd->colrptrs[j]) ||
+	     (wc->bg == wd->colrptrs[j])) {
+	    if (numhits == 0)
+	       theColors[numSaved++] = j;
+	    numhits++;
+	    }
+	 }
+      if (numhits) {
+	 if (numhits > wd->colrptrs[j]->refcount)
+	    wd->colrptrs[j]->refcount = numhits;
+	 continue;
+	 }
+      }
+#endif					/* FreeColorFix */
+
+      if (--(wd->colrptrs[j]->refcount) == 0) {
+	 toFree[freed++] = wd->colrptrs[j]->c;
+         }
+      }
+   if (freed>0)
+      XFreeColors(stddpy, wd->cmap, toFree, freed,0);
+   *numColors = numSaved;
+   }
+
+/*
+ * Allocate a virtual colormap with all colors used by the client copied from
+ * the default colormap to new colormap, and set all windows to use this new
+ * colormap.  Returns 0 on failure.
+ */
+int go_virtual(w)
+wbp w;
+{
+   wsp win;
+   STDLOCALS(w);
+
+   if (wd->cmap != DefaultColormap(stddpy,wd->screen))
+      return 0;    /* already using a virtual colormap */
+
+   wd->cmap = XCopyColormapAndFree(stddpy,wd->cmap);
+
+   /* set the colormap for all the windows to the new colormap */
+
+   for (win = wstates; win; win = win->next)
+      if ((win->display->display == stddpy) & (win->win != (Window)NULL))
+         XSetWindowColormap(stddpy, win->win, wd->cmap);
+
+   return 1;
+}
+
+/*
+ * allocate a display on machine s
+ */
+wdp alc_display(s)
+char *s;
+   {
+   int i;
+   double g;
+   wdp wd;
+   XColor color;
+   wclrp cp;
+
+   if (s == NULL) s = getenv("DISPLAY");
+   if (s == NULL) s = "";
+   for(wd = wdsplys; wd; wd = wd->next)
+      if (!strcmp(wd->name,s)) {
+         wd->refcount++;
+	 return wd;
+         }
+
+   GRFX_ALLOC(wd, _wdisplay);
+
+   strcpy(wd->name,s);
+   wd->display = XOpenDisplay((*s=='\0') ? NULL : s);
+
+   if (wd->display == NULL) {
+      wd->refcount = 0;
+      free(wd);
+      return NULL;
+      }
+   wd->screen = DefaultScreen(wd->display);
+   wd->visual = DefaultVisual(wd->display, wd->screen);
+   wd->cmap = DefaultColormap(wd->display, wd->screen);
+
+   /*
+    * Allocate initial set of color slots.
+    */
+   wd->cpSize = 8;		/* start with room for 8 colors */
+   wd->colrptrs = alloc(wd->cpSize * sizeof(struct wcolor *));
+   if (wd->colrptrs == NULL)
+      ReturnErrNum(305, NULL);
+
+   /*
+    * Color slots 0 and 1 are permanently reserved for black and white
+    * respectively.
+    */
+   alc_centry(wd);		/* allocate slot 0 (ambiguous return value) */
+   if (!alc_centry(wd))		/* allocate slot 1 */
+      ReturnErrNum(305, NULL);
+
+   cp = wd->colrptrs[0];
+   strcpy(cp->name,"black");
+   cp->type = SHARED;
+   cp->r = cp->g = cp->b = 0;
+   color.red = color.green = color.blue = 0;
+   if (XAllocColor(wd->display, wd->cmap, &color))
+      cp->c = color.pixel;
+   else
+      cp->c = BlackPixel(wd->display,wd->screen);
+
+   cp = wd->colrptrs[1];
+   strcpy(cp->name,"white");
+   cp->type = SHARED;
+   cp->r = cp->g = cp->b = 65535;
+   color.red = color.green = color.blue = 65535;
+   if (XAllocColor(wd->display, wd->cmap, &color))
+      cp->c = color.pixel;
+   else
+      cp->c = WhitePixel(wd->display,wd->screen);
+
+   /*
+    * Set the default gamma correction value for windows that are
+    * opened on this display.  Start with configuration default,
+    * but if we can get an interpretation of "RGBi:.5/.5/.5",
+    * calculate a gamma value from that instead.
+    */
+   wd->gamma = GammaCorrection;
+   if (XParseColor(wd->display, wd->cmap, "RGBi:.5/.5/.5", &color)) {
+      g = .299 * color.red + .587 * color.green + .114 * color.blue;
+      g /= 65535;
+      if (g >= 0.1 && g <= 0.9)		/* sanity check */
+         wd->gamma = log(0.5) / log(g);
+      }
+
+   /*
+    * Initialize fonts and other things.
+    */
+   wd->numFonts = 1;
+   wd->fonts = (wfp)malloc(sizeof(struct _wfont));
+   if (wd->fonts == NULL) {
+      free(wd);
+      return NULL;
+      }
+   wd->fonts->refcount = 1;
+   wd->fonts->next = wd->fonts->previous = NULL;
+   wd->fonts->name = malloc(6);
+   if (wd->fonts->name == NULL) {
+      free(wd);
+      return NULL;
+      }
+   strcpy(wd->fonts->name,"fixed");
+   wd->fonts->fsp = XLoadQueryFont(wd->display, "fixed");
+   if (wd->fonts->fsp == NULL) { /* couldn't load "fixed"! */
+      free(wd);
+      return NULL;
+      }
+
+   {
+   XGCValues gcv;
+   Display *stddpy = wd->display;
+   gcv.font = wd->fonts->fsp->fid;
+   gcv.foreground = wd->colrptrs[0]->c;
+   gcv.background = wd->colrptrs[1]->c;
+   gcv.fill_style = FillSolid;
+   gcv.cap_style = CapProjecting;
+   wd->icongc = XCreateGC(stddpy, DefaultRootWindow(stddpy),
+      GCFont | GCForeground | GCBackground | GCFillStyle | GCCapStyle, &gcv);
+   if (wd->icongc == NULL) {
+      free(wd);
+      return NULL;
+      }
+   }
+
+   wd->fonts->height = wd->fonts->fsp->ascent + wd->fonts->fsp->descent;
+
+   GRFX_LINK(wd, wdsplys);
+   return wd;
+   }
+
+/*
+ * allocate font s in the display attached to w
+ */
+wfp alc_font(w,s)
+wbp w;
+char **s;
+   {
+   int flags, size;
+   wfp rv;
+   char family[MAXFONTWORD+1];
+   char *stdfam;
+
+   if (strcmp(*s, "fixed") != 0 && parsefont(*s, family, &flags, &size)) {
+      /*
+       * This is a legal Icon font spec (and it's not an unadorned "fixed").
+       * Check first for special "standard" family names.
+       */
+      if (!strcmp(family, "mono")) {
+         stdfam = "lucidatypewriter";
+         flags |= FONTFLAG_MONO + FONTFLAG_SANS;
+         }
+      else if (!strcmp(family, "typewriter")) {
+         stdfam = "courier";
+         flags |= FONTFLAG_MONO + FONTFLAG_SERIF;
+         }
+      else if (!strcmp(family, "sans")) {
+         stdfam = "helvetica";
+         flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SANS;
+         }
+      else if (!strcmp(family, "serif")) {
+         stdfam = "times";
+         flags |= FONTFLAG_PROPORTIONAL + FONTFLAG_SERIF;
+         }
+      else stdfam = NULL;
+
+      if (stdfam) {
+         /*
+          * Standard name: first try preferred family, then generalize.
+          */
+         rv = findfont(w, stdfam, size, flags);
+         if (!rv)
+            rv = findfont(w, "*", size, flags);
+         }
+      else {
+         /*
+          * Any other name: must match as specified.
+          */
+         rv = findfont(w, family, size, flags);
+         }
+
+      if (rv != NULL)
+         return rv;
+      }
+
+   /*
+    * Not found as an Icon name; may be an X font name.
+    */
+   return tryfont(w, *s);
+   }
+
+/*
+ * return pointer to field i inside XLFD (X Logical Font Description) s.
+ */
+char *xlfd_field(s, i)
+char *s;
+int i;
+   {
+   int j = 0;
+   while (j < i) {
+      if (*s == '\0') return "";	/* if no such field */
+      if (*s++ == '-') j++;
+      }
+   return s;
+   }
+
+/*
+ * return size of font, treating a scalable font as having size n
+ */
+int xlfd_size(s, n)
+char *s;
+int n;
+   {
+   char *f;
+   int z;
+
+   f = xlfd_field(s, XLFD_Size);
+   if (!*f)
+      return 0;
+   z = atoi(f);
+   if (z != 0)
+      return z;
+   else
+      return n;
+   }
+
+/*
+ * Find the best font matching a set of specifications.
+ */
+wfp findfont(w, family, size, flags)
+wbp w;
+char *family;
+int size, flags;
+   {
+   char fontspec[MAXFONTWORD+100];
+   char *p, *weight, *slant, *width, *spacing, **fontlist;
+   int n, champ, challenger, bestsize;
+
+   /*
+    * Construct a font specification that enforces any stated requirements
+    * of size, weight, slant, set width, or proportionality.
+    */
+   if (size > 0)
+      bestsize = size;
+   else
+      bestsize = DEFAULTFONTSIZE;
+
+   if (flags & FONTFLAG_MEDIUM)
+      weight = "medium";
+   else if ((flags & FONTFLAG_DEMI) && (flags & FONTFLAG_BOLD))
+      weight = "demibold";
+   else if (flags & FONTFLAG_BOLD)
+      weight = "bold";
+   else if (flags & FONTFLAG_DEMI)
+      weight = "demi";
+   else if (flags & FONTFLAG_LIGHT)
+      weight = "light";
+   else
+      weight = "*";
+
+   if (flags & FONTFLAG_ITALIC)
+      slant = "i";
+   else if (flags & FONTFLAG_OBLIQUE)
+      slant = "o";
+   else if (flags & FONTFLAG_ROMAN)
+      slant = "r";
+   else
+      slant = "*";
+
+   if (flags & FONTFLAG_NARROW)
+      width = "narrow";
+   else if (flags & FONTFLAG_CONDENSED)
+      width = "condensed";
+   else if (flags & FONTFLAG_NORMAL)
+      width = "normal";
+   else if (flags & FONTFLAG_WIDE)
+      width = "wide";
+   else if (flags & FONTFLAG_EXTENDED)
+      width = "extended";
+   else
+      width = "*";
+
+   if (flags & FONTFLAG_PROPORTIONAL)
+      spacing = "p";
+   else
+      spacing = "*";			/* can't specify {m or c} to X */
+
+   sprintf(fontspec, "-*-%s-%s-%s-%s-*-*-*-*-*-%s-*-*-*",
+      family, weight, slant, width, spacing);
+
+   /*
+    * Get a list of matching fonts from the X server and find the best one.
+    */
+   fontlist = XListFonts(w->window->display->display, fontspec, 2500, &n);
+   champ = 0;
+   while (champ < n && !okfont(fontlist[champ], size, flags))
+      champ++;
+   if (champ >= n) {
+      XFreeFontNames(fontlist);
+      return NULL;			/* nothing acceptable */
+      }
+   for (challenger = champ + 1; challenger < n; challenger++)
+      if (okfont(fontlist[challenger], size, flags)
+      && fontcmp(fontlist[challenger], fontlist[champ], bestsize, flags) < 0)
+         champ = challenger;
+
+   /*
+    * Set the scaling field, if needed, and load the font.
+    */
+   p = xlfd_field(fontlist[champ], XLFD_Size);
+   if (p[0] == '0' && p[1] == '-')
+      sprintf(fontspec, "%.*s%d%s", p - fontlist[champ],
+         fontlist[champ], bestsize, p + 1);
+   else
+      strcpy(fontspec, fontlist[champ]);
+   XFreeFontNames(fontlist);
+   return tryfont(w, fontspec);
+   }
+
+/*
+ * check for minimum acceptability of a font
+ * (things that couldn't be filtered by the XLFD pattern):
+ * -- size wrong (there's a bug in OpenWindows 3.3 else X could do it)
+ * -- not monospaced (can't set pattern to match m or c but not p)
+ */
+int okfont(spec, size, flags)
+char *spec;
+int size, flags;
+   {
+   if (size > 0 && xlfd_size(spec, size) != size)
+      return 0;			/* can't match explicit size request */
+   if ((flags & FONTFLAG_MONO) && xlfd_field(spec, XLFD_Spacing)[0] == 'p')
+      return 0;			/* requested mono, but this isn't */
+   return 1;
+   }
+
+/*
+ * rank two fonts based on whether XLFD field n matches a preferred value.
+ * returns <0 if font1 is better, >0 if font2 is better, else 0.
+ */
+int fieldcmp(font1, font2, value, field)
+char *font1, *font2, *value;
+int field;
+   {
+   int len, r1, r2;
+
+   len = strlen(value);
+   r1 = (strncmp(xlfd_field(font1, field), value, len) == 0);
+   r2 = (strncmp(xlfd_field(font2, field), value, len) == 0);
+   return r2 - r1;			/* -1, 0, or 1 */
+   }
+
+/*
+ * rank two fonts.
+ * returns <0 if font1 is better, >0 if font2 is better, else 0.
+ *
+ * Note that explicit requests for size, slant, weight, and width caused
+ * earlier filtering in findfont(), so all those flags aren't checked
+ * again here; normal values are just favored in case nothing was specified.
+ */
+int fontcmp(font1, font2, size, flags)
+char *font1, *font2;
+int size, flags;
+   {
+   int n;
+
+/* return if exactly one of the fonts matches value s in field n */
+#define PREFER(s,n) \
+do { int r = fieldcmp(font1, font2, s, n); if (r != 0) return r; } while (0)
+
+/* return if exactly one of the fonts does NOT match value s in field n */
+#define SPURN(s,n) \
+do { int r = fieldcmp(font1, font2, s, n); if (r != 0) return -r; } while (0)
+
+   /*
+    * Prefer the font that is closest to the desired size.
+    */
+   n = abs(size - xlfd_size(font1, size)) - abs(size - xlfd_size(font2, size));
+   if (n != 0)
+      return n;
+
+   /*
+    * try to check serifs (though not always indicated in X font description)
+    */
+   if (flags & FONTFLAG_SANS) {
+      PREFER("sans", XLFD_AddStyle);
+      SPURN("serif", XLFD_AddStyle);
+      }
+   else if (flags & FONTFLAG_SERIF) {
+      PREFER("serif", XLFD_AddStyle);
+      SPURN("sans", XLFD_AddStyle);
+      }
+
+   /*
+    * prefer normal values for other fields.  These only have an effect
+    * for fields that were wildcarded when requesting the font list.
+    */
+   PREFER("r", XLFD_Slant);		/* prefer roman slant */
+   PREFER("medium", XLFD_Weight);	/* prefer medium weight */
+   SPURN("demi", XLFD_Weight);		/* prefer non-demi if no medium */
+   PREFER("normal", XLFD_SetWidth);	/* prefer normal width */
+   PREFER("iso8859", XLFD_CharSet);	/* prefer font of ASCII chars */
+   SPURN("0", XLFD_PointSize);		/* prefer tuned font to scaled */
+   PREFER("adobe", XLFD_Foundry);	/* these look better than others */
+
+   /* no significant difference */
+   return 0;
+   }
+
+/*
+ * load a font and return a font structure.
+ */
+
+wfp tryfont(w,s)
+wbp w;
+char *s;
+   {
+   wdp wd = w->window->display;
+   wfp rv;
+   /*
+    * see if the font is already loaded on this display
+    */
+   for(rv = wd->fonts; rv != NULL; rv = rv->next) {
+      if (!strcmp(s,rv->name)) break;
+      }
+   if (rv != NULL) {
+      rv->refcount++;
+      return rv;
+      }
+
+   /*
+    * load a new font
+    */
+   GRFX_ALLOC(rv, _wfont);
+   rv->name = malloc(strlen(s) + 1);
+   if (rv->name == NULL) ReturnErrNum(305, NULL);
+   strcpy(rv->name, s);
+   rv->fsp = XLoadQueryFont(wd->display, rv->name);
+   if (rv->fsp == NULL){
+      free(rv->name);
+      free(rv);
+      return NULL;
+      }
+   rv->height = rv->fsp->ascent + rv->fsp->descent;
+   w->context->leading = rv->height;
+
+   /*
+    * link the font into this displays fontlist (but not at the head!)
+    */
+   rv->next = wd->fonts->next;
+   rv->previous = wd->fonts;
+   if (wd->fonts->next) wd->fonts->next->previous = rv;
+   wd->fonts->next = rv;
+   return rv;
+   }
+
+/*
+ * allocate a context.  Can't be called until w has a display and window.
+ */
+wcp alc_context(w)
+wbp w;
+   {
+   wcp wc;
+   wdp wd = w->window->display;
+
+   GRFX_ALLOC(wc, _wcontext);
+   wc->serial = ++context_serial;
+   wc->display = wd;
+   wd->refcount++;
+   wc->fg = wd->colrptrs[0];
+   wc->fg->refcount++;
+   wc->bg = wd->colrptrs[1];
+   wc->bg->refcount++;
+   wc->font = wd->fonts;
+   wc->leading = wd->fonts->height;
+   wc->drawop = GXcopy;
+   wc->gamma = wd->gamma;
+   wc->clipx = wc->clipy = 0;
+   wc->clipw = wc->cliph = -1;
+   wc->linewidth = 1;
+
+   GRFX_LINK(wc, wcntxts);
+   return wc;
+   }
+
+/*
+ * allocate a context, cloning attributes from an existing context
+ */
+wcp clone_context(w)
+wbp w;
+   {
+   wcp wc, rv;
+   XGCValues gcv;
+   XRectangle rec;
+   unsigned long gcmask = GCFont | GCForeground | GCBackground |
+		GCFillStyle | GCCapStyle | GCLineWidth | GCLineStyle;
+
+   wc = w->context;
+   Protect(rv = alc_context(w), return NULL);
+
+   rv->dx = wc->dx;
+   rv->dy = wc->dy;
+   rv->clipx = wc->clipx;
+   rv->clipy = wc->clipy;
+   rv->clipw = wc->clipw;
+   rv->cliph = wc->cliph;
+   rv->fg = wc->fg;
+   rv->fg->refcount++;
+   rv->bg = wc->bg;
+   rv->bg->refcount++;
+   rv->font = wc->font;
+   rv->font->refcount++;
+   rv->fillstyle = wc->fillstyle;
+   rv->linestyle = wc->linestyle;
+   rv->linewidth = wc->linewidth;
+   rv->drawop = wc->drawop;
+   rv->gamma = wc->gamma;
+   rv->bits = wc->bits;
+
+   if (ISXORREVERSE(w))
+      gcv.foreground = rv->fg->c ^ rv->bg->c;
+   else
+      gcv.foreground = rv->fg->c;
+   gcv.background = rv->bg->c;
+   gcv.font       = rv->font->fsp->fid;
+   gcv.line_style = rv->linestyle;
+   gcv.line_width = rv->linewidth;
+   if (rv->linewidth > 1) {
+      gcv.dashes = 3 * rv->linewidth;
+      gcmask |= GCDashList;
+      }
+   gcv.fill_style = rv->fillstyle;
+   gcv.cap_style  = CapProjecting;
+   rv->gc = XCreateGC(w->window->display->display,w->window->pix,gcmask,&gcv);
+   if (rv->gc == NULL) {
+      free(rv);
+      return NULL;
+      }
+   if (rv->clipw >= 0) {
+      rec.x = rv->clipx;
+      rec.y = rv->clipy;
+      rec.width = rv->clipw;
+      rec.height = rv->cliph;
+      XSetClipRectangles(rv->display->display, rv->gc, 0, 0, &rec, 1,Unsorted);
+      }
+   return rv;
+   }
+
+/*
+ * allocate a window state structure
+ */
+wsp alc_winstate()
+   {
+   wsp ws;
+
+   GRFX_ALLOC(ws, _wstate);
+   ws->serial = ++canvas_serial;
+   ws->bits = 1024;				/* echo ON; others OFF */
+   ws->filep = nulldesc;
+   ws->listp = nulldesc;
+   ws->theCursor = si_s2i(cursorsyms, "left ptr") >> 1;
+   ws->iconic = NormalState;
+   ws->posx = ws->posy = -(MaxInt);
+   GRFX_LINK(ws, wstates);
+   return ws;
+   }
+
+/*
+ * free a window state
+ */
+int free_window(ws)
+wsp ws;
+   {
+   ws->refcount--;
+   if(ws->refcount == 0) {
+      ws->bits |= 1;			/* SETZOMBIE */
+      if (ws->win != (Window) NULL) {
+	 XDestroyWindow(ws->display->display, ws->win);
+	 XFlush(ws->display->display);
+	 while (ws->win != (Window) NULL)
+	    if (pollevent() == -1) return -1;
+	 }
+      GRFX_UNLINK(ws, wstates);
+      }
+   return 0;
+   }
+
+/*
+ * free a window context
+ */
+void free_context(wc)
+wcp wc;
+   {
+   wc->refcount--;
+   if(wc->refcount == 0) {
+      if (wc->gc != NULL)
+	 XFreeGC(wc->display->display, wc->gc);
+      free_display(wc->display);
+      GRFX_UNLINK(wc, wcntxts);
+      }
+   }
+
+/*
+ * free a display
+ */
+void free_display(wd)
+wdp wd;
+   {
+   wd->refcount--;
+   if(wd->refcount == 0) {
+      if (wd->cmap != DefaultColormap(wd->display, wd->screen))
+	 XFreeColormap(wd->display, wd->cmap);
+      XCloseDisplay(wd->display);
+      if (wd->previous) wd->previous->next = wd->next;
+      else wdsplys = wd->next;
+      if (wd->next) wd->next->previous = wd->previous;
+      free(wd);
+      }
+   }
diff --git a/src/runtime/rxwin.ri b/src/runtime/rxwin.ri
new file mode 100644
index 0000000..c2dc48c
--- /dev/null
+++ b/src/runtime/rxwin.ri
@@ -0,0 +1,3475 @@
+/*
+ * File: rxwin.ri - X11 system-specific graphics interface code.
+ */
+
+#ifdef Graphics
+
+#define RootState IconicState+1
+
+/*
+ * Global variables specific to X
+ */
+static XSizeHints size_hints;
+
+/*
+ * function prototypes
+ */
+static int	handle_misc	(wdp display, wbp w);
+static int	handle_config	(wbp w, XConfigureEvent *event);
+static int	handle_exposures (wbp w, XExposeEvent *event);
+static void	handle_mouse	(wbp w, XButtonEvent *event);
+static void	handle_keypress (wbp w, XKeyEvent *event);
+static void	postcursor	(wbp w);
+static void	scrubcursor	(wbp w);
+static XImage *	getximage	(wbp w, int x, int y,
+				 int width, int height, int init);
+static void	moveWindow	(wbp w, int x, int y);
+static void	makeIcon	(wbp w, int x, int y);
+static int	wmap		(wbp w);
+static Pixmap	loadimage	(wbp w, char *filename, unsigned int *height,
+				unsigned int *width, int atorigin, int *status);
+
+
+/*
+ * write some text to both the window and the pixmap
+ */
+void xdis(w,s,n)
+register wbp w;
+char *s;
+int n;
+   {
+   int x, y, delta_x;
+   STDLOCALS(w);
+
+   pollctr>>=1; pollctr++;
+   x = ws->x;
+   y = ws->y;
+   delta_x = XTextWidth(wc->font->fsp,s,n);
+   RENDER4(XDrawImageString,x,y,s,n);
+   ws->x += delta_x;
+   }
+
+
+
+/*
+ * put a character out to a window using the current attributes
+ */
+int wputc(ci,w)
+int ci;
+wbp w;
+   {
+   int fh, lh, width, height, over;
+   char c = (char)ci;
+   STDLOCALS(w);
+
+   fh = wc->font->height;
+   lh = wc->leading;
+   width = ws->width;
+   height = ws->height;
+
+   switch(c) {
+   case '\r': {
+      ws->x = wc->dx;
+      break;
+      }
+   case '\n': {
+      if (ISCEOLON(w)) {
+         /*
+	  * Clear the rest of the line, like a terminal would.
+	  * Its arguable whether this should clear to the window
+	  * background or the current context background.  If you
+	  * change it to use the context background you have to
+	  * change the XClearArea call to another XFillRectangle
+	  * (cf. eraseArea()).
+	  */
+	 if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+	 XSetForeground(stddpy, stdgc, wc->bg->c);
+	 XClearArea(stddpy, stdwin,
+		    ws->x, ws->y-wc->font->fsp->max_bounds.ascent,
+		    width-ws->x, lh, False);
+	 XFillRectangle(stddpy, stdpix, stdgc,
+			ws->x, ws->y - wc->font->fsp->max_bounds.ascent,
+			width - ws->x, lh);
+	 XSetForeground(stddpy, stdgc,wc->fg->c^(ISXORREVERSE(w)?wc->bg->c:0));
+	 if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+         }
+      ws->y += lh;
+      ws->x = wc->dx;
+      /*
+       * Now for the exciting part: do we scroll the window?
+       * Copy the pixmap upward, then repaint the window.
+       */
+      over = ws->y + wc->font->fsp->max_bounds.descent - height;
+      if (over > 0) {
+	 ws->y -= over;
+
+	 if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+	 XCopyArea(stddpy, stdpix, stdpix, stdgc,
+		   0, over,			/* x, y */
+		   width, height - over,	/* w, h */
+		   0, 0);			/* dstx,dsty */
+	 XSetForeground(stddpy, stdgc, wc->bg->c);
+	 XFillRectangle(stddpy, stdpix, stdgc,
+		   0, height - over, width, over);
+	 XSetForeground(stddpy, stdgc,wc->fg->c^(ISXORREVERSE(w)?wc->bg->c:0));
+	 if (stdwin)
+	    XCopyArea(stddpy, stdpix, stdwin, stdgc, 0, 0, width, height, 0,0);
+	 if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+         }
+      break;
+      }
+   case '\t': {
+      xdis(w, "        ", 8 - ((XTOCOL(w,ws->x))&7));
+      break;
+      }
+   /*
+    * Handle backspaces.  This implements cooked mode echo handling.
+    */
+   case '\177':
+   case '\010': {
+      int i = 0, pre_x;
+      /*
+       * Start with the last character queued up.
+       */
+      i--;
+      /*
+       * Trot back to the control-H itself.
+       */
+      while ((i>-EQUEUELEN) && (EVQUESUB(w,i) != c)) i--;
+      if (i == -EQUEUELEN) break;
+      /*
+       * Go past the control-H.
+       */
+      i--;
+      /*
+       * Go back through any number of control-H's from prior lifetimes.
+       */
+      while((i > -EQUEUELEN) && !isprint(EVQUESUB(w,i))) i--;
+      if (i == -EQUEUELEN) break;
+
+      /*
+       * OK, here's the character we're actually rubbing out.  Back up.
+       */
+      c = EVQUESUB(w,i);
+      pre_x = ws->x;
+      ws->x -= XTextWidth(wc->font->fsp, &c, 1);
+      /*
+       * Physically erase the character from the queue.  This results in
+       * two control-H's present in the queue.
+       */
+      *evquesub(w,i) = '\010';
+      /*
+       * Save the backed-up position, and draw spaces through the erased.
+       */
+      i = ws->x;
+      while(ws->x < pre_x) xdis(w," ",1);
+      ws->x = i;
+      break;
+      }
+   default: {
+      xdis(w,&c,1);
+      }
+   }
+   return 1;
+   }
+
+
+/*
+ * handle_misc processes pending events on display.
+ * if w is non-null, block until a returnable event arrives.
+ * returns 1 on success, 0 on failure, and -1 on error.
+ */
+int handle_misc(wd, w)
+wdp wd;
+wbp w;
+   {
+   XEvent event;
+   Window evwin;
+   static int presscount = 0;
+   wbp wb;
+   wsp ws;
+
+   while ((w != NULL) || XPending(wd->display)) {
+
+      XNextEvent(wd->display, &event);
+      evwin = event.xexpose.window;  /* go ahead, criticize all you like */
+
+/* could avoid doing this search every event by handling 1 window at a time */
+      for (wb = wbndngs; wb; wb=wb->next) {
+	 ws = wb->window;
+
+	 if ((ws->display == wd) &&
+	     ((ws->win == evwin) || (ws->iconwin == evwin) ||
+	      (ws->pix == evwin) || (ws->initialPix == evwin))) break;
+         }
+      if (!wb) continue;
+      if (evwin == ws->iconwin) {
+         switch (event.type) {
+	    case Expose:
+               if (ws->iconpix)
+	          XCopyArea(wd->display, ws->iconpix, ws->iconwin,
+			    wd->icongc, 0, 0, ws->iconw, ws->iconh, 3, 3);
+	       else
+	          XDrawString(wd->display, evwin, wd->icongc, 4,
+	                      ws->display->fonts->fsp->max_bounds.ascent + 2,
+		              ws->iconlabel, strlen(ws->iconlabel));
+	       if (ws->iconic == IconicState)
+		  SETEXPOSED(wb);
+	       break;
+	    case KeyPress:
+	       handle_keypress(wb, (XKeyEvent *)&event);
+	       break;
+	    case ButtonPress:
+	       if (ws->iconic == IconicState)
+	          XMapWindow(ws->display->display, ws->win);
+	       ws->iconic = NormalState;        /* set the current state */
+	       break;
+	    case ConfigureNotify:
+	       ws->iconx = ((XConfigureEvent *)&event)->x;
+	       ws->icony = ((XConfigureEvent *)&event)->y;
+	       break;
+	    }
+	 }
+      else {
+      switch (event.type) {
+	 case KeyPress:
+	    handle_keypress(wb, (XKeyEvent *)&event);
+	    break;
+	 case ButtonPress:
+	    presscount++;
+	    handle_mouse(wb, (XButtonEvent *)&event);
+	    break;
+	 case ButtonRelease:
+	    if (--presscount < 0) presscount = 0;
+	    handle_mouse(wb, (XButtonEvent *)&event);
+	    break;
+	 case MotionNotify:
+	    if (presscount)
+	       handle_mouse(wb, (XButtonEvent *)&event);
+	    break;
+         case NoExpose:
+	    break;
+	 case Expose:
+	    if (!handle_exposures(wb, (XExposeEvent *)&event))
+	       return 1;
+	    continue;
+         case UnmapNotify:
+	    wb->window->iconic = IconicState;
+            continue;
+	 case MapNotify:
+	    if ((ws->width != DisplayWidth(wd->display, wd->screen)) ||
+		(ws->height != DisplayHeight(wd->display, wd->screen)))
+	       ws->iconic = NormalState;
+	    else
+	       ws->iconic = MaximizedState;
+	    continue;
+	 case ConfigureNotify:
+	    if (!handle_config(wb, (XConfigureEvent *)&event)) {
+	       return 0;
+               }
+	    break;
+	 case DestroyNotify:
+	    if (!ISZOMBIE(wb)) return -1; /* error #141 */
+
+	    /*
+	     * first of all, we are done with this window
+	     */
+	    ws->win = (Window) NULL;
+
+	    /*
+	     * if there are no more references, we are done with the pixmap
+	     *  too.  Free it and the colors allocated for this canvas.
+	     */
+	    if (ws->refcount == 0) {
+	       if (wb->window->pix) {
+		  Display *d = ws->display->display;
+		  XSync(d, False);
+		  if (ws->pix)
+		     XFreePixmap(d, ws->pix);
+		  ws->pix = (Pixmap) NULL;
+	          }
+	       if (ws->initialPix != (Pixmap) NULL) {
+		  Display *d = ws->display->display;
+		  XSync(d, False);
+		  XFreePixmap(d, ws->initialPix);
+		  ws->initialPix = (Pixmap) NULL;
+	          }
+               free_xcolors(wb, 2); /* free regular colors */
+               free_xcolors(wb, 1); /* free icon colors */
+	       }
+	    break;
+	 default:
+	    continue;
+	 }
+      if ((w != NULL) &&
+	  ((evwin == w->window->win) || (evwin == w->window->iconwin))) {
+	 return 1;
+         }
+      }
+   }
+   return 1;
+   }
+
+/*
+ * poll for available events on all opened displays.
+ * this is where the interpreter calls into the X interface.
+ */
+int pollevent()
+   {
+   wdp wd;
+   int hm;
+   for (wd = wdsplys; wd; wd = wd->next) {
+      if ((hm = handle_misc(wd, NULL)) < 1) {
+	 if (hm == -1) return -1;
+	 else if (hm == 0) {
+	    /* how to handle failure? */
+	    }
+         }
+      }
+   return 400;
+   }
+
+/*
+ * get a single item from w's pending queue
+ */
+int wgetq(w,res)
+wbp w;
+dptr res;
+   {
+   int posted = 0;
+
+   while (1) {
+      STDLOCALS(w);		/* leave inside loop; ws->pix can change! */
+      if (!EVQUEEMPTY(w)) {
+	 EVQUEGET(w,*res);
+	 if (posted)
+            scrubcursor(w);
+	 return 1;
+         }
+      postcursor(w);		/* post every time in case resize erased it */
+      posted = 1;
+      if (handle_misc(wd, w) == -1) {
+	 if (posted)
+            scrubcursor(w);
+	 return -1;
+	 }
+      }
+   }
+
+/*
+ * postcursor/scrubcursor calls must be paired without any intervening output.
+ */
+static void postcursor(w)
+wbp w;
+   {
+   STDLOCALS(w);
+
+   if (!ISCURSORON(w) || !stdwin) return;
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+   if (ISXORREVERSE(w)) XSetForeground(stddpy, stdgc, wc->fg->c);
+
+   /* Draw only on window, not on backing pixmap */
+   XFillRectangle(stddpy, stdwin, stdgc, ws->x, ws->y, FWIDTH(w), DESCENT(w));
+   XSync(stddpy, False);
+   }
+
+static void scrubcursor(w)
+wbp w;
+   {
+   STDLOCALS(w);
+
+   if (!ISCURSORON(w) || !stdwin) return;
+
+   XCopyArea(stddpy, stdpix, stdwin, stdgc,	/* restore window from pixmap */
+      ws->x, ws->y, FWIDTH(w), DESCENT(w), ws->x, ws->y);
+
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+   if (ISXORREVERSE(w)) XSetForeground(stddpy, stdgc, wc->fg->c ^ wc->bg->c);
+   }
+
+/*
+ * wclose - close a window.  If is a real on-screen window,
+ * wait for a DestroyNotify event from the server before returning.
+ */
+int wclose(w)
+wbp w;
+   {
+   STDLOCALS(w);
+
+   XSync(stddpy, False);
+   if (pollevent() == -1) return -1;
+
+   /*
+    * Force window to close (turn into a pixmap)
+    */
+   if (ws->win && ws->refcount > 1) {
+      SETZOMBIE(w);
+      XDestroyWindow(stddpy,stdwin);
+      XFlush(stddpy);
+      ws->refcount--;
+      while (ws->win)
+	 if (pollevent() == -1) return -1;
+      }
+   /*
+    * Entire canvas terminates
+    */
+   else {
+      free_xcolors(w, 2);
+      free_xcolors(w, 1);
+      free_window(ws);
+      }
+
+   return 0;
+   }
+/*
+ * flush a window
+ */
+void wflush(w)
+wbp w;
+   {
+   STDLOCALS(w);
+   XFlush(stddpy);
+   }
+/*
+ * flush all windows
+ */
+void wflushall()
+   {
+   wdp wd;
+   for (wd = wdsplys; wd != NULL; wd = wd->next) {
+      XFlush(wd->display);
+      }
+   }
+/*
+ * sync all the servers
+ */
+void wsync(w)
+wbp w;
+   {
+   wdp wd;
+   if (w == NULL) {
+      for (wd = wdsplys; wd != NULL; wd = wd->next) {
+	 XSync(wd->display, False);
+	 }
+      }
+   else
+      XSync(w->window->display->display, False);
+   }
+
+/*
+ * open a window
+ * This routine really just allocates a window data structure.
+ * The interesting part is done in wmap, after the user preferences
+ * passed to Icon have been parsed.  Returns NULL on error/failure;
+ * err_index is set to one of:
+ *  >= 0: the index of an offending attribute value
+ *  -1  : ordinary failure
+ *  -2  : out of memory
+ */
+FILE *wopen(name, lp, attr, n, err_index)
+char *name;
+struct b_list *lp;
+dptr attr;
+int n, *err_index;
+   {
+   wbp w;
+   wsp ws;
+   char dispchrs[256];
+   char answer[128];
+   char *display = NULL;
+   int i;
+   tended struct b_list *tlp;
+   tended struct descrip attrrslt;
+
+   tlp = lp;
+
+   for(i=0;i<n;i++) {
+      if (is:string(attr[i]) &&
+	  (StrLen(attr[i])>8) &&
+	  !strncmp("display=",StrLoc(attr[i]),8)) {
+         strncpy(dispchrs,StrLoc(attr[i])+8,StrLen(attr[i])-8);
+	 dispchrs[StrLen(attr[i]) - 8] = '\0';
+	 display = dispchrs;
+         }
+      }
+
+   if ((w = alc_wbinding()) == NULL) {
+      *err_index = -2;
+      return NULL;
+      }
+   if ((w->window = alc_winstate()) == NULL) {
+      *err_index = -2;
+      free_binding(w);
+      return NULL;
+      }
+   if ((w->window->display = alc_display(display)) == NULL) {
+      *err_index = -1; /* might be out of memory, probably bad DISPLAY var. */
+      free_binding(w);
+      return NULL;
+      }
+   ws = w->window;
+   ws->listp.dword = D_List;
+   BlkLoc(ws->listp) = (union block *)tlp;
+
+   /*
+    * some attributes of the display and window are used in the context
+    */
+   if ((w->context = alc_context(w)) == NULL) {
+      *err_index = -2;
+      free_binding(w);
+      return NULL;
+      }
+
+   /*
+    * some attributes of the context determine window defaults
+    */
+   ws->height = w->context->font->height * 12;
+   ws->width  = w->context->font->fsp->max_bounds.width * 80;
+   ws->y = w->context->font->fsp->max_bounds.ascent;
+   ws->x = 0;
+   ws->y += w->context->dy;
+   ws->x += w->context->dx;
+
+   /*
+    * Loop through any remaining arguments.
+    */
+   for (i = 0; i < n; i++){
+      /*
+       * write the attribute,
+       *  except "display=" attribute, which is done earlier
+       */
+      if((StrLen(attr[i])<9)||strncmp(StrLoc(attr[i]),"display=",8)) {
+	 switch (wattrib((wbp) w, StrLoc(attr[i]), StrLen(attr[i]), &attrrslt,
+			 answer)) {
+	 case Error:
+	    *err_index = i;
+	    return NULL;
+	 case Failed:
+	    free_binding((wbp)w);
+	    *err_index = -1;
+	    return NULL;
+	    }
+	 }
+      }
+   if (ws->windowlabel == NULL) {
+      ws->windowlabel = salloc(name);
+      if (ws->windowlabel == NULL) { /* out of memory */
+	 *err_index = -2;
+	 return NULL;
+	 }
+      }
+
+   if ((i = wmap(w)) != Succeeded) {
+      if (i == Failed) *err_index = -1;
+      else *err_index = 0;
+      return NULL;
+      }
+   return (FILE *)w;
+   }
+
+/*
+ * make an icon for a window
+ */
+void makeIcon(w, x, y)
+wbp w;
+int x, y;		/* current mouse position */
+{
+   int status;
+   STDLOCALS(w);
+
+   /* if a pixmap image has been specified, load it */
+   if (ws->initicon.width) {
+      ws->iconpix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy),
+				  ws->iconw, ws->iconh,
+				  DefaultDepth(stddpy,wd->screen));
+      }
+   else if (ws->iconimage && strcmp(ws->iconimage, "")) {
+      ws->iconpix = loadimage(w, ws->iconimage, &(ws->iconh), &(ws->iconw),
+			      0, &status);
+      ws->iconh += 6;
+      ws->iconw += 6;
+      }
+   else {    /* determine the size of the icon window */
+      ws->iconh = wd->fonts->fsp->max_bounds.ascent +
+		  wd->fonts->fsp->max_bounds.descent + 5;
+      if (ws->iconlabel == NULL) ws->iconlabel = "";
+      ws->iconw = XTextWidth(wd->fonts->fsp, ws->iconlabel,
+		  strlen(ws->iconlabel)) + 6;
+   }
+
+   /* if icon position hint exists, get it */
+   if (ws->wmhintflags & IconPositionHint) {
+      x = ws->iconx;
+      y = ws->icony;
+   }
+
+   /* create the icon window */
+   ws->iconwin = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy), x, y,
+				     ws->iconw, ws->iconh, 2, wc->fg->c,
+				     wc->bg->c);
+
+   /* select events for the icon window */
+   XSelectInput(stddpy, ws->iconwin,
+		ExposureMask | KeyPressMask | ButtonPressMask |
+		StructureNotifyMask);
+
+}
+
+/*
+ * Create a canvas.
+ *  If a window, cause the window to actually become visible on the screen.
+ *  returns Succeeded, Failed, or Error
+ */
+int wmap(w)
+wbp w;
+   {
+   XWindowAttributes attrs;
+   XGCValues gcv;
+   unsigned long gcmask =
+      GCFont | GCForeground | GCBackground | GCFillStyle | GCCapStyle;
+   struct imgdata *imd;
+   int i, r;
+   int new_pixmap = 0;
+   char *p, *s;
+   XWMHints wmhints;
+   XClassHint clhints;
+   STDLOCALS(w);
+
+   /*
+    *  Create a pixmap for this canvas if there isn't one already.
+    */
+   if (ws->pix == (Pixmap) NULL) {
+      if (ws->initialPix) {
+	 ws->pix = ws->initialPix;
+	 ws->initialPix = (Pixmap) NULL;
+	 ws->pixwidth = ws->width;
+	 ws->pixheight = ws->height;
+	 }
+      else {
+	 ws->pix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy),
+				 ws->width, ws->height,
+				 DefaultDepth(stddpy,wd->screen));
+	 ws->pixwidth = ws->width;
+	 ws->pixheight = ws->height;
+	 new_pixmap = 1;
+	 }
+      stdpix = ws->pix;
+      }
+
+   /*
+    * create the X window (or use the DefaultRootWindow if requested)
+    */
+   if (ws->iconic != HiddenState) {
+      ws->win = ((ws->iconic == RootState) ? DefaultRootWindow(stddpy) :
+		 XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy),
+				     ws->posx < 0 ? 0 : ws->posx,
+				     ws->posy < 0 ? 0 : ws->posy, ws->width,
+				     ws->height, 1, wc->fg->c, wc->bg->c));
+      if (ws->win == (Window) NULL)
+	 return Failed;
+      stdwin = ws->win;
+      XClearWindow(stddpy, stdwin);
+      }
+
+   /*
+    * before creating the graphics context, construct a description
+    * of any non-default initial graphics context values.
+    */
+   gcv.foreground = wc->fg->c ^ (ISXORREVERSE(w) ? wc->bg->c : 0);
+   gcv.background = wc->bg->c;
+   gcv.font       = wc->font->fsp->fid;
+   if (wc->fillstyle)
+      gcv.fill_style = wc->fillstyle;
+   else
+      gcv.fill_style = wc->fillstyle = FillSolid;
+   if (wc->linestyle || wc->linewidth) {
+      gcmask |= (GCLineWidth | GCLineStyle);
+      gcv.line_width = wc->linewidth;
+      gcv.line_style = wc->linestyle;
+      if (wc->linewidth > 1) {
+         gcv.dashes = 3 * wc->linewidth;
+         gcmask |= GCDashList;
+         }
+      }
+   else
+      wc->linestyle = LineSolid;
+   gcv.cap_style = CapProjecting;
+
+   /*
+    * Create a graphics context (or change an existing one to conform
+    * with initial values).
+    */
+   if (stdgc == NULL) {
+      wc->gc = XCreateGC(stddpy, stdpix, gcmask, &gcv);
+      stdgc = wc->gc;
+      if (stdgc == NULL) return Failed;
+      }
+   else
+      XChangeGC(stddpy, stdgc, gcmask, &gcv);
+
+   if (wc->clipw >= 0)
+      setclip(w);
+
+   if (new_pixmap) {
+      XSetForeground(stddpy, stdgc, wc->bg->c);
+      XFillRectangle(stddpy, ws->pix, stdgc, 0, 0, ws->width, ws->height);
+      XSetForeground(stddpy, stdgc, wc->fg->c ^(ISXORREVERSE(w)?wc->bg->c:0));
+      }
+
+   imd = &ws->initimage;
+   if (imd->width) {
+      r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl,
+         imd->data, (word)imd->width * (word)imd->height, 0);
+      free((pointer)imd->paltbl);
+      free((pointer)imd->data);
+      imd->width = 0;
+      if (r < 0)
+         return Failed;
+      }
+
+   imd = &ws->initicon;
+   if (imd->width) {
+      r = strimage(w, 0, 0, imd->width, imd->height, imd->paltbl,
+         imd->data, (word)imd->width * (word)imd->height, 1);
+      free((pointer)imd->paltbl);
+      free((pointer)imd->data);
+      imd->width = 0;
+      if (r < 0)
+         return Failed;
+      wmhints.icon_window = ws->iconwin;
+      ws->wmhintflags |= IconWindowHint;
+      }
+
+   if (wc->patternname != NULL) {
+      if (SetPattern(w, wc->patternname, strlen(wc->patternname)) != Succeeded)
+	 return Failed;
+      }
+
+   /*
+    *  if we are opening a pixmap, we are done at this point.
+    */
+   if (stdwin == (Window) NULL) return Succeeded;
+
+   if (ws->iconic != RootState) {
+      size_hints.flags = PSize | PMinSize | PMaxSize;
+      size_hints.width = ws->width;
+      size_hints.height= ws->height;
+      if (ws->posx == -(MaxInt)) ws->posx = 0;
+      else size_hints.flags |= USPosition;
+      if (ws->posy == -(MaxInt)) ws->posy = 0;
+      else size_hints.flags |= USPosition;
+      size_hints.x = ws->posx;
+      size_hints.y = ws->posy;
+      if (ISRESIZABLE(w)) {
+	 size_hints.min_width = 0;
+	 size_hints.min_height = 0;
+	 size_hints.max_width = DisplayWidth(stddpy, wd->screen);
+	 size_hints.max_height = DisplayHeight(stddpy, wd->screen);
+	 }
+      else {
+	 size_hints.min_width = size_hints.max_width = ws->width;
+	 size_hints.min_height = size_hints.max_height = ws->height;
+	 }
+      if (ws->iconlabel == NULL) {
+	 if ((ws->iconlabel = salloc(ws->windowlabel)) == NULL)
+	    ReturnErrNum(305, Error);
+	 }
+      XSetStandardProperties(stddpy, stdwin, ws->windowlabel, ws->iconlabel,
+			     0,0,0, &size_hints);
+      XSelectInput(stddpy, stdwin, ExposureMask | KeyPressMask |
+		   ButtonPressMask | ButtonReleaseMask | ButtonMotionMask |
+		   StructureNotifyMask);
+      }
+
+   wmhints.input = True;
+   wmhints.flags = InputHint;
+   if (ws->iconic != RootState) {
+      if (ws->iconimage != NULL) {
+	 makeIcon(w, ws->posx < 0 ? 0 : ws->posx, ws->posy < 0 ? 0 : ws->posy);
+	 wmhints.icon_window = ws->iconwin;
+	 ws->wmhintflags |= IconWindowHint;
+         }
+      wmhints.flags |= (ws->wmhintflags | StateHint);
+      wmhints.initial_state = ws->iconic;
+      wmhints.icon_x = ws->iconx;
+      wmhints.icon_y = ws->icony;
+      }
+   XSetWMHints(stddpy, stdwin, &wmhints);
+
+   /*
+    * Set the class hints that name the program (for reference by the
+    * window manager) following conventions given in O'Reilly.
+    */
+   if (! (s = getenv("RESOURCE_NAME"))) {
+      p = StrLoc(kywd_prog);
+      s = p + StrLen(kywd_prog);
+      while (s > p && s[-1] != '/')
+	 s--;				/* find tail of prog_name */
+      }
+   clhints.res_name = s;
+   clhints.res_class = "IconProg";
+   XSetClassHint(stddpy, stdwin, &clhints);
+
+   if (wd->cmap != DefaultColormap(stddpy,wd->screen))
+      XSetWindowColormap(stddpy, stdwin, wd->cmap);
+
+   if (ws->iconic != RootState) {
+      CLREXPOSED(w);
+      XMapWindow(stddpy, stdwin);
+      }
+
+   XGetWindowAttributes(stddpy, stdwin, &attrs);
+   ws->width = attrs.width;
+   ws->height = attrs.height;
+   if (!resizePixmap(w, ws->width, ws->height)) return Failed;
+
+   if (stdwin) {
+      i = ws->theCursor;
+      if (!(wd->cursors[i]))
+         wd->cursors[i] = XCreateFontCursor(stddpy, 2 * i);
+      XDefineCursor(stddpy, stdwin, wd->cursors[i]);
+      }
+
+   /*
+    * busy loop for an expose event, unless of course we are starting out
+    *  in an iconic state
+    */
+   CLRZOMBIE(w);
+   if (ws->win != (Window) NULL) {
+      int hm;
+      while (!ISEXPOSED(w) && (ws->iconic != IconicState || ws->iconwin)) {
+	 if ((hm = handle_misc(wd, w)) < 1) {
+	    if (hm == -1) return Error;
+	    else if (hm == 0) {
+	       /* how to handle failure? */
+	       }
+	    }
+         }
+      }
+
+   XSetFunction(stddpy, stdgc, wc->drawop);
+   XSync(stddpy, False);
+   return Succeeded;
+}
+
+
+int do_config(w, status)
+wbp w;
+int status;
+   {
+   wsp ws = w->window;
+   wdp wd = ws->display;
+   int wid = ws->width, ht = ws->height;
+   int posx = ws->posx, posy = ws->posy;
+   XTextProperty textprop;
+
+   if (! resizePixmap(w, ws->width, ws->height))
+      return Failed;
+   if (ws->win) {
+      XSync(wd->display, False);
+      pollevent();
+      if (status == 1)
+	 moveWindow(w, posx, posy);
+      else {
+	 if (status == 2)
+	    posx = posy = -MaxInt;
+	 if (moveResizeWindow(w, posx, posy, wid, ht) == Failed)
+	    return Failed;
+	 }
+
+      /* XSync is not enough because the window manager gets involved here. */
+      XFlush(wd->display);			      /* force out request */
+      XGetWMName(wd->display, ws->win, &textprop);    /* force WM round trip */
+      XSync(wd->display, False);		      /* NOW sync */
+      }
+   return Succeeded;
+   }
+
+int setheight(w, new_height)
+wbp w;
+SHORT new_height;
+   {
+   STDLOCALS(w);
+   if (new_height < 0) return Failed;
+   ws->height = size_hints.height = new_height;
+   return Succeeded;
+   }
+
+int setwidth(w, new_width)
+wbp w;
+SHORT new_width;
+{
+   STDLOCALS(w);
+   if (new_width < 0) return Failed;
+   ws->width = size_hints.width = new_width;
+   return Succeeded;
+}
+
+int setgeometry(w, geo)
+wbp w;
+char *geo;
+   {
+   int width = 0, height = 0;
+   int x = 0, y = 0, status;
+   STDLOCALS(w);
+
+   if ((status = parsegeometry(geo, &x, &y, &width, &height)) == 0)
+      return Error;
+   if (status & 1) {
+      ws->width = size_hints.width = width;
+      ws->height = size_hints.height = height;
+      }
+   /*
+    * can't set position on hidden windows
+    */
+   if ((stdwin || !stdpix) && (status & 2)) {
+      ws->posx = x;
+      ws->posy = y;
+      }
+   /* insert assigns here:
+    *  ws->posx = ((sign > 0) ? tmp :
+    *              DisplayWidth(stddpy,wd->screen) - ws->width - tmp);
+    *  ws->posy = ((sign > 0) ? tmp :
+    *              DisplayHeight(stddpy,wd->screen) - ws->height - tmp);
+    */
+   return Succeeded;
+   }
+
+int allowresize(w, on)
+wbp w;
+int on;
+   {
+   if (on)
+      SETRESIZABLE(w);
+   else
+      CLRRESIZABLE(w);
+   return Succeeded;
+   }
+
+void warpPointer(w, x, y)
+wbp w;
+int x, y;
+   {
+   wsp ws = w->window;
+   XWarpPointer(ws->display->display, None, ws->win, 0,0,0,0, x, y);
+   }
+
+/*
+ * #@#@ This is a bug
+ */
+int seticonlabel(w, val)
+wbp w;
+char *val;
+   {
+   STDLOCALS(w);
+   if (ws->iconlabel != NULL) free(ws->iconlabel);
+   if ((ws->iconlabel = salloc(val)) == NULL)
+      ReturnErrNum(305, Error);
+
+   if (stddpy && stdwin) {
+      XSetIconName(stddpy, stdwin, w->window->iconlabel);
+      if (ws->iconic == IconicState && !ws->iconpix && ws->iconwin) {
+	 XClearWindow(stddpy, ws->iconwin);
+	 XDrawString(stddpy, ws->iconwin, wd->icongc, 4,
+		     wd->fonts->fsp->max_bounds.ascent + 2,
+		     ws->iconlabel, strlen(ws->iconlabel));
+	 }
+      }
+   return Succeeded;
+   }
+
+/*
+ * setwindowlabel
+ */
+int setwindowlabel(w, s)
+wbp w;
+char *s;
+{
+   wsp ws = w->window;
+   if (ws->windowlabel != NULL) free(ws->windowlabel);
+   if ((ws->windowlabel = salloc(s)) == NULL)
+      ReturnErrNum(305, Error);
+   if (ws->display && ws->display->display && ws->win)
+      XStoreName(ws->display->display, ws->win,
+	 *ws->windowlabel ? ws->windowlabel : " ");    /* empty string fails */
+   return Succeeded;
+}
+
+/*
+ * setcursor() - a no-op under X at present
+ */
+int setcursor(w, on)
+wbp w;
+int on;
+{
+   if (on)
+      SETCURSORON(w);
+   else
+      CLRCURSORON(w);
+   return Succeeded;
+}
+
+
+/*
+ * setpointer() - define a mouse pointer shape
+ */
+int setpointer(w, val)
+wbp w;
+char *val;
+   {
+   int i = si_s2i(cursorsyms,val) >> 1;
+   STDLOCALS(w);
+   if (i < 0 || i >= NUMCURSORSYMS) return Failed;
+
+   ws->theCursor = i;
+   if (!(wd->cursors[i]))
+      wd->cursors[i] = XCreateFontCursor(stddpy, 2 * i);
+   if (stdwin)
+      XDefineCursor(stddpy, stdwin, wd->cursors[i]);
+   return Succeeded;
+   }
+
+/*
+ * setdrawop() - set the drawing operation
+ */
+int setdrawop(w, val)
+wbp w;
+char *val;
+   {
+   STDLOCALS(w);
+   XSync(stddpy, False);
+   if (!strcmp(val,"reverse")) {
+      if (!ISXORREVERSE(w)) {
+	 SETXORREVERSE(w);
+	 wc->drawop = GXxor;
+	 if (stdgc)
+	    XSetForeground(stddpy, stdgc, wc->fg->c ^ wc->bg->c);
+	 }
+      }
+   else {
+      if (ISXORREVERSE(w)) {
+	 CLRXORREVERSE(w);
+	 if (stdgc)
+	    XSetForeground(stddpy, stdgc, wc->fg->c);
+	 }
+      wc->drawop = si_s2i(drawops,val);
+      if (wc->drawop == -1) { wc->drawop = GXcopy; return Error; }
+      }
+   if (stdgc) XSetFunction(stddpy, stdgc, wc->drawop);
+   return Succeeded;
+   }
+
+/*
+ * rebind() - bind w's context to that of w2.
+ */
+int rebind(w, w2)
+wbp w, w2;
+   {
+   if (w->window->display != w2->context->display) return Failed;
+   w->context = w2->context;
+   return Succeeded;
+   }
+
+
+void setclip(w)
+wbp w;
+   {
+   wcp wc = w->context;
+   XRectangle rec;
+   if (wc->gc) {
+      rec.x = wc->clipx;
+      rec.y = wc->clipy;
+      rec.width = wc->clipw;
+      rec.height = wc->cliph;
+      XSetClipRectangles(wc->display->display, wc->gc, 0, 0, &rec, 1,Unsorted);
+      }
+   }
+
+void unsetclip(w)
+wbp w;
+   {
+   wcp wc = w->context;
+   if (wc->gc) {
+      XSetClipMask(wc->display->display, wc->gc, None);
+      }
+   }
+
+void getcanvas(w, s)
+wbp w;
+char *s;
+   {
+   if (w->window->win == (Window) NULL) sprintf(s, "hidden");
+   else
+      switch (w->window->iconic) {
+      case RootState:
+	 sprintf(s, "root");
+	 break;
+      case NormalState:
+	 sprintf(s, "normal");
+	 break;
+      case IconicState:
+	 sprintf(s, "iconic");
+	 break;
+      case MaximizedState:
+	 sprintf(s, "maximal");
+	 break;
+      case HiddenState:
+	 sprintf(s, "hidden");
+	 break;
+      default:
+	 sprintf(s, "???");
+      }
+   }
+
+/*
+ *  Set the canvas type, either during open (pixmap is null, set a flag)
+ *   or change an existing canvas to a different type.
+ */
+int setcanvas(w,s)
+wbp w;
+char *s;
+   {
+   int hm;
+   XTextProperty textprop;
+   STDLOCALS(w);
+
+   if (!strcmp(s, "iconic")) {
+      if (ws->pix == (Pixmap) NULL) {
+	 ws->wmhintflags |= StateHint;
+	 ws->iconic = IconicState;
+	 }
+      else {
+	 if (ws->iconic != IconicState) {
+#ifdef Iconify
+	    if (ws->win == (Window) NULL) {
+	       wmap(w);
+	       }
+	    XIconifyWindow(ws->display->display, ws->win, ws->display->screen);
+	    XSync(stddpy, False);
+	    while (ws->iconic != IconicState)
+	       if ((hm = handle_misc(wd, NULL)) < 1) {
+		  if (hm == -1) return Error;
+		  else if (hm == 0) {
+		     return Failed;
+		     }
+		  }
+#else					/* Iconify */
+	    return Failed;
+#endif					/* Iconify */
+	    }
+	 }
+      }
+
+   else if (!strcmp(s, "normal")) {
+      if (ws->pix == (Pixmap) NULL) {
+	 ws->iconic = NormalState;
+	 }
+      else {
+	 if (ws->win == (Window) NULL) {
+	    ws->iconic = NormalState;
+	    ws->initialPix = ws->pix;
+	    ws->pix = (Window) NULL;
+	    wmap(w);
+	    }
+	 else if (ws->iconic == IconicState) {
+	    XMapWindow(stddpy, stdwin);
+	    XSync(stddpy, False);
+	    while (ws->iconic == IconicState)
+	       pollevent();
+	    }
+	 else if (ws->iconic == MaximizedState) {
+	    moveResizeWindow(w, ws->normalx, ws->normaly,
+			     ws->normalw, ws->normalh);
+	    ws->iconic = NormalState;
+	    }
+	 }
+      }
+   else if (!strcmp(s, "maximal")) {
+      if (ws->iconic != MaximizedState) {
+	 int expect_config= (ws->width != DisplayWidth(stddpy, wd->screen)) ||
+	    (ws->height != DisplayHeight(stddpy, wd->screen));
+	 ws->normalx = ws->posx;
+	 ws->normaly = ws->posy;
+	 ws->normalw = ws->width;
+	 ws->normalh = ws->height;
+	 ws->width = DisplayWidth(stddpy, wd->screen);
+	 ws->height= DisplayHeight(stddpy, wd->screen);
+	 if (ws->pix != (Pixmap) NULL) {
+	    if (ws->win == (Window) NULL) {
+	       ws->iconic = MaximizedState;
+	       ws->initialPix = ws->pix;
+	       ws->pix = (Window) NULL;
+	       wmap(w);
+	       }
+	    else if (ws->iconic == IconicState) {
+	       XMapWindow(stddpy, stdwin);
+	       XSync(stddpy, False);
+	       while (ws->iconic == IconicState)
+		  pollevent();
+	       }
+	    else if (expect_config) {
+	       moveResizeWindow(w, 0, 0, ws->width, ws->height);
+	       /* XSync is not enough because window manager gets involved. */
+	       XFlush(wd->display);			      /* flush req */
+	       XGetWMName(wd->display, ws->win, &textprop);   /* force WM RT */
+	       XSync(wd->display, False);		      /* NOW sync */
+	       if (pollevent() == -1) return Error;
+	       moveWindow(w, -ws->posx, -ws->posy);
+	       XFlush(wd->display);			      /* flush req */
+	       XGetWMName(wd->display, ws->win, &textprop);   /* force WM RT */
+	       XSync(wd->display, False);		      /* NOW sync */
+	       }
+	    }
+	 ws->iconic = MaximizedState;
+	 }
+      }
+   else if (!strcmp(s, "hidden")) {
+      if (ws->pix == (Pixmap)NULL) {
+	 ws->iconic = HiddenState;
+	 }
+      else {
+	 if (ws->win != (Window) NULL) {
+	    if (ws->iconic == MaximizedState) {
+	       ws->posx = ws->normalx;
+	       ws->posy = ws->normaly;
+	       ws->width = ws->normalw;
+	       ws->height = ws->normalh;
+	       ws->iconic = NormalState;
+	       }
+	    if (ws->iconic != IconicState) {
+	       SETZOMBIE(w);
+	       XDestroyWindow(stddpy, stdwin);
+	       XFlush(stddpy);
+	       while (ws->win)
+		  if (pollevent() == -1)
+		     return Error;
+	       }
+	    }
+	 }
+      }
+   else return Error;
+   XSync(ws->display->display, False);
+   return Succeeded;
+   }
+
+int seticonicstate(w,s)
+wbp w;
+char *s;
+   {
+   STDLOCALS(w);
+
+   if (!strcmp(s, "icon")) {
+      if (ws->pix == (Pixmap) NULL) {
+	 ws->wmhintflags |= StateHint;
+	 ws->iconic = IconicState;
+	 }
+      else {
+	 if (ws->iconic != IconicState) {
+#ifdef Iconify
+	    XIconifyWindow(ws->display->display, ws->win, ws->display->screen);
+#else					/* Iconify */
+	    return Failed;
+#endif					/* Iconify */
+	    }
+	 }
+      }
+   else if (!strcmp(s, "window")) {
+      if (ws->win != (Window) NULL) {
+	 if (ws->iconic == IconicState) {
+	    XMapWindow(stddpy, stdwin);
+	    }
+	 }
+      }
+   else if (!strcmp(s, "root")) {
+      if (ws->win == (Window) NULL)
+	 ws->iconic = RootState;
+      else return Failed;
+      }
+   else return Error;
+   XSync(ws->display->display, False);
+   return Succeeded;
+   }
+
+int seticonpos(w,s)
+wbp w;
+char *s;
+   {
+   char *s2;
+   wsp ws = w->window;
+
+   ws->wmhintflags |= IconPositionHint;
+   s2 = s;
+   ws->iconx = atol(s2);
+   while (isspace(*s2)) s2++;
+   while (isdigit(*s2)) s2++;
+   if (*s2++ != ',') return Error;
+   ws->icony = atol(s2);
+
+   if (ws->win) {
+      if (ws->iconwin == (Window) NULL)
+	 makeIcon(w, ws->iconx, ws->icony);
+      if (remap(w, ws->iconx, ws->icony) == -1) return Error;
+      }
+   return Succeeded;
+   }
+
+int geticonpos(w, s)
+wbp w;
+char *s;
+   {
+   wsp ws = w->window;
+   sprintf(s,"%d,%d", ws->iconx, ws->icony);
+   return Succeeded;
+   }
+
+
+/*
+ * if the window exists and is visible, set its position to (x,y)
+ */
+void moveWindow(w,x,y)
+wbp w;
+int x, y;
+{
+   STDLOCALS(w);
+   ws->posx = x;
+   ws->posy = y;
+   if (stdwin) {
+      XMoveWindow(stddpy, stdwin, ws->posx, ws->posy);
+      XSync(stddpy, False);
+      }
+}
+
+int moveResizeWindow(w, x, y, width, height)
+wbp w;
+int x, y, width, height;
+   {
+   wsp ws = w->window;
+   wdp wd = ws->display;
+   ws->width = width;
+   ws->height = height;
+
+   size_hints.flags = PMinSize | PMaxSize;
+   if (ISRESIZABLE(w)) {
+      size_hints.min_width = 0;
+      size_hints.min_height = 0;
+      size_hints.max_width = DisplayWidth(wd->display, wd->screen);
+      size_hints.max_height = DisplayHeight(wd->display, wd->screen);
+      }
+   else {
+      size_hints.min_width = size_hints.max_width = width;
+      size_hints.min_height = size_hints.max_height = height;
+      }
+   XSetNormalHints(wd->display, ws->win, &size_hints);
+
+   if (resizePixmap(w, width, height) == 0) return Failed;
+
+   if (ws->win != (Window) NULL) {
+      if (x == -MaxInt && y == -MaxInt)
+	 XResizeWindow(wd->display, ws->win, width, height);
+      else
+         XMoveResizeWindow(wd->display, ws->win, x, y, width, height);
+      XSync(wd->display, False);
+      }
+   return Succeeded;
+   }
+
+/*
+ * Set the context's fill style by name.
+ */
+int setfillstyle(w, s)
+wbp w;
+char *s;
+   {
+   STDLOCALS(w);
+
+   if (!strcmp(s, "solid")) {
+      wc->fillstyle = FillSolid;
+      }
+   else if (!strcmp(s, "masked")
+	    || !strcmp(s, "stippled") || !strcmp(s, "patterned")) {
+      wc->fillstyle = FillStippled;
+      }
+   else if (!strcmp(s, "textured")
+      || !strcmp(s, "opaquestippled") || !strcmp(s, "opaquepatterned")) {
+      wc->fillstyle = FillOpaqueStippled;
+      }
+   else return Error;
+   if (stdpix) {
+      XSetFillStyle(stddpy, stdgc, wc->fillstyle);
+      }
+   return Succeeded;
+   }
+
+/*
+ * Set the context's line style by name.
+ */
+int setlinestyle(w, s)
+wbp w;
+char *s;
+   {
+   STDLOCALS(w);
+
+   if (!strcmp(s, "solid")) {
+      wc->linestyle = LineSolid;
+      }
+   else if (!strcmp(s, "onoff") || !strcmp(s, "dashed")) {
+      wc->linestyle = LineOnOffDash;
+      }
+   else if (!strcmp(s, "doubledash") || !strcmp(s, "striped")) {
+      wc->linestyle = LineDoubleDash;
+      }
+   else return Error;
+   if (stdpix) {
+      XSetLineAttributes(stddpy, stdgc,
+	 wc->linewidth, wc->linestyle, CapProjecting, JoinMiter);
+      }
+   return Succeeded;
+   }
+
+/*
+ * Set the context's line width
+ */
+int setlinewidth(w, linewid)
+wbp w;
+LONG linewid;
+   {
+   unsigned long gcmask;
+   XGCValues gcv;
+   STDLOCALS(w);
+
+   if (linewid < 0) return Error;
+   wc->linewidth = linewid;
+   if (stdpix) {
+      gcv.line_width = linewid;
+      gcv.line_style = wc->linestyle;
+      if (linewid > 1)
+         gcv.dashes = 3 * wc->linewidth;
+      else
+	 gcv.dashes = 4;
+      gcmask = GCLineWidth | GCLineStyle | GCDashList;
+      XChangeGC(stddpy, stdgc, gcmask, &gcv);
+      }
+
+   return Succeeded;
+   }
+
+/*
+ * Reset the context's foreground color to whatever it is supposed to be.
+ */
+int resetfg(w)
+wbp w;
+   {
+   wcp wc = w->context;
+   if (wc->gc != NULL)
+      XSetForeground(wc->display->display, wc->gc,
+		     wc->fg->c ^ (ISXORREVERSE(w) ? wc->bg->c : 0));
+   return Succeeded;
+   }
+
+/*
+ * Set the context's foreground color by name.
+ */
+int setfg(w,s)
+wbp w;
+char *s;
+   {
+   wclrp cp;
+   STDLOCALS(w);
+
+   Protect(cp = alc_color(w,s), return Failed);
+   wc->fg = cp;
+   return resetfg(w);
+   }
+
+int setfgrgb(w, r, g, b)
+wbp w;
+int r, g, b;
+{
+   char sbuf1[MaxCvtLen];
+   sprintf(sbuf1, "%d,%d,%d", r, g, b);
+   return setfg(w, sbuf1);
+}
+
+/*
+ * Set the context's foreground color by color cell.
+ */
+int isetfg(w,fg)
+wbp w;
+int fg;
+   {
+   int i, r, g, b;
+   STDLOCALS(w);
+
+   if (fg >= 0) {
+      b = fg & 255;
+      fg >>= 8;
+      g = fg & 255;
+      fg >>= 8;
+      r = fg & 255;
+      return setfgrgb(w, r * 257, g * 257, b * 257);
+      }
+   for (i = 2; i < wd->numColors; i++)
+      if (wd->colrptrs[i]->type == MUTABLE && wd->colrptrs[i]->c == -fg - 1)
+	 break;
+   if (i == wd->numColors) return Failed;
+   wc->fg = wd->colrptrs[i];
+   return resetfg(w);
+   }
+
+/*
+ * Set the window context's background color by name.
+ */
+int setbg(w,s)
+wbp w;
+char *s;
+   {
+   wclrp cp;
+   STDLOCALS(w);
+
+   Protect(cp = alc_color(w,s), return Failed);
+   wc->bg = cp;
+
+   if (stdgc != NULL)
+      XSetBackground(stddpy, stdgc, wc->bg->c);
+   return ISXORREVERSE(w) ? resetfg(w) : Succeeded;
+   }
+
+int setbgrgb(w, r, g, b)
+wbp w;
+int r, g, b;
+{
+   char sbuf1[MaxCvtLen];
+   sprintf(sbuf1, "%d,%d,%d", r, g, b);
+   return setbg(w, sbuf1);
+}
+
+/*
+ * Set the context's background color by color cell.
+ */
+int isetbg(w,bg)
+wbp w;
+int bg;
+   {
+   int i, r, g, b;
+   STDLOCALS(w);
+
+   if (bg >= 0) {
+      b = bg & 255;
+      bg >>= 8;
+      g = bg & 255;
+      bg >>= 8;
+      r = bg & 255;
+      return setbgrgb(w, r * 257, g * 257, b * 257);
+      }
+   for (i = 2; i < wd->numColors; i++)
+      if (wd->colrptrs[i]->type == MUTABLE && wd->colrptrs[i]->c == -bg - 1)
+	 break;
+   if (i == wd->numColors) return Failed;
+   wc->bg = wd->colrptrs[i];
+   if (stdgc != NULL)
+      XSetBackground(stddpy, stdgc, wc->bg->c);
+   return ISXORREVERSE(w) ? resetfg(w) : Succeeded;
+   }
+
+/*
+ * Set the gamma correction value.
+ */
+int setgamma(w, gamma)
+wbp w;
+double gamma;
+   {
+   w->context->gamma = gamma;
+   setfg(w, w->context->fg->name);	/* reinterpret current Fg/Bg spec */
+   setbg(w, w->context->bg->name);
+   return Succeeded;
+   }
+
+/*
+ * Set the display by name.  Really should cache answers as per fonts below;
+ * for now just open a new display each time.  Note that this can only be
+ * called before a window is instantiated...
+ */
+int setdisplay(w,s)
+wbp w;
+char *s;
+   {
+   wdp d;
+   /* can't change display for mapped window! */
+   if (w->window->pix != (Pixmap) NULL)
+      return Failed;
+
+   Protect(d = alc_display(s), return 0);
+   w->window->display = d;
+   w->context->fg = d->colrptrs[0];
+   w->context->bg = d->colrptrs[1];
+   w->context->font = d->fonts;
+   return Succeeded;
+   }
+
+int setleading(w, i)
+wbp w;
+int i;
+{
+   w->context->leading = i;
+   return Succeeded;
+}
+
+int setimage(w, val)
+wbp w;
+char *val;
+   {
+   wsp ws = w->window;
+   int status;
+   ws->initialPix = loadimage(w, val, &(ws->height), &(ws->width),
+			  0, &status);
+   if (ws->initialPix == (Pixmap) NULL) return Failed;
+   return Succeeded;
+   }
+
+void toggle_fgbg(w)
+wbp w;
+{
+   wclrp tmp;
+   STDLOCALS(w);
+   tmp = wc->fg;
+   wc->fg = wc->bg;
+   wc->bg = tmp;
+   if (stdpix) {
+      XSetForeground(stddpy, stdgc,
+		     wc->fg->c ^ (ISXORREVERSE(w)?wc->bg->c:0));
+      XSetBackground(stddpy, stdgc, wc->bg->c);
+      }
+}
+
+void getdisplay(w, answer)
+wbp w;
+char *answer;
+   {
+   char *tmp;
+   wdp wd = w->window->display;
+   if (!strcmp(wd->name, "")) {
+      if ((tmp = getenv("DISPLAY")) != NULL)
+	 sprintf(answer, "%s", tmp);
+      else
+	 *answer = '\0';
+      }
+   else sprintf(answer, "%s", wd->name);
+   }
+
+int getvisual(w, answer)
+wbp w;
+char *answer;
+{
+   wdp wd = w->window->display;
+   Visual * v = DefaultVisual(wd->display,wd->screen);
+   sprintf(answer, "%d,%d,%d", v->class, v->bits_per_rgb, v->map_entries );
+   return Succeeded;
+}
+/*
+ * getpos() - update the window state's notion of its current position
+ */
+int getpos(w)
+wbp w;
+{
+   Window garbage1, garbage2;
+   int root_x, root_y, win_x, win_y;
+   unsigned int key_buttons;
+   STDLOCALS(w);
+   if (!stdwin) return Failed;
+   /*
+    * This call is made because it is guaranteed to generate
+    * a synchronous request of the server, not just ask Xlib
+    * what the window position was last it knew.
+    */
+   if (XQueryPointer(stddpy, stdwin, &garbage1, &garbage2,
+		     &root_x, &root_y, &win_x, &win_y, &key_buttons) ==
+       False) {
+      return Failed;
+      }
+   ws->posx = root_x - win_x;
+   ws->posy = root_y - win_y;
+   return Succeeded;
+}
+
+void getfg(w, answer)
+wbp w;
+char *answer;
+{
+   sprintf(answer, "%s", w->context->fg->name);
+}
+
+void getbg(w, answer)
+wbp w;
+char *answer;
+{
+   sprintf(answer, "%s", w->context->bg->name);
+}
+
+void getlinestyle(w, answer)
+wbp w;
+char *answer;
+{
+   wcp wc = w->context;
+   sprintf(answer,"%s",
+	   (wc->linestyle==LineSolid)?"solid":
+	   ((wc->linestyle==LineOnOffDash)?"dashed":"striped"));
+}
+
+void getfntnam(w, answer)
+wbp w;
+char *answer;
+{
+   sprintf(answer,"%s", w->context->font->name);
+}
+
+void getpointername(w, answer)
+wbp w;
+char *answer;
+{
+   strcpy(answer, si_i2s(cursorsyms, 2 * w->window->theCursor));
+}
+
+void getdrawop(w, answer)
+wbp w;
+char *answer;
+{
+   char *s;
+   if (ISXORREVERSE(w)) s = "reverse";
+   else s = si_i2s(drawops, w->context->drawop);
+   if (s) sprintf(answer, "%s", s);
+   else strcpy(answer, "copy");
+}
+
+void geticonic(w, answer)
+wbp w;
+char *answer;
+{
+   switch (w->window->iconic) {
+   case RootState:
+     sprintf(answer, "root");
+     break;
+   case NormalState:
+     sprintf(answer, "window");
+     break;
+   case IconicState:
+     sprintf(answer, "icon");
+     break;
+   default:
+     sprintf(answer, "???");
+   }
+}
+
+/*
+ * Set the window's font by name.
+ */
+int setfont(w,s)
+wbp w;
+char **s;
+   {
+   wfp tmp;
+   STDLOCALS(w);
+
+   /* could free up previously allocated font here */
+
+   Protect(tmp = alc_font(w,s), return Failed);
+   wc->font = tmp;
+
+   if (stdgc != NULL)
+      XSetFont(stddpy, stdgc, wc->font->fsp->fid);
+
+   if (stdpix == (Pixmap) NULL) {
+      ws->y = wc->font->fsp->max_bounds.ascent;
+      ws->x = 0;
+      }
+   return Succeeded;
+   }
+
+/*
+ * callback procedures
+ */
+
+static int handle_exposures(w, event)
+wbp w;
+XExposeEvent *event;
+   {
+   int returnval;
+   STDLOCALS(w);
+
+   returnval = ISEXPOSED(w);
+   SETEXPOSED(w);
+   if (stdwin && !ISZOMBIE(w)) {
+      if (wc->drawop != GXcopy)
+	 XSetFunction(stddpy, stdgc, GXcopy);
+      if (wc->clipw >= 0)
+	 unsetclip(w);
+      XCopyArea(stddpy, stdpix, stdwin, stdgc, event->x,event->y,
+		event->width,event->height, event->x,event->y);
+      if (wc->clipw >= 0)
+	 setclip(w);
+      if (wc->drawop != GXcopy)
+	 XSetFunction(stddpy,stdgc,wc->drawop);
+      }
+   return returnval;
+   }
+#ifndef min
+#define min(x,y) (((x)<(y))?(x):(y))
+#define max(x,y) (((x)>(y))?(x):(y))
+#endif
+
+/*
+ * resizePixmap(w,width,height) -- ensure w's backing pixmap is at least
+ * width x height pixels.
+ *
+ * Resizes the backing pixmap, if needed.  Called when X resize events
+ * arrive, as well as when programs make explicit resize requests.
+ *
+ * Returns 0 on failure.
+ */
+int resizePixmap(w,width,height)
+wbp w;
+int width;
+int height;
+   {
+   Pixmap p;
+   STDLOCALS(w);
+   if (ws->pix == (Pixmap) NULL) return 1;
+   if ((width > ws->pixwidth) || (height > ws->pixheight)) {
+      int x = ws->pixwidth, y = ws->pixheight;
+
+      ws->pixheight = max(ws->pixheight, height);
+      ws->pixwidth  = max(ws->pixwidth, width);
+      p = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), ws->pixwidth,
+			ws->pixheight, DefaultDepth(stddpy,wd->screen));
+      if (p == (Pixmap) NULL)
+	 return 0;
+
+      /*
+       * This staggering amount of redudancy manages to make sure the new
+       * pixmap gets initialized including areas not in the old pixmap.
+       * The window is redrawn.
+       */
+      XSetForeground(stddpy, stdgc, wc->bg->c);
+      if (wc->drawop != GXcopy)
+	 XSetFunction(stddpy, stdgc, GXcopy);
+      if (wc->fillstyle != FillSolid)
+	 XSetFillStyle(stddpy, stdgc, FillSolid);
+      if (wc->clipw >= 0)
+	 unsetclip(w);
+
+      if (width > x) {
+	 XFillRectangle(stddpy, p, stdgc, x, 0, width-x, ws->pixheight);
+	 if (stdwin != (Window) NULL)
+	    XFillRectangle(stddpy,stdwin,stdgc, x, 0, width-x, ws->pixheight);
+         }
+      if (height > y) {
+	 XFillRectangle(stddpy, p, stdgc, 0, y, x, height - y);
+	 if (stdwin != (Window) NULL)
+	    XFillRectangle(stddpy, stdwin, stdgc, 0, y, x, height - y);
+         }
+      XSetForeground(stddpy, stdgc, wc->fg->c ^ (ISXORREVERSE(w)?wc->bg->c:0));
+      XCopyArea(stddpy, stdpix, p, stdgc, 0, 0, x, y, 0, 0);
+      if (wc->drawop != GXcopy)
+	 XSetFunction(stddpy,stdgc,wc->drawop);
+      if (wc->fillstyle != FillSolid)
+	 XSetFillStyle(stddpy, stdgc, wc->fillstyle);
+      if (wc->clipw >= 0)
+	 setclip(w);
+
+      XFreePixmap(stddpy, stdpix);	/* free old pixmap */
+      ws->pix = p;
+      }
+   return 1;
+   }
+
+/*
+ * Resize operations are made as painless as possible, but the
+ * user program is informed anyhow.  The integer coordinates are
+ * the new size of the window, in pixels.
+ */
+static int handle_config(w, event)
+wbp w;
+XConfigureEvent *event;
+   {
+   struct descrip d;
+   STDLOCALS(w);
+
+   /*
+    * Update X-Icon's information about the window's configuration
+    */
+   ws->x = min(ws->x, event->width - FWIDTH(w));
+   ws->y = min(ws->y, event->height);
+
+   ws->posx = event->x;
+   ws->posy = event->y;
+
+   /*
+    * If this was not a resize, drop it
+    */
+   if ((event->width == ws->width) && (event->height == ws->height))
+      return 1;
+
+   ws->width = event->width;
+   ws->height = event->height;
+
+   if (! resizePixmap(w, event->width, event->height)) return 0;
+
+   /*
+    * The initial configure event generates no Icon-level "events"
+    */
+   if (!ISEXPOSED(w))
+      return 1;
+
+   MakeInt(RESIZED, &d);
+   qevent(w->window, &d, ws->width, ws->height, ~(uword)0, 0);
+   return 1;
+   }
+
+/*
+ * Queue up characters for keypress events.
+ */
+static void handle_keypress(w,event)
+wbp w;
+XKeyEvent *event;
+   {
+   int i,j;
+   char s[10];
+   struct descrip d;
+   KeySym k;
+
+   w->window->pointerx = event->x;
+   w->window->pointery = event->y;
+
+   switch (i=translate_key_event(event, s, &k)) {
+   case -1:
+      return;
+   case 0:
+      MakeInt(k, &d);
+      qevent(w->window, &d, event->x, event->y,
+	     (uword)event->time, event->state);
+      break;
+   default:
+      StrLen(d) = 1;
+      for (j = 0; j < i; j++) {
+	 StrLoc(d) = (char *)&allchars[s[j] & 0xFF];
+	 qevent(w->window, &d, event->x, event->y,
+		(uword)event->time, event->state);
+	 }
+      }
+   }
+
+#define swap(a,b) { tmp = a; a = b; b = tmp; }
+/*
+ * Handle button presses and drag events.  In the case of drags, we should
+ * really be looking at an XMotionEvent instead of an XButtonEvent, but
+ * the structures are identical up to the button field (which we do not
+ * examine for drag events).  Mouse coordinates are queued up after the event.
+ */
+static void handle_mouse(w,event)
+wbp w;
+XButtonEvent *event;
+   {
+   static unsigned int buttonorder[3] =
+     { Button1Mask, Button2Mask, Button3Mask };
+   unsigned int tmp;
+   int eventcode = 0;
+   struct descrip d;
+
+   if (event->type == MotionNotify) {
+      if (event->state | buttonorder[0]) {
+         if (buttonorder[0] == Button1Mask)
+	    eventcode = MOUSELEFTDRAG;
+         else if (buttonorder[0] == Button2Mask)
+            eventcode = MOUSEMIDDRAG;
+         else
+            eventcode = MOUSERIGHTDRAG;
+         }
+      else if (event->state | buttonorder[1]) {
+         if (buttonorder[1] == Button1Mask)
+	    eventcode = MOUSELEFTDRAG;
+         else if (buttonorder[1] == Button2Mask)
+            eventcode = MOUSEMIDDRAG;
+         else
+            eventcode = MOUSERIGHTDRAG;
+         }
+      else if (event->state | buttonorder[2]) {
+         if (buttonorder[2] == Button1Mask)
+	    eventcode = MOUSELEFTDRAG;
+         else if (buttonorder[2] == Button2Mask)
+            eventcode = MOUSEMIDDRAG;
+         else
+            eventcode = MOUSERIGHTDRAG;
+         }
+      }
+   else switch (event->button) {
+      case Button1: {
+	 eventcode = MOUSELEFT;
+	 if (buttonorder[2] == Button1Mask)
+	    swap(buttonorder[1],buttonorder[2]);
+	 if (buttonorder[1] == Button1Mask)
+	    swap(buttonorder[0],buttonorder[1]);
+	 break;
+         }
+      case Button2: {
+	 eventcode = MOUSEMID;
+	 if (buttonorder[2] == Button2Mask)
+	    swap(buttonorder[1],buttonorder[2]);
+	 if (buttonorder[1] == Button2Mask)
+	    swap(buttonorder[0],buttonorder[1]);
+	 break;
+         }
+      case Button3: {
+	 eventcode = MOUSERIGHT;
+	 if (buttonorder[2] == Button3Mask)
+	    swap(buttonorder[1],buttonorder[2]);
+	 if (buttonorder[1] == Button3Mask)
+	    swap(buttonorder[0],buttonorder[1]);
+	 break;
+         }
+      }
+   if (event->type == ButtonRelease) {
+      eventcode -= (MOUSELEFT - MOUSELEFTUP);
+      swap(buttonorder[0],buttonorder[1]);
+      swap(buttonorder[1],buttonorder[2]);
+      }
+
+   w->window->pointerx = event->x;
+   w->window->pointery = event->y;
+   MakeInt(eventcode,&d);
+   qevent(w->window, &d, event->x, event->y, (uword)event->time, event->state);
+   }
+
+
+/*
+ * fill a series of rectangles
+ */
+void fillrectangles(w, recs, nrecs)
+wbp w;
+XRectangle *recs;
+int nrecs;
+   {
+   STDLOCALS(w);
+
+   /*
+    * Free colors if drawop=copy, fillstyle~=masked, no clipping,
+    * and a single rectangle that fills the whole window.
+    */
+   if (!RECX(*recs) && !RECY(*recs) && RECWIDTH(*recs) >= ws->width &&
+      RECHEIGHT(*recs) >= ws->height && nrecs == 1 &&
+      wc->drawop == GXcopy && wc->fillstyle != FillStippled && wc->clipw < 0) {
+         RECWIDTH(*recs) = ws->pixwidth;	/* fill hidden part */
+	 RECHEIGHT(*recs) = ws->pixheight;
+	 free_xcolors(w, 0);			/* free old colors */
+	 }
+   RENDER2(XFillRectangles, recs, nrecs);
+   }
+
+/*
+ * erase an area
+ */
+void eraseArea(w,x,y,width,height)
+wbp w;
+int x, y, width, height;
+   {
+   STDLOCALS(w);
+
+   /*
+    * if width >= window width or height >= window height, clear any
+    * offscreen portion as well in order to allow the freeing of colors.
+    */
+   if (x + width  >= ws->width)  width  = ws->pixwidth - x;
+   if (y + height >= ws->height) height = ws->pixheight - y;
+
+   /*
+    * fill the rectangle with the background color
+    */
+   XSetForeground(stddpy, stdgc, wc->bg->c);
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+   if (wc->fillstyle != FillSolid) XSetFillStyle(stddpy, stdgc, FillSolid);
+   RENDER4(XFillRectangle, x, y, width, height);
+   XSetForeground(stddpy, stdgc, wc->fg->c ^ (ISXORREVERSE(w)?wc->bg->c:0));
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+   if (wc->fillstyle != FillSolid) XSetFillStyle(stddpy, stdgc, wc->fillstyle);
+
+   /*
+    * if the entire window is cleared, free up colors
+    */
+   if (!x && !y && width >= ws->pixwidth && height >= ws->pixheight &&
+      wc->clipw < 0)
+      free_xcolors(w, 0);
+   }
+
+/*
+ * copy an area
+ */
+int copyArea(w,w2,x,y,width,height,x2,y2)
+wbp w, w2;
+int x, y, width, height, x2, y2;
+   {
+   int lpad, rpad, tpad, bpad;
+   Pixmap src;
+   wsp ws1 = w->window, ws2 = w2->window;
+   wclrp cp1, cp2 = NULL, *cpp;
+   STDLOCALS(w2);
+
+   if (w->window->display->display != w2->window->display->display) {
+      wdp wd1 = ws1->display;
+      unsigned long c = 0;
+      int i, j;
+      Display *d1 = wd1->display;
+      XColor clr;
+      XImage *xim;
+
+      /*
+       * Copying is between windows on two different displays.
+       */
+      if (x<0 || y<0 || x+width > ws1->pixwidth || y+height > ws1->pixheight)
+	 return Failed;		/*#%#%# BOGUS, NEEDS FIXING */
+      xim = XGetImage(d1, ws1->pix, x, y, width, height,
+		      (1<<DefaultDepth(d1,wd1->screen))-1,XYPixmap);
+      XSetFunction(stddpy, stdgc, GXcopy);
+      for (i=0; i < width; i++) {
+	 for (j=0; j < height; j++) {
+	    clr.pixel = XGetPixel(xim, i, j);
+	    if (cp2 != NULL && c == clr.pixel) {
+	       XSetForeground(stddpy, stdgc, cp2->c);
+	       RENDER2(XDrawPoint, i + x2, j + y2);
+	       continue;
+	       }
+	    c = clr.pixel;
+	    cp2 = NULL;
+	    for (cpp = wd1->colrptrs; cpp < wd1->colrptrs+wd->numColors; cpp++){
+	       cp1 = *cpp;
+	       if (cp1->c == c) {
+		  if (cp1->name[0]=='\0') {
+		     XQueryColor(d1, wd1->cmap, &clr);
+		     cp1->r = clr.red;
+		     cp1->g = clr.green;
+		     cp1->b = clr.blue;
+		     sprintf(cp1->name,"%d,%d,%d",cp1->r,cp1->g,cp1->b);
+		     }
+		  cp2 = alc_rgb(w2, cp1->name, cp1->r, cp1->g, cp1->b, 0);
+		  if (cp2 == NULL) return Failed;
+		  break;
+		  }
+	       }
+	    if (cp2 == NULL) {
+	       XQueryColor(d1, wd1->cmap, &clr);
+	       cp2 = alc_rgb(w2, "unknown", clr.red, clr.green, clr.blue, 0);
+	       }
+	    if (cp2 == NULL) return Failed;
+	    XSetForeground(stddpy, stdgc, cp2->c);
+	    RENDER2(XDrawPoint, i + x2, j + y2);
+	    }
+	 }
+      XSetForeground(stddpy, stdgc,
+		     wc->fg->c ^ (ISXORREVERSE(w2) ? wc->bg->c : 0));
+      XSetFunction(stddpy, stdgc, wc->drawop);
+      XSync(stddpy,False);
+      XDestroyImage(xim);
+      }
+   else {
+      /*
+       * Copying is between windows on one display, perhaps the same window.
+       */
+      src = ws1->pix;
+      if (src != stdpix) {
+	 /* copying between different windows; handle color bookkeeping */
+         if (!x2 && !y2 &&
+            ((width  >= ws2->pixwidth)  || !width) &&
+            ((height >= ws2->pixheight) || !height) && w2->context->clipw < 0)
+	       free_xcolors(w2, 0);
+	 copy_colors(w, w2);
+	 }
+
+      XSetForeground(stddpy, stdgc, wc->bg->c);
+      XSetFunction(stddpy, stdgc, GXcopy);
+
+      if (x+width<0 || y+height<0 || x>=ws1->pixwidth || y>=ws1->pixheight) {
+	 /* source is entirely offscreen */
+         RENDER4(XFillRectangle, x2, y2, width, height);
+         }
+      else {
+	 /*
+	  * Check for source partially offscreen, but copy first and
+	  * fill later in case the source and destination overlap.
+	  */
+	 lpad = rpad = tpad = bpad = 0;
+         if (x < 0) {			/* source extends past left edge */
+	    lpad = -x;
+            width -= lpad;
+            x2 += lpad;
+            x = 0;
+            }
+         if (x + width > ws1->pixwidth) {  /* source extends past right edge */
+            rpad = x + width - ws1->pixwidth;
+            width -= rpad;
+            }
+         if (y < 0) {			/* source extends above top edge */
+	    tpad = -y;
+            height -= tpad;
+            y2 += tpad;
+            y = 0;
+            }
+         if (y + height > ws1->pixheight) {  /* source extends below bottom */
+            bpad = y + height - ws1->pixheight;
+            height -= bpad;
+            }
+	 /*
+	  * Copy the area.
+	  */
+         if (stdwin)
+            XCopyArea(stddpy, src, stdwin, stdgc, x, y, width, height, x2, y2);
+         XCopyArea(stddpy, src, stdpix, stdgc, x, y, width, height, x2, y2);
+	 /*
+	  * Fill any edges not provided by source.
+	  */
+	 if (lpad > 0)
+            RENDER4(XFillRectangle, x2-lpad, y2-tpad, lpad, tpad+height+bpad);
+	 if (rpad > 0)
+            RENDER4(XFillRectangle, x2+width, y2-tpad, rpad, tpad+height+bpad);
+	 if (tpad > 0)
+	    RENDER4(XFillRectangle, x2, y2-tpad, width, tpad);
+	 if (bpad > 0)
+	    RENDER4(XFillRectangle, x2, y2+height, width, bpad);
+	 }
+
+      XSetForeground(stddpy,stdgc,wc->fg->c^(ISXORREVERSE(w2) ? wc->bg->c :0));
+      XSetFunction(stddpy, stdgc, wc->drawop);
+      }
+   return Succeeded;
+   }
+
+int getdefault(w, prog, opt, answer)
+wbp w;
+char *prog, *opt, *answer;
+   {
+   char *p;
+   STDLOCALS(w);
+
+
+   if ((p = XGetDefault(stddpy,prog,opt)) == NULL)
+      return Failed;
+   strcpy(answer, p);
+   return Succeeded;
+   }
+
+
+/*
+ * Allocate a mutable color
+ */
+int mutable_color(w, argv, ac, retval)
+wbp w;
+dptr argv;
+int ac;
+int *retval;
+   {
+   XColor colorcell;
+   LinearColor clr;
+   unsigned long plane_masks[1], pixels[1];
+   char *colorname;
+   tended char  *str;
+   int i;
+   {
+   STDLOCALS(w);
+
+   if (!XAllocColorCells(stddpy,wd->cmap,False,plane_masks,0,pixels,1)) {
+      /*
+       * try again with a virtual colormap
+       */
+      if (!go_virtual(w) ||
+	  !XAllocColorCells(stddpy,wd->cmap,False,plane_masks,0,pixels,1))
+	 return Failed;                         /* cannot allocate an entry */
+      }
+
+   /*
+    * allocate a slot in wdisplay->colors and wstate->theColors arrays
+    */
+   i = alc_centry(wd);
+   if (i == 0)
+      return Failed;
+   wd->colrptrs[i]->type = MUTABLE;
+   wd->colrptrs[i]->c = pixels[0];
+
+   /* save color index as "name", followed by a null string for value */
+   colorname = wd->colrptrs[i]->name;
+   sprintf(colorname, "%ld", -pixels[0] - 1);	/* index is name */
+   colorname = colorname + strlen(colorname) + 1;
+   *colorname = '\0';				/* value unknown */
+
+   if (ws->numColors < WMAXCOLORS) {
+      if (ws->theColors == NULL) {
+	 ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short));
+	 if (ws->theColors == NULL)
+	    return Error;
+	 }
+      ws->theColors[ws->numColors++] = i;
+      }
+
+   if (ac > 0) {                     /* set the color */
+      if (ac != 1) return Error;
+      /*
+       * old-style check for C integer
+       */
+      else if (argv[0].dword == D_Integer) {/* check for color cell */
+	 if (IntVal(argv[0]) >= 0)
+	    return Failed;        /* must be negative */
+	 colorcell.pixel = -IntVal(argv[0]) - 1;
+	 XQueryColor(stddpy, wd->cmap, &colorcell);
+         clr = lcolor(w, colorcell);
+         sprintf(colorname, "%ld,%ld,%ld", clr.red, clr.green, clr.blue);
+	 }
+      else {
+	 if (!cnv:C_string(argv[0],str)) {
+	    ReturnErrVal(103,argv[0], Error);
+	    }
+         if (parsecolor(w, str, &clr.red, &clr.green, &clr.blue) != Succeeded) {
+            free_xcolor(w, pixels[0]);
+	    return Failed;                   /* invalid color specification */
+	    }
+	 strcpy(colorname, str);
+         colorcell = xcolor(w, clr);
+	 }
+      colorcell.pixel = pixels[0];
+      XStoreColor(stddpy, wd->cmap, &colorcell);
+      }
+
+   *retval = (-pixels[0] - 1);
+   return Succeeded;
+   }
+   }
+
+char *get_mutable_name(w, mute_index)
+wbp w;
+int mute_index;
+   {
+   wdp dp;
+   Display *d;
+   int i;
+   char *colorname;
+
+   dp = w->window->display;
+   d = dp->display;
+
+   for (i = 2; i < dp->numColors; i++)
+      if (dp->colrptrs[i]->type == MUTABLE
+      && dp->colrptrs[i]->c == - mute_index - 1)
+         break;
+   if (i == dp->numColors)
+      return NULL;
+   colorname = dp->colrptrs[i]->name;			/* color name field */
+   colorname = colorname + strlen(colorname) + 1;	/* set value follows */
+   return colorname;
+   }
+
+int set_mutable(w, i, s)
+wbp w;
+int i;
+char *s;
+   {
+   LinearColor clr;
+   XColor colorcell;
+   wdp dp = w->window->display;
+
+   if (parsecolor(w, s, &clr.red, &clr.green, &clr.blue) != Succeeded)
+      return Failed;                        /* invalid color specification */
+   colorcell = xcolor(w, clr);
+   colorcell.pixel = -i - 1;
+   XStoreColor(dp->display, dp->cmap, &colorcell);
+   return Succeeded;
+   }
+
+void free_mutable(w, mute_index)
+wbp w;
+int mute_index;
+   {
+   wdp dp;
+   Display *d;
+   int i;
+
+   dp = w->window->display;
+   d = dp->display;
+
+   for (i = 2; i < dp->numColors; i++)
+      if (dp->colrptrs[i]->type == MUTABLE
+      && dp->colrptrs[i]->c == - mute_index - 1)
+         break;
+   if (i != dp->numColors)
+      free_xcolor(w, dp->colrptrs[i]->c);
+   }
+
+
+void freecolor(w, s)
+wbp w;
+char *s;
+   {
+   wdp dp;
+   Display *d;
+   int i;
+   LinearColor clr;
+   XColor color;
+
+   if (parsecolor(w, s, &clr.red, &clr.green, &clr.blue) != Succeeded)
+      return;
+   dp = w->window->display;
+   d = dp->display;
+   color = xcolor(w, clr);
+
+   for (i = 2; i < dp->numColors; i++)
+      if (dp->colrptrs[i]->r == color.red && dp->colrptrs[i]->g == color.green
+      && dp->colrptrs[i]->b == color.blue && dp->colrptrs[i]->type != MUTABLE)
+         break;
+   if (i != dp->numColors)
+      free_xcolor(w, dp->colrptrs[i]->c);
+   }
+
+/*
+ * Draw a bilevel image
+ */
+int blimage(w, x, y, width, height, ch, s, len)
+wbp w;
+int x, y, width, height, ch;
+unsigned char *s;
+word len;
+   {
+   unsigned int m, msk1, c, ix, iy;
+   long fg, bg;
+   XImage *im;
+   STDLOCALS(w);
+
+   /*
+    * Get an XImage structure and free the old color set if possible.
+    */
+   im = getximage(w, x, y, width, height, ch == TCH1);
+   if (im == NULL)
+      return Error;
+
+   /*
+    * Read the image string and set the pixel values.  Note that
+    * the hex digits in sequence fill the rows *right to left*.
+    */
+   m = width % 4;
+   if (m == 0)
+      msk1 = 8;
+   else
+      msk1 = 1 << (m - 1);		/* mask for first byte of row */
+
+   fg = wc->fg->c;
+   bg = wc->bg->c;
+   ix = width;
+   iy = 0;
+   m = msk1;
+   while (len--) {
+      if (isxdigit(c = *s++)) {		/* if hexadecimal character */
+         if (!isdigit(c))		/* fix bottom 4 bits if necessary */
+            c += 9;
+         while (m > 0) {		/* set (usually) 4 pixel values */
+	    --ix;
+	    if (c & m)
+	       XPutPixel(im, ix, iy, fg);
+	    else if (ch != TCH1)	/* if zeroes aren't transparent */
+	       XPutPixel(im, ix, iy, bg);
+            m >>= 1;
+            }
+         if (ix == 0) {			/* if end of row */
+            ix = width;
+            iy++;
+            m = msk1;
+            }
+         else
+            m = 8;
+         }
+      }
+   if (ix > 0)				/* pad final row if incomplete */
+      while (ix < width)
+         XPutPixel(im, ix++, iy, bg);
+
+   /*
+    * Put it on the screen.
+    */
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+   RENDER7(XPutImage, im, 0, 0, x, y, width, height);
+   XDestroyImage(im);
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+   return Succeeded;
+   }
+
+/*
+ * Draw a character-per-pixel image
+ */
+int strimage(w, x, y, width, height, e, s, len, on_icon)
+wbp w;
+int x, y, width, height;
+struct palentry *e;
+unsigned char *s;
+word len;
+int on_icon;
+   {
+   int c, v, ret, trans;
+   unsigned int r, g, b, ix, iy;
+   wclrp cp, cplist[256];
+   char tmp[24];
+   XImage *im;
+   STDLOCALS(w);
+
+   /*
+    * Get an XImage structure and free the old color set if possible.
+    */
+   trans = 0;
+   for (c = 0; c < 256; c++)
+      trans |= e[c].used && e[c].transpt;
+   im = getximage(w, x, y, width, height, trans);
+   if (im == NULL)
+      return -1;
+
+   /*
+    * Allocate the colors we need.  Use black or white if unsuccessful.
+    */
+   ret = 0;
+   for (c = 0; c < 256; c++)
+      if (e[c].used && e[c].valid) {
+         r = e[c].clr.red;
+         g = e[c].clr.green;
+         b = e[c].clr.blue;
+         sprintf(tmp, "%d,%d,%d", r, g, b);
+         cp = alc_rgb(w, tmp, r, g, b, 0);
+         if (cp == NULL) {
+            ret++;
+            if ((0.299 * r + 0.587 * g + 0.114 * b) > 32767)
+               cp = alc_rgb(w, "white", 65535, 65535, 65535, 0);
+            else
+               cp = alc_rgb(w, "black", 0, 0, 0, 0);
+            }
+         cplist[c] = cp;
+         }
+
+   /*
+    * Read the image string and set the pixel values.
+    */
+   ix = iy = 0;
+   while (len--) {
+      c = *s++;
+      v = e[c].valid;
+      if (v)				/* put char if valid */
+         XPutPixel(im, ix, iy, cplist[c]->c);
+      if (v || e[c].transpt) {		/* advance if valid or transparent */
+         if (++ix >= width) {
+            ix = 0;			/* reset for new row */
+            iy++;
+            }
+         }
+      }
+   if (ix > 0)				/* pad final row if incomplete */
+      while (ix < width)
+         XPutPixel(im, ix++, iy, wc->bg->c);
+
+   /*
+    * Put it on the screen.
+    */
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, GXcopy);
+   if (on_icon) {
+      if (ws->iconwin == (Window) NULL) makeIcon(w, 0, 0);
+      XPutImage(stddpy, ws->iconwin, stdgc, im, 0, 0, x, y, width, height);
+      XPutImage(stddpy, ws->iconpix, stdgc, im, 0, 0, x, y, width, height);
+      }
+   else {
+      XPutImage(stddpy, ws->pix, stdgc, im, 0, 0, x, y, width, height);
+      if (ws->win)
+	 XCopyArea(stddpy, ws->pix, ws->win, stdgc, x, y, width, height, x, y);
+      }
+   XDestroyImage(im);
+   if (wc->drawop != GXcopy) XSetFunction(stddpy, stdgc, wc->drawop);
+   return ret;
+   }
+
+/*
+ * capture(w, x, y, width, height, data) -- get image region.
+ *
+ * Stores the specified subimage in data as 15-bit linear color.
+ */
+int capture(w, x, y, width, height, data)
+wbp w;
+int x, y, width, height;
+short *data;
+   {
+   Visual *v;
+   XImage *im;
+   XColor colorcell;
+   LinearColor lc;
+   wclrp *cpp;
+   unsigned char cmap[256];
+   short *cval;
+   int i, r, g, b, ncolors;
+   unsigned long px, clist[GIFMAX], *lp, *ckey;
+   double gamma = w->context->gamma;
+   STDLOCALS(w);
+
+   /*
+    * Get an XImage structure containing window pixel values.
+    */
+   im = getximage(w, x, y, width, height, 1);
+   if (!im)
+      return 0;
+
+   /*
+    * Make a mapping table from X color to 5-bit linear color.
+    */
+   for (i = 0; i < 256; i++)
+      cmap[i] = 31 * pow(i / 255., gamma) + 0.5;
+
+   /*
+    * Translate the colors and store in the data buffer.
+    */
+   v = wd->visual;
+   if (v->class == TrueColor && v->red_mask == 0x00FF0000L
+   && v->green_mask == 0x0000FF00L && v->blue_mask == 0x000000FFL) {
+      /*
+       * 24-bit RGB is decomposed and mapped directly
+       */
+      for (y = 0; y < height; y++) {
+         for (x = 0; x < width; x++) {
+            px = XGetPixel(im, x, y);
+            r = cmap[(px >> 16) & 0xFF];
+            g = cmap[(px >> 8) & 0xFF];
+            b = cmap[px & 0xFF];
+            *data++ = (r << 10) | (g << 5) | b;
+            }
+         }
+      }
+   else {
+      /*
+       * General case uses a cache to improve performance.
+       */
+      #define CCACHE 4987	/* cache size; should be odd */
+      ckey = calloc(CCACHE, sizeof(ckey[0]));
+      cval = calloc(CCACHE, sizeof(cval[0]));
+      if (!ckey || !cval)
+         return 0;
+      for (y = 0; y < height; y++) {
+         for (x = 0; x < width; x++) {
+            px = XGetPixel(im, x, y);		/* get pixel value */
+            i = px % CCACHE;			/* get cache index */
+            if (ckey[i] != px) {		/* if color not cached */
+               colorcell.pixel = px;
+               colorcell.flags = DoRed | DoGreen | DoBlue;
+               XQueryColor(stddpy, wd->cmap, &colorcell);	/* costly */
+               ckey[i] = px;
+               cval[i] = (cmap[colorcell.red >> 8] << 10) |
+   	          (cmap[colorcell.green >> 8] << 5) | cmap[colorcell.blue >> 8];
+               }
+            *data++ = cval[i];			/* save rgb15 color value */
+            }
+         }
+      free(cval);
+      free(ckey);
+      }
+   XDestroyImage(im);
+   return 1;
+   }
+
+/*
+ * Create an XImage structure corresponding to subimage (x, y, w, h).
+ * If init is nonzero, initialize it with current contents.
+ * If init is zero and (x,y,w,h) fills the window, free existing color set.
+ */
+static XImage *getximage(w, x, y, width, height, init)
+wbp w;
+int x, y, width, height, init;
+   {
+   int tx, ty;
+   XImage *im;
+   STDLOCALS(w);
+
+   im = XCreateImage(stddpy, DefaultVisual(stddpy, wd->screen),
+      DefaultDepth(stddpy, wd->screen), ZPixmap, 0, NULL, width, height, 32, 0);
+   if (im == NULL)
+      return NULL;
+   im->data = malloc(im->bytes_per_line * height);
+   if (im->data == NULL) {
+      XDestroyImage(im);
+      return NULL;
+      }
+
+   if (!init) {
+      if (x <= 0 && y <= 0 && x + width >= ws->pixwidth &&
+	 y + height >= ws->pixheight && wc->clipw < 0)
+            free_xcolors(w, 0);
+      return im;
+      }
+
+   tx = ty = 0;
+   if (x < 0)  { tx -= x; width += x; x = 0; }
+   if (y < 0)  { ty -= y; height += y; y = 0; }
+   if (x + width > ws->width)  { width = ws->width - x; }
+   if (y + height > ws->height) { height = ws->height - y; }
+   if (width > 0 && height > 0)
+      XGetSubImage(stddpy, stdpix, x, y, width, height, AllPlanes, ZPixmap,
+		   im, tx, ty);
+   return im;
+   }
+
+int readimage(w, filename, x, y, status)
+wbp w;
+char *filename;
+int x, y, *status;
+   {
+   Pixmap p;
+   unsigned int width, height;
+   STDLOCALS(w);
+   if (!x && !y)
+      p = loadimage(w, filename, &height, &width, 1, status);
+   else
+      p = loadimage(w, filename, &height, &width, 0, status);
+   if (p == (Pixmap) NULL) return Failed;
+
+   if (wc->drawop != GXcopy)
+      XSetFunction(stddpy, stdgc, GXcopy);
+   if (stdwin)
+      XCopyArea(stddpy, p, stdwin, stdgc, 0, 0, width, height, x, y);
+   XCopyArea(stddpy, p, stdpix, stdgc, 0, 0, width, height, x, y);
+   if (wc->drawop != GXcopy)
+      XSetFunction(stddpy,stdgc,wc->drawop);
+
+   /*
+    * Make sure previous ops on p are complete, then free it.
+    */
+   XSync(stddpy, False);
+   XFreePixmap(stddpy, p);
+   return Succeeded;
+   }
+
+
+/*
+ * Initialize client for producing pixels from a window
+ */
+int getpixel_init(w, imem)
+wbp w;
+struct imgmem *imem;
+   {
+   STDLOCALS(w);
+
+   if (imem->width <= 0 || imem->height <= 0) {
+      imem->im = NULL;
+      return Succeeded;
+      }
+
+   imem->im = XGetImage(stddpy, stdpix,
+			imem->x, imem->y, imem->width, imem->height,
+		  (1 << DefaultDepth(stddpy, wd->screen))-1, XYPixmap);
+
+   if (imem->im == NULL) return Failed;
+   return Succeeded;
+   }
+
+int getpixel_term(w, imem)
+wbp w;
+struct imgmem *imem;
+   {
+   if (imem->im != NULL)
+      XDestroyImage(imem->im);
+   return Succeeded;
+   }
+
+/*
+ * Return pixel (x,y) from a window in long value (rv)
+ */
+int getpixel(w, x, y, rv, s, imem)
+wbp w;
+int x, y;
+long *rv;
+char *s;
+struct imgmem *imem;
+   {
+   XColor colorcell;
+   LinearColor clr;
+   wclrp *cpp;
+   unsigned long c;
+   STDLOCALS(w);
+
+   if (x < imem->x || x >= imem->x + imem->width ||
+       y < imem->y || y >= imem->y + imem->height)
+      c = colorcell.pixel = wc->bg->c;
+   else
+      c = colorcell.pixel = XGetPixel(imem->im, x - imem->x, y - imem->y);
+   *rv = 0xff000000;
+
+   for (cpp = wd->colrptrs ; cpp < wd->colrptrs + wd->numColors; cpp++) {
+      if ((*cpp)->c == c) {
+	 if ((*cpp)->type == MUTABLE)
+	    *rv = -c - 1;
+	 else {
+            *rv = 1;
+            colorcell.red = (*cpp)->r;
+            colorcell.green = (*cpp)->g;
+            colorcell.blue = (*cpp)->b;
+            clr = lcolor(w, colorcell);
+            sprintf(s, "%ld,%ld,%ld", clr.red, clr.green, clr.blue);
+	    }
+	 break;
+	 }
+      }
+   if (*rv == 0xff000000) {
+      XQueryColor(stddpy, wd->cmap, &colorcell);
+      *rv = 1;
+      clr = lcolor(w, colorcell);
+      sprintf(s, "%ld,%ld,%ld", clr.red, clr.green, clr.blue);
+      }
+   return Succeeded;
+   }
+
+
+int query_pointer(w, pp)
+wbp w;
+XPoint *pp;
+   {
+   Display *theDisplay;
+   Window theWindow;
+   Window garbage1, garbage2;
+   int root_x, root_y, win_x, win_y;
+   unsigned int key_buttons;
+
+   theDisplay = w->window->display->display;
+   theWindow  = w->window->win;
+   if (theWindow == (Window) NULL) return Failed;
+
+   XQueryPointer(theDisplay, theWindow, &garbage1, &garbage2,
+		 &root_x, &root_y, &win_x, &win_y, &key_buttons);
+   pp->x = w->window->pointerx = win_x;
+   pp->y = w->window->pointery = win_y;
+   return Succeeded;
+   }
+
+int query_rootpointer(pp)
+XPoint *pp;
+   {
+   Display *theDisplay;
+   Window theWindow;
+   Window garbage1, garbage2;
+   int root_x, root_y, win_x, win_y;
+   unsigned int key_buttons;
+   wdp wd;
+   if (wdsplys == NULL) {
+      /*
+       * Initialize the window system
+       */
+      Protect(wd = alc_display(NULL), return Failed);
+
+      theDisplay = wd->display;
+      theWindow  = DefaultRootWindow(wd->display);
+      }
+   else {
+      wd = wdsplys;
+      theDisplay = wd->display;
+      theWindow  = DefaultRootWindow(wd->display);
+      }
+   XQueryPointer(theDisplay, theWindow, &garbage1, &garbage2,
+		 &root_x, &root_y, &win_x, &win_y, &key_buttons);
+   pp->x = root_x;
+   pp->y = root_y;
+   return Succeeded;
+   }
+
+
+int patbits[] = {
+  0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+  0xFE,0xFF,0xEF,0xFF,0xFE,0xFF,0xEF,0xFF,
+  0x77,0xDD,0x77,0xDD,0x77,0xDD,0x77,0xDD,
+  0x55,0xAA,0x55,0xAA,0x55,0xAA,0x55,0xAA,
+  0x11,0x44,0x11,0x44,0x11,0x44,0x11,0x44,
+  0x01,0x00,0x10,0x00,0x01,0x00,0x10,0x00,
+  0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
+
+  0x10,0x10,0x10,0x10,0x10,0x10,0x10,0x10,
+  0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01,
+  0x00,0x00,0x00,0xFF,0x00,0x00,0x00,0x00,
+  0x10,0x10,0x10,0xFF,0x10,0x10,0x10,0x10,
+  0x82,0x44,0x28,0x10,0x28,0x44,0x82,0x01,
+
+  0x0F,0x0F,0x0F,0x0F,0xF0,0xF0,0xF0,0xF0,
+  0x1B,0x18,0x81,0xB1,0x36,0x06,0x60,0x63,
+  0x02,0x02,0x05,0xF8,0x20,0x20,0x50,0x8F,
+  0x03,0x84,0x48,0x30,0x03,0x84,0x48,0x30,
+};
+
+/*
+ * pattern symbols
+ */
+stringint siPatternSyms[] = {
+  {0,		16},
+  { "black",	 0},
+  { "checkers",	 12},
+  { "darkgray",	 2},
+  { "diagonal",	 8},
+  { "grains",	 13},
+  { "gray",	 3},
+  { "grid",	 10},
+  { "horizontal",9},
+  { "lightgray", 4},
+  { "scales",	 14},
+  { "trellis",	 11},
+  { "vertical",	 7},
+  { "verydark",	 1},
+  { "verylight", 5},
+  { "waves",	 15},
+  { "white",	 6},
+};
+
+/*
+ * SetPattern
+ */
+int SetPattern(w, name, len)
+wbp w;
+char *name;
+int len;
+   {
+   int width, nbits;
+   int i;
+   int symbol;
+   C_integer v, bits[MAXXOBJS];
+   Pixmap p;
+   char data[MAXXOBJS];
+   char *buf = data;
+   STDLOCALS(w);
+
+   if (wc->patternname != NULL)
+      free(wc->patternname);
+   wc->patternname = malloc(len+1);
+   if (wc->patternname == NULL) ReturnErrNum(305, Error);
+   strncpy(wc->patternname, name, len);
+   wc->patternname[len] = '\0';
+
+   /*
+    * If the pattern starts with a number it is a width , bits encoding
+    */
+   if ((len > 0) && isdigit(name[0])) {
+      nbits = MAXXOBJS;
+      switch (parsepattern(name, len, &width, &nbits, bits)) {
+      case Failed:
+	 return Failed;
+      case Error:
+	 ReturnErrNum(145, Error);
+	 }
+      if (!stdgc) return Succeeded;
+      return SetPatternBits(w, width, bits, nbits);
+      }
+
+   /*
+    * Otherwise, it is a named pattern.  Find the symbol id.
+    */
+   if ((symbol = si_s2i(siPatternSyms, wc->patternname)) >= 0) {
+      if (!stdgc) return Succeeded;
+      for(i = 0; i < 8; i++) {
+	 v = patbits[symbol * 8 + i];
+	 *buf++ = v;
+	 }
+      p = XCreateBitmapFromData(stddpy, stdpix, data, 8, 8);
+      XSetStipple(stddpy, stdgc, p);
+      XSync(stddpy, False);
+      XFreePixmap(stddpy, p);
+      return Succeeded;
+      }
+   return Failed;
+   }
+
+int SetPatternBits(w, width, bits, nbits)
+wbp w;
+int width;
+C_integer *bits;
+int nbits;
+   {
+   C_integer v;
+   int i, j;
+   Pixmap p;
+   char data[MAXXOBJS];
+   char *buf = data;
+   STDLOCALS(w);
+
+   for(i = 0; i < nbits; i++) {
+      v = bits[i];
+      for(j=0; j<width; j+=8) {
+	 *buf++ = v;
+	 v >>= 8;
+	 }
+      }
+
+   p = XCreateBitmapFromData(stddpy, stdpix, data, width, nbits);
+   XSetStipple(stddpy, stdgc, p);
+   XSync(stddpy, False);
+   XFreePixmap(stddpy, p);
+   return Succeeded;
+   }
+
+
+
+/*
+ * remap a window ... this time with an iconwin
+ */
+int remap(w,x,y)
+wbp w;
+int x,y;
+   {
+   XSizeHints size_hints;
+   XWMHints   *wmhints;
+   STDLOCALS(w);
+
+   XGetSizeHints(stddpy, stdwin, &size_hints, XA_WM_NORMAL_HINTS);
+   wmhints = XGetWMHints(stddpy, stdwin);
+   if (ws->iconwin)
+      XDestroyWindow(stddpy, ws->iconwin);
+   if (stdwin)
+      XDestroyWindow(stddpy, stdwin);
+
+   ws->win = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy),
+				 ws->posx, ws->posy, ws->width,
+				 ws->height, 4, wc->fg->c, wc->bg->c);
+   XSetStandardProperties(stddpy, ws->win, ws->windowlabel,
+			  ws->iconlabel, 0, 0, 0, &size_hints);
+   XSelectInput(stddpy, ws->win, ExposureMask | KeyPressMask |
+		ButtonPressMask | ButtonReleaseMask | ButtonMotionMask |
+		StructureNotifyMask);
+
+   ws->iconwin = XCreateSimpleWindow(stddpy, DefaultRootWindow(stddpy),
+				     ws->iconx, ws->icony, ws->iconw,
+				     ws->iconh, 2, wc->fg->c, wc->bg->c);
+   XSelectInput(stddpy, ws->iconwin,
+		ExposureMask | KeyPressMask | ButtonPressMask);
+
+   wmhints->flags |= IconPositionHint;
+   wmhints->icon_x = x;
+   wmhints->icon_y = y;
+   wmhints->initial_state = ws->iconic;
+   wmhints->icon_window = ws->iconwin;
+   wmhints->flags |= IconWindowHint;
+   XSetWMHints(stddpy, ws->win, wmhints);
+   CLREXPOSED(w);
+   XMapWindow(stddpy, ws->win);
+   if (ws->iconic == NormalState) {
+      while (!ISEXPOSED(w))
+         if (pollevent() == -1) return -1;
+      }
+   ws->iconx = x;
+   ws->icony = y;
+   XSync(stddpy, False);
+   XFree((char *)wmhints);
+   return 1;
+   }
+
+
+int seticonimage(w, dp)
+wbp w;
+dptr dp;
+   {
+   int status;
+   Pixmap pix;
+   tended char *tmp;
+   {
+   STDLOCALS(w);
+   /*
+    * get the preloaded (in another window value) pixmap image
+    */
+   if (is:file(*dp) && (BlkLoc(*dp)->file.status & Fs_Window)) {
+      wbp x = (wbp)BlkLoc(*dp)->file.fd;
+      if ((ws->iconimage = salloc(x->window->windowlabel)) == NULL)
+	 ReturnErrNum(305, Error);
+      pix = XCreatePixmap(stddpy, DefaultRootWindow(stddpy),
+			  x->window->width, x->window->height,
+			  DefaultDepth(stddpy,wd->screen));
+
+      XCopyArea(stddpy, x->window->pix, pix, wd->icongc, 0, 0,
+		x->window->width, x->window->height, 0, 0);
+      if (ws->iconpix) {
+	 XSync(stddpy, False);
+	 XFreePixmap(stddpy, ws->iconpix);
+	 }
+      ws->iconpix = pix;
+      ws->iconw = x->window->width;
+      ws->iconh = x->window->height;
+      if (!ws->iconx && !ws->icony) {
+	 ws->iconx = ws->x;
+	 ws->icony = ws->y;
+	 }
+      if (remap(w,ws->iconx,ws->icony) == -1)
+	 ReturnErrNum(144, Error);
+
+      }
+   /* get the pixmap file named by x */
+   else if (is:string(*dp)) {
+      unsigned int height, width;
+      if (!cnv:C_string(*dp,tmp))
+	 ReturnErrVal(103, *dp, Error);
+
+      if ((ws->iconimage != NULL) && strcmp(ws->iconimage, ""))
+	free(ws->iconimage);
+      if ((ws->iconimage = salloc(tmp)) == NULL)
+	 ReturnErrNum(305, Error);
+      if (ws->iconwin == (Window) NULL) makeIcon(w,0,0);
+      else {
+	 pix = loadimage(w, ws->iconimage, &height, &width, 0, &status);
+	 if (pix == (Pixmap) NULL)
+	    return Failed;
+	 XCopyArea(stddpy, pix, ws->iconwin, wd->icongc,
+		   0, 0, width, height, 0, 0);
+	 if (ws->iconpix) {
+	    XSync(stddpy, False);
+	    XFreePixmap(stddpy, ws->iconpix);
+	    }
+	 ws->iconpix = pix;
+	 ws->iconw = width;
+	 ws->iconh = height;
+	 if (remap(w,ws->iconx,ws->icony) == -1)
+	    ReturnErrNum(144, Error);
+	 }
+      }
+   else
+      return Failed;
+   return Succeeded;
+   }
+   }
+
+
+/*
+ * dumpimage -- write an image to a disk file in an X format.
+ *
+ * Accepts only .xpm and .xbm file names, returning NoCvt for anything else.
+ */
+
+int dumpimage(w,filename,x,y,width,height)
+wbp w;
+char *filename;
+unsigned int x, y, height, width;
+   {
+   int status;
+   STDLOCALS(w);
+
+   /*
+    * Check for bilevel XBM (X BitMap) format.
+    */
+   if (!strcmp(".xbm", filename + strlen(filename) - 4) ||
+       !strcmp(".XBM", filename + strlen(filename) - 4)) {
+      /*
+       * Write a bitmap from a "color" window (presumed to have only BW in it).
+       * BlackPixel ^ WhitePixel will have a 1 in the first bit in which
+       * they are different, so this bit is the plane we want to copy.
+       */
+
+      if (DefaultDepth(stddpy,wd->screen) != 1) {
+         unsigned long bw =
+            BlackPixel(stddpy,wd->screen) ^ WhitePixel(stddpy,wd->screen);
+	 Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy),
+				   width, height, 1);
+	 XGCValues xgc;
+	 GC thinGC;
+	 int i;
+	 /*
+	  * pick out the bitplane on which Black and White differ
+	  */
+	 for(i=0;!((1<<i) & bw);i++);
+	 bw &= (1<<i);
+	 /*
+	  * Construct a 1-bit-deep GC for use in copying the plane.
+	  */
+	 xgc.foreground = BlackPixel(stddpy,wd->screen);
+	 xgc.background = WhitePixel(stddpy,wd->screen);
+	 thinGC = XCreateGC(stddpy,p1,GCForeground|GCBackground,&xgc);
+
+	 if (i>DefaultDepth(stddpy,wd->screen)) return Failed;
+	 XCopyPlane(stddpy,stdpix,p1,thinGC,x,y,width,height,0,0,bw);
+	 status= XWriteBitmapFile(stddpy, filename, p1, width, height, -1, -1);
+
+	 XSync(stddpy, False);
+	 XFreePixmap(stddpy, p1);
+	 XFreeGC(stddpy,thinGC);
+	 if (status != BitmapSuccess) return Failed;
+         }
+      else {
+	 if(x || y) {
+	    Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), width,
+				      height, DefaultDepth(stddpy,wd->screen));
+
+	    XCopyArea(stddpy, stdpix, p1, stdgc, x, y, width, height, 0, 0);
+	    XSync(stddpy, False);
+
+	    status = XWriteBitmapFile(stddpy,filename,p1,width,height,-1,-1);
+
+	    XSync(stddpy, False);
+	    XFreePixmap(stddpy, p1);
+
+	    if (status != BitmapSuccess) return Failed;
+
+	  }
+	 else if (XWriteBitmapFile(stddpy, filename, stdpix,
+				   width, height, -1, -1) != BitmapSuccess)
+	    return Failed;
+
+       }
+   return Succeeded;
+   }
+   /*
+    * Check for XPM (color X PixMap) format.
+    */
+   else if (!strcmp(".xpm", filename + strlen(filename) - 4) ||
+       !strcmp(".XPM", filename + strlen(filename) - 4) ||
+       !strcmp(".xpm.Z", filename + strlen(filename) - 6)) {
+#ifdef HaveXpmFormat
+      /*
+       * Could optimize by calling XpmWriteFileFromPixmap directly on the
+       * stdpix...
+       */
+      Pixmap p1 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), width,
+			       height, DefaultDepth(stddpy,wd->screen));
+
+      XCopyArea(stddpy, stdpix, p1, stdgc, x, y, width, height, 0, 0);
+      XSync(stddpy, False);
+
+      status = XpmWriteFileFromPixmap(stddpy, filename, p1,
+				      (Pixmap) NULL, NULL);
+      XSync(stddpy, False);
+      XFreePixmap(stddpy, p1);
+
+      if (status == XpmSuccess)
+         return Succeeded;
+#endif					/* HaveXpmFormat */
+      return Failed;
+      }
+   else
+      return NoCvt;		/* not an X format -- write GIF instead */
+   }
+
+/*
+ * Load an image, in any format we can figure out.
+ */
+Pixmap loadimage(w, filename, height, width, atorigin, status)
+wbp w;
+char *filename;
+unsigned int *height, *width;
+int atorigin;
+int *status;
+   {
+   Pixmap p1, p2 = (Pixmap) NULL;
+   int xhot, yhot, i, j;
+   XGCValues gcv;
+   unsigned long gcmask = GCFont | GCForeground | GCBackground;
+   int isxbm;
+   STDLOCALS(w);
+
+   if (!strcmp(".xbm", filename + strlen(filename) - 4))
+      isxbm = 1;
+   else if (!strcmp(".xpm", filename + strlen(filename) - 4) ||
+	    !strcmp(".xpm.Z", filename + strlen(filename) - 6))
+      isxbm = 0;
+   else {
+      /*
+       * Not sure what kind of file this is, make a guess
+       * For example, the format might be on the first line of the file,
+       * so open it up and read some.
+       */
+      FILE *ftemp = fopen(filename,"r");
+      char s[6];
+      int  i;
+
+      if (!ftemp) {
+	 return (Pixmap) NULL;
+         }
+      if ((long)fread(s,1,6,ftemp) < (long)6) {
+	 fclose(ftemp);
+	 return (Pixmap) NULL;
+         }
+      fclose(ftemp);
+      /* check s for XPM string */
+      isxbm = 1;         /* default to xbm */
+      for (i = 0; i <= 3; i++)
+	 if (!strncmp(&s[i], "XPM", 3))
+	    isxbm = 0;
+      }
+
+   if (isxbm) {    /* isxbm = 1 => .xbm file */
+      if (XReadBitmapFile(stddpy, DefaultRootWindow(stddpy), filename,
+			  width, height, &p1, &xhot, &yhot) != BitmapSuccess)
+	 return (Pixmap) NULL;
+      else *status = 0;
+      p2 = XCreatePixmap(stddpy, DefaultRootWindow(stddpy), *width, *height,
+			 DefaultDepth(stddpy,DefaultScreen(stddpy)));
+      }
+   else {				/* isxbm == 0 => .xpm file */
+#ifndef HaveXpmFormat
+      return NULL;
+#else					/* HaveXpmFormat */
+      XpmAttributes a;
+      XColor color;
+      LinearColor clr;
+      Pixmap dummy;
+      a.npixels = 0;
+      a.colormap = wd->cmap;
+      a.valuemask = XpmReturnPixels | XpmColormap;
+
+      *status = XpmReadFileToPixmap(stddpy, DefaultRootWindow(stddpy),
+			    filename, &p2, &dummy, &a);
+
+      if (*status == XpmColorFailed && go_virtual(w)) {
+	 /* try again with a virtual colormap */
+	 a.npixels = 0;
+	 a.colormap = wd->cmap;
+	 a.valuemask = XpmReturnPixels | XpmColormap;
+         *status = XpmReadFileToPixmap(stddpy, DefaultRootWindow(stddpy),
+			               filename, &p2, &dummy, &a);
+	 }
+
+      if (*status != XpmSuccess) {
+         if (*status == XpmColorFailed)
+	    *status = 1;
+	 else
+	    return (Pixmap) NULL;
+         }
+      else *status = 0;
+      *height = a.height;
+      *width = a.width;
+
+      /*
+       * if the loaded image is to cover an entire window, free up colors
+       * currently in use by the window
+       */
+      if (atorigin && *width >= ws->pixwidth && *height >= ws->pixheight
+	 && wc->clipw < 0)
+            free_xcolors(w, 0);
+
+      /*
+       * OK, now register all the allocated colors with the display
+       * and window in which we are residing.
+       */
+      for (i = 0; i < a.npixels; i++) {
+	 j = alc_centry(wd);
+	 if (j == 0)
+	    return (Pixmap) NULL;
+	 /*
+	  * Store their allocated pixel (r,g,b) values.
+	  */
+	 color.pixel = wd->colrptrs[j]->c = a.pixels[i];
+	 XQueryColor(stddpy, wd->cmap, &color);
+	 wd->colrptrs[j]->r = color.red;
+	 wd->colrptrs[j]->g = color.green;
+	 wd->colrptrs[j]->b = color.blue;
+         clr = lcolor(w, color);
+         sprintf(wd->colrptrs[j]->name, "%ld,%ld,%ld",
+	    clr.red, clr.green, clr.blue);
+	 if (ws->numColors <= WMAXCOLORS) {
+	    if (ws->theColors == NULL) {
+	       ws->theColors = (short *)calloc(WMAXCOLORS, sizeof(short));
+	       if (ws->theColors == NULL)
+		  return (Pixmap) NULL;
+	       }
+	    ws->theColors[ws->numColors++] = j;
+	    }
+         }
+#endif					/* HaveXpmFormat */
+      }
+
+   if (p2 == (Pixmap) NULL) {
+      return (Pixmap) NULL;
+      }
+
+   if (stdgc == NULL) {
+      gcv.foreground = wc->fg->c;
+      gcv.background = wc->bg->c;
+      gcv.font       = wc->font->fsp->fid;
+      wc->gc = XCreateGC(stddpy, p2, gcmask, &gcv);
+      stdgc = wc->gc;
+      }
+
+   if (isxbm) {
+      XCopyPlane(stddpy, p1, p2, stdgc, 0, 0, *width, *height, 0, 0, 1);
+      XSync(stddpy, False);
+      XFreePixmap(stddpy, p1);
+      }
+   return p2;
+   }
+
+/*
+ * Interpret a platform-specific color name s.
+ * Under X, we can do this only if there is a window.
+ */
+int nativecolor(w, s, r, g, b)
+wbp w;
+char *s;
+long *r, *g, *b;
+   {
+   XColor colorcell;
+   LinearColor clr;
+   wsp ws;
+   wdp wd;
+
+   if (!w)				/* if no window, give up */
+      return 0;
+   ws = w->window;
+   wd = ws->display;
+   if (!XParseColor(wd->display, wd->cmap, s, &colorcell))
+      return 0;				/* if unknown to X */
+   clr = lcolor(w, colorcell);
+   *r = clr.red;
+   *g = clr.green;
+   *b = clr.blue;
+   return 1;
+   }
+
+/*
+ * Convert an X color into an Icon linear color.
+ */
+LinearColor lcolor(w, colorcell)
+wbp w;
+XColor colorcell;
+   {
+   LinearColor l;
+   double gamma = w->context->gamma;
+
+   l.red   = 65535 * pow((int)colorcell.red   / 65535.0, gamma);
+   l.green = 65535 * pow((int)colorcell.green / 65535.0, gamma);
+   l.blue  = 65535 * pow((int)colorcell.blue  / 65535.0, gamma);
+   return l;
+   }
+
+/*
+ * Convert an Icon linear color into an X colorcell.
+ */
+XColor xcolor(w, c)
+wbp w;
+LinearColor c;
+   {
+   XColor x;
+   double invgamma = 1.0 / w->context->gamma;
+
+   x.red   = 65535 * pow(c.red   / 65535.0, invgamma);
+   x.green = 65535 * pow(c.green / 65535.0, invgamma);
+   x.blue  = 65535 * pow(c.blue  / 65535.0, invgamma);
+   x.flags = DoRed | DoGreen | DoBlue;
+   return x;
+   }
+
+
+int raiseWindow(w)
+wbp w;
+   {
+   wsp ws = w->window;
+   if (ws->win) {
+      XRaiseWindow(ws->display->display, ws->win);
+      XSetInputFocus(ws->display->display,ws->win,RevertToParent,CurrentTime);
+      }
+   return Succeeded;
+   }
+
+int lowerWindow(w)
+wbp w;
+   {
+   if (w->window->win)
+      XLowerWindow(w->window->display->display, w->window->win);
+   return Succeeded;
+   }
+
+int walert(w, volume)
+wbp w;
+int volume;
+{
+  STDLOCALS(w);
+  XBell(stddpy, volume);
+  XFlush(stddpy);
+  return Succeeded;
+  }
+
+#endif					/* Graphics */
diff --git a/src/wincap/Makefile b/src/wincap/Makefile
new file mode 100644
index 0000000..ec6a03e
--- /dev/null
+++ b/src/wincap/Makefile
@@ -0,0 +1,24 @@
+# Makefile for creating a library of the parts of Wincap used by Icon.
+
+include ../../Makedefs
+
+W32DEFS = -mwin32
+OBJS = copy.o dibutil.o errors.o file.o
+
+.c.o:
+	$(CC) -c $(CFLAGS) $(W32DEFS) $*.c
+
+libWincap.a: $(OBJS)
+	rm -f $@
+	ar qc $@ $(OBJS)
+
+copy.o: copy.c dibapi.h dibutil.h errors.h
+
+dibutil.o: dibutil.c dibutil.h
+
+errors.o: errors.c errors.h
+
+file.o: file.c  dibapi.h dibutil.h errors.h
+
+Clean:
+	rm -f *.o *.a
diff --git a/src/wincap/copy.c b/src/wincap/copy.c
new file mode 100644
index 0000000..927f574
--- /dev/null
+++ b/src/wincap/copy.c
@@ -0,0 +1,338 @@
+/*
+ *  copy.c
+ *
+ *  Source file for Device-Independent Bitmap (DIB) API.  Provides
+ *  the following functions:
+ *
+ *  CopyWindowToDIB()   - Copies a window to a DIB
+ *  CopyScreenToDIB()   - Copies entire screen to a DIB
+ *  CopyWindowToBitmap()- Copies a window to a standard Bitmap
+ *  CopyScreenToBitmap()- Copies entire screen to a standard Bitmap
+ *
+ *  The following functions are called from DIBUTIL.C:
+ *
+ *  DIBToBitmap()       - Creates a bitmap from a DIB
+ *  BitmapToDIB()       - Creates a DIB from a bitmap
+ *  DIBWidth()          - Gets the width of the DIB
+ *  DIBHeight()         - Gets the height of the DIB
+ *  CreateDIBPalette()  - Gets the DIB's palette
+ *  GetSystemPalette()  - Gets the current palette
+ *
+ * Development Team: Mark Bader
+ *                   Patrick Schreiber
+ *                   Garrett McAuliffe
+ *                   Eric Flo
+ *                   Tony Claflin
+ *
+ * Written by Microsoft Product Support Services, Developer Support.
+ * Copyright (c) 1991 Microsoft Corporation. All rights reserved.
+ */
+
+/* header files */
+#include <WINDOWS.H>
+#include "ERRORS.H"
+#include "DIBUTIL.H"
+#include "DIBAPI.H"
+
+/*************************************************************************
+ *
+ * CopyWindowToDIB()
+ *
+ * Parameters:
+ *
+ * HWND hWnd        - specifies the window
+ *
+ * WORD fPrintArea  - specifies the window area to copy into the device-
+ *                    independent bitmap
+ *
+ * Return Value:
+ *
+ * HDIB             - identifies the device-independent bitmap
+ *
+ * Description:
+ *
+ * This function copies the specified part(s) of the window to a device-
+ * independent bitmap.
+ *
+ ************************************************************************/
+
+
+HDIB CopyWindowToDIB(HWND hWnd, WORD fPrintArea)
+{
+   HDIB hDIB = NULL;  // handle to DIB
+
+   /* check for a valid window handle */
+
+   if (!hWnd)
+      return NULL;
+   switch (fPrintArea)
+      {
+   case PW_WINDOW: // copy entire window
+   {
+      RECT rectWnd;
+
+      /* get the window rectangle */
+
+      GetWindowRect(hWnd, &rectWnd);
+
+      /*  get the DIB of the window by calling
+       *  CopyScreenToDIB and passing it the window rect
+       */
+      hDIB = CopyScreenToDIB(&rectWnd);
+   }
+      break;
+
+   case PW_CLIENT: // copy client area
+   {
+      RECT rectClient;
+      POINT pt1, pt2;
+
+      /* get the client area dimensions */
+
+      GetClientRect(hWnd, &rectClient);
+
+      /* convert client coords to screen coords */
+      pt1.x = rectClient.left;
+      pt1.y = rectClient.top;
+      pt2.x = rectClient.right;
+      pt2.y = rectClient.bottom;
+      ClientToScreen(hWnd, &pt1);
+      ClientToScreen(hWnd, &pt2);
+      rectClient.left = pt1.x;
+      rectClient.top = pt1.y;
+      rectClient.right = pt2.x;
+      rectClient.bottom = pt2.y;
+
+      /*  get the DIB of the client area by calling
+       *  CopyScreenToDIB and passing it the client rect
+       */
+      hDIB = CopyScreenToDIB(&rectClient);
+   }
+      break;
+
+   default:    // invalid print area
+      return NULL;
+      }
+
+   /* return the handle to the DIB */
+   return hDIB;
+}
+
+
+/*************************************************************************
+ *
+ * CopyScreenToDIB()
+ *
+ * Parameter:
+ *
+ * LPRECT lpRect    - specifies the window
+ *
+ * Return Value:
+ *
+ * HDIB             - identifies the device-independent bitmap
+ *
+ * Description:
+ *
+ * This function copies the specified part of the screen to a device-
+ * independent bitmap.
+ *
+ ************************************************************************/
+
+
+HDIB CopyScreenToDIB(LPRECT lpRect)
+{
+   HBITMAP hBitmap;    // handle to device-dependent bitmap
+   HPALETTE hPalette;  // handle to palette
+   HDIB hDIB = NULL;   // handle to DIB
+
+   /*  get the device-dependent bitmap in lpRect by calling
+    *  CopyScreenToBitmap and passing it the rectangle to grab
+    */
+
+   hBitmap = CopyScreenToBitmap(lpRect);
+
+   /* check for a valid bitmap handle */
+   if (!hBitmap)
+      return NULL;
+
+   /* get the current palette */
+   hPalette = GetSystemPalette();
+
+   /* convert the bitmap to a DIB */
+   hDIB = BitmapToDIB(hBitmap, hPalette);
+
+   /* clean up */
+   DeleteObject(hBitmap);
+
+   /* return handle to the packed-DIB */
+   return hDIB;
+}
+
+
+/*************************************************************************
+ *
+ * CopyWindowToBitmap()
+ *
+ * Parameters:
+ *
+ * HWND hWnd        - specifies the window
+ *
+ * WORD fPrintArea  - specifies the window area to copy into the device-
+ *                    dependent bitmap
+ *
+ * Return Value:
+ *
+ * HDIB         - identifies the device-dependent bitmap
+ *
+ * Description:
+ *
+ * This function copies the specified part(s) of the window to a device-
+ * dependent bitmap.
+ *
+ ************************************************************************/
+
+
+HBITMAP CopyWindowToBitmap(HWND hWnd, WORD fPrintArea)
+{
+   HBITMAP hBitmap = NULL;  // handle to device-dependent bitmap
+
+   /* check for a valid window handle */
+
+   if (!hWnd)
+      return NULL;
+   switch (fPrintArea)
+      {
+   case PW_WINDOW: // copy entire window
+   {
+      RECT rectWnd;
+
+      /* get the window rectangle */
+
+      GetWindowRect(hWnd, &rectWnd);
+
+      /*  get the bitmap of that window by calling
+       *  CopyScreenToBitmap and passing it the window rect
+       */
+      hBitmap = CopyScreenToBitmap(&rectWnd);
+   }
+      break;
+
+   case PW_CLIENT: // copy client area
+   {
+      RECT rectClient;
+      POINT pt1, pt2;
+
+      /* get client dimensions */
+
+      GetClientRect(hWnd, &rectClient);
+
+      /* convert client coords to screen coords */
+      pt1.x = rectClient.left;
+      pt1.y = rectClient.top;
+      pt2.x = rectClient.right;
+      pt2.y = rectClient.bottom;
+      ClientToScreen(hWnd, &pt1);
+      ClientToScreen(hWnd, &pt2);
+      rectClient.left = pt1.x;
+      rectClient.top = pt1.y;
+      rectClient.right = pt2.x;
+      rectClient.bottom = pt2.y;
+
+      /*  get the bitmap of the client area by calling
+       *  CopyScreenToBitmap and passing it the client rect
+       */
+      hBitmap = CopyScreenToBitmap(&rectClient);
+   }
+      break;
+
+   default:    // invalid print area
+      return NULL;
+      }
+
+   /* return handle to the bitmap */
+   return hBitmap;
+}
+
+
+/*************************************************************************
+ *
+ * CopyScreenToBitmap()
+ *
+ * Parameter:
+ *
+ * LPRECT lpRect    - specifies the window
+ *
+ * Return Value:
+ *
+ * HDIB             - identifies the device-dependent bitmap
+ *
+ * Description:
+ *
+ * This function copies the specified part of the screen to a device-
+ * dependent bitmap.
+ *
+ ************************************************************************/
+
+
+HBITMAP CopyScreenToBitmap(LPRECT lpRect)
+{
+   HDC hScrDC, hMemDC;           // screen DC and memory DC
+   HBITMAP hBitmap, hOldBitmap;  // handles to deice-dependent bitmaps
+   int nX, nY, nX2, nY2;         // coordinates of rectangle to grab
+   int nWidth, nHeight;          // DIB width and height
+   int xScrn, yScrn;             // screen resolution
+
+   /* check for an empty rectangle */
+
+   if (IsRectEmpty(lpRect))
+      return NULL;
+
+   /*  create a DC for the screen and create
+    *  a memory DC compatible to screen DC
+    */
+   hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL);
+   hMemDC = CreateCompatibleDC(hScrDC);
+
+   /* get points of rectangle to grab */
+   nX = lpRect->left;
+   nY = lpRect->top;
+   nX2 = lpRect->right;
+   nY2 = lpRect->bottom;
+
+   /* get screen resolution */
+   xScrn = GetDeviceCaps(hScrDC, HORZRES);
+   yScrn = GetDeviceCaps(hScrDC, VERTRES);
+
+   /* make sure bitmap rectangle is visible */
+   if (nX < 0)
+      nX = 0;
+   if (nY < 0)
+      nY = 0;
+   if (nX2 > xScrn)
+      nX2 = xScrn;
+   if (nY2 > yScrn)
+      nY2 = yScrn;
+   nWidth = nX2 - nX;
+   nHeight = nY2 - nY;
+
+   /* create a bitmap compatible with the screen DC */
+   hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight);
+
+   /* select new bitmap into memory DC */
+   hOldBitmap = SelectObject(hMemDC, hBitmap);
+
+   /* bitblt screen DC to memory DC */
+   BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY);
+
+   /*  select old bitmap back into memory DC and get handle to
+    *  bitmap of the screen
+    */
+   hBitmap = SelectObject(hMemDC, hOldBitmap);
+
+   /* clean up */
+   DeleteDC(hScrDC);
+   DeleteDC(hMemDC);
+
+   /* return handle to the bitmap */
+   return hBitmap;
+}
diff --git a/src/wincap/dibapi.h b/src/wincap/dibapi.h
new file mode 100644
index 0000000..c1f8824
--- /dev/null
+++ b/src/wincap/dibapi.h
@@ -0,0 +1,46 @@
+/*
+ *  dibapi.h
+ *
+ *  Copyright (c) 1991 Microsoft Corporation. All rights reserved
+ *
+ *  Header file for Device-Independent Bitmap (DIB) API.  Provides
+ *  function prototypes and constants for the following functions:
+ *
+ *  PrintWindow()       - Prints all or part of a window
+ *  PrintScreen()       - Prints the entire screen
+ *  CopyWindowToDIB()   - Copies a window to a DIB
+ *  CopyScreenToDIB()   - Copies entire screen to a DIB
+ *  CopyWindowToBitmap()- Copies a window to a standard Bitmap
+ *  CopyScreenToBitmap()- Copies entire screen to a standard Bitmap
+ *  PrintDIB()          - Prints the specified DIB
+ *  SaveDIB()           - Saves the specified dib in a file
+ *  LoadDIB()           - Loads a DIB from a file
+ *  DestroyDIB()        - Deletes DIB when finished using it
+ *
+ * See the file DIBAPI.TXT for more information about these functions.
+ *
+ */
+
+/* Handle to a DIB */
+#define HDIB HANDLE
+
+/* Print Area selection */
+#define PW_WINDOW        1
+#define PW_CLIENT        2
+
+/* Print Options selection */
+#define PW_BESTFIT       1
+#define PW_STRETCHTOPAGE 2
+#define PW_SCALE         3
+
+/* Function prototypes */
+WORD    PrintWindow(HWND, WORD, WORD, WORD, WORD, LPSTR);
+WORD    PrintScreen(LPRECT, WORD, WORD, WORD, LPSTR);
+HDIB   	CopyWindowToDIB(HWND, WORD);
+HDIB   	CopyScreenToDIB(LPRECT);
+HBITMAP	CopyWindowToBitmap(HWND, WORD);
+HBITMAP	CopyScreenToBitmap(LPRECT);
+WORD    PrintDIB(HDIB, WORD, WORD, WORD, LPSTR);
+WORD   	SaveDIB(HDIB, LPSTR);
+HDIB   	LoadDIB(LPSTR);
+WORD   	DestroyDIB(HDIB);
diff --git a/src/wincap/dibutil.c b/src/wincap/dibutil.c
new file mode 100644
index 0000000..00d2aa1
--- /dev/null
+++ b/src/wincap/dibutil.c
@@ -0,0 +1,680 @@
+/*
+ *  dibutil.c
+ *
+ *  Source file for Device-Independent Bitmap (DIB) API.  Provides
+ *  the following functions:
+ *
+ *  FindDIBBits()       - Sets pointer to the DIB bits
+ *  DIBWidth()          - Gets the width of the DIB
+ *  DIBHeight()         - Gets the height of the DIB
+ *  PaletteSize()       - Calculates the buffer size required by a palette
+ *  DIBNumColors()      - Calculates number of colors in the DIB's color table
+ *  CreateDIBPalette()  - Creates a palette from a DIB
+ *  DIBToBitmap()       - Creates a bitmap from a DIB
+ *  BitmapToDIB()       - Creates a DIB from a bitmap
+ *
+ * Development Team: Mark Bader
+ *                   Patrick Schreiber
+ *                   Garrett Mcauliffe
+ *                   Eric Flo
+ *                   Tony Claflin
+ *
+ * Written by Microsoft Product Support Services, Developer Support.
+ * Copyright (c) 1991 Microsoft Corporation. All rights reserved.
+ */
+
+/* header files */
+#include <windows.h>
+#include <assert.h>
+#include <stdio.h>
+#include "dibutil.h"
+
+
+/*************************************************************************
+ *
+ * FindDIBBits()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * LPSTR            - pointer to the DIB bits
+ *
+ * Description:
+ *
+ * This function calculates the address of the DIB's bits and returns a
+ * pointer to the DIB bits.
+ *
+ ************************************************************************/
+
+
+LPSTR FindDIBBits(LPSTR lpbi)
+{
+   return (lpbi + *(LPDWORD)lpbi + PaletteSize(lpbi));
+}
+
+
+/*************************************************************************
+ *
+ * DIBWidth()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * DWORD            - width of the DIB
+ *
+ * Description:
+ *
+ * This function gets the width of the DIB from the BITMAPINFOHEADER
+ * width field if it is a Windows 3.0-style DIB or from the BITMAPCOREHEADER
+ * width field if it is an OS/2-style DIB.
+ *
+ ************************************************************************/
+
+
+DWORD DIBWidth(LPSTR lpDIB)
+{
+   LPBITMAPINFOHEADER lpbmi;  // pointer to a Win 3.0-style DIB
+   LPBITMAPCOREHEADER lpbmc;  // pointer to an OS/2-style DIB
+
+   /* point to the header (whether Win 3.0 and OS/2) */
+
+   lpbmi = (LPBITMAPINFOHEADER)lpDIB;
+   lpbmc = (LPBITMAPCOREHEADER)lpDIB;
+
+   /* return the DIB width if it is a Win 3.0 DIB */
+   if (lpbmi->biSize == sizeof(BITMAPINFOHEADER))
+      return lpbmi->biWidth;
+   else  /* it is an OS/2 DIB, so return its width */
+      return (DWORD)lpbmc->bcWidth;
+}
+
+
+/*************************************************************************
+ *
+ * DIBHeight()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * DWORD            - height of the DIB
+ *
+ * Description:
+ *
+ * This function gets the height of the DIB from the BITMAPINFOHEADER
+ * height field if it is a Windows 3.0-style DIB or from the BITMAPCOREHEADER
+ * height field if it is an OS/2-style DIB.
+ *
+ ************************************************************************/
+
+
+DWORD DIBHeight(LPSTR lpDIB)
+{
+   LPBITMAPINFOHEADER lpbmi;  // pointer to a Win 3.0-style DIB
+   LPBITMAPCOREHEADER lpbmc;  // pointer to an OS/2-style DIB
+
+   /* point to the header (whether OS/2 or Win 3.0 */
+
+   lpbmi = (LPBITMAPINFOHEADER)lpDIB;
+   lpbmc = (LPBITMAPCOREHEADER)lpDIB;
+
+   /* return the DIB height if it is a Win 3.0 DIB */
+   if (lpbmi->biSize == sizeof(BITMAPINFOHEADER))
+      return lpbmi->biHeight;
+   else  /* it is an OS/2 DIB, so return its height */
+      return (DWORD)lpbmc->bcHeight;
+}
+
+
+/*************************************************************************
+ *
+ * PaletteSize()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * WORD             - size of the color palette of the DIB
+ *
+ * Description:
+ *
+ * This function gets the size required to store the DIB's palette by
+ * multiplying the number of colors by the size of an RGBQUAD (for a
+ * Windows 3.0-style DIB) or by the size of an RGBTRIPLE (for an OS/2-
+ * style DIB).
+ *
+ ************************************************************************/
+
+
+WORD PaletteSize(LPSTR lpbi)
+{
+   /* calculate the size required by the palette */
+   if (IS_WIN30_DIB (lpbi))
+      return (DIBNumColors(lpbi) * sizeof(RGBQUAD));
+   else
+      return (DIBNumColors(lpbi) * sizeof(RGBTRIPLE));
+}
+
+
+/*************************************************************************
+ *
+ * DIBNumColors()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * WORD             - number of colors in the color table
+ *
+ * Description:
+ *
+ * This function calculates the number of colors in the DIB's color table
+ * by finding the bits per pixel for the DIB (whether Win3.0 or OS/2-style
+ * DIB). If bits per pixel is 1: colors=2, if 4: colors=16, if 8: colors=256,
+ * if 24, no colors in color table.
+ *
+ ************************************************************************/
+
+
+WORD DIBNumColors(LPSTR lpbi)
+{
+   WORD wBitCount;  // DIB bit count
+
+   /*  If this is a Windows-style DIB, the number of colors in the
+    *  color table can be less than the number of bits per pixel
+    *  allows for (i.e. lpbi->biClrUsed can be set to some value).
+    *  If this is the case, return the appropriate value.
+    */
+
+   if (IS_WIN30_DIB(lpbi))
+   {
+      DWORD dwClrUsed;
+
+      dwClrUsed = ((LPBITMAPINFOHEADER)lpbi)->biClrUsed;
+      if (dwClrUsed)
+         return (WORD)dwClrUsed;
+   }
+
+   /*  Calculate the number of colors in the color table based on
+    *  the number of bits per pixel for the DIB.
+    */
+   if (IS_WIN30_DIB(lpbi))
+      wBitCount = ((LPBITMAPINFOHEADER)lpbi)->biBitCount;
+   else
+      wBitCount = ((LPBITMAPCOREHEADER)lpbi)->bcBitCount;
+
+   /* return number of colors based on bits per pixel */
+   switch (wBitCount)
+      {
+   case 1:
+      return 2;
+
+   case 4:
+      return 16;
+
+   case 8:
+      return 256;
+
+   default:
+      return 0;
+      }
+}
+
+
+/*************************************************************************
+ *
+ * CreateDIBPalette()
+ *
+ * Parameter:
+ *
+ * HDIB hDIB        - specifies the DIB
+ *
+ * Return Value:
+ *
+ * HPALETTE         - specifies the palette
+ *
+ * Description:
+ *
+ * This function creates a palette from a DIB by allocating memory for the
+ * logical palette, reading and storing the colors from the DIB's color table
+ * into the logical palette, creating a palette from this logical palette,
+ * and then returning the palette's handle. This allows the DIB to be
+ * displayed using the best possible colors (important for DIBs with 256 or
+ * more colors).
+ *
+ ************************************************************************/
+
+
+HPALETTE CreateDIBPalette(HDIB hDIB)
+{
+   LPLOGPALETTE lpPal;      // pointer to a logical palette
+   HANDLE hLogPal;          // handle to a logical palette
+   HPALETTE hPal = NULL;    // handle to a palette
+   int i, wNumColors;       // loop index, number of colors in color table
+   LPSTR lpbi;              // pointer to packed-DIB
+   LPBITMAPINFO lpbmi;      // pointer to BITMAPINFO structure (Win3.0)
+   LPBITMAPCOREINFO lpbmc;  // pointer to BITMAPCOREINFO structure (OS/2)
+   BOOL bWinStyleDIB;       // flag which signifies whether this is a Win3.0 DIB
+
+   /* if handle to DIB is invalid, return NULL */
+
+   if (!hDIB)
+      return NULL;
+
+   /* lock DIB memory block and get a pointer to it */
+   lpbi = (LPSTR) GlobalLock(hDIB);
+
+   /* get pointer to BITMAPINFO (Win 3.0) */
+   lpbmi = (LPBITMAPINFO)lpbi;
+
+   /* get pointer to BITMAPCOREINFO (OS/2 1.x) */
+   lpbmc = (LPBITMAPCOREINFO)lpbi;
+
+   /* get the number of colors in the DIB */
+   wNumColors = DIBNumColors(lpbi);
+
+   /* is this a Win 3.0 DIB? */
+   bWinStyleDIB = IS_WIN30_DIB(lpbi);
+   if (wNumColors)
+   {
+      /* allocate memory block for logical palette */
+      hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + sizeof(PALETTEENTRY) *
+                            wNumColors);
+
+      /* if not enough memory, clean up and return NULL */
+      if (!hLogPal)
+      {
+         GlobalUnlock(hDIB);
+         return NULL;
+      }
+
+      /* lock memory block and get pointer to it */
+      lpPal = (LPLOGPALETTE)GlobalLock(hLogPal);
+
+      /* set version and number of palette entries */
+      lpPal->palVersion = PALVERSION;
+      lpPal->palNumEntries = wNumColors;
+
+      /*  store RGB triples (if Win 3.0 DIB) or RGB quads (if OS/2 DIB)
+       *  into palette
+       */
+      for (i = 0; i < wNumColors; i++)
+      {
+         if (bWinStyleDIB)
+         {
+            lpPal->palPalEntry[i].peRed = lpbmi->bmiColors[i].rgbRed;
+            lpPal->palPalEntry[i].peGreen = lpbmi->bmiColors[i].rgbGreen;
+            lpPal->palPalEntry[i].peBlue = lpbmi->bmiColors[i].rgbBlue;
+            lpPal->palPalEntry[i].peFlags = 0;
+         }
+         else
+         {
+            lpPal->palPalEntry[i].peRed = lpbmc->bmciColors[i].rgbtRed;
+            lpPal->palPalEntry[i].peGreen = lpbmc->bmciColors[i].rgbtGreen;
+            lpPal->palPalEntry[i].peBlue = lpbmc->bmciColors[i].rgbtBlue;
+            lpPal->palPalEntry[i].peFlags = 0;
+         }
+      }
+
+      /* create the palette and get handle to it */
+      hPal = CreatePalette(lpPal);
+
+      /* if error getting handle to palette, clean up and return NULL */
+      if (!hPal)
+      {
+         GlobalUnlock(hLogPal);
+         GlobalFree(hLogPal);
+         return NULL;
+      }
+   }
+
+   /* clean up */
+   GlobalUnlock(hLogPal);
+   GlobalFree(hLogPal);
+   GlobalUnlock(hDIB);
+
+   /* return handle to DIB's palette */
+   return hPal;
+}
+
+
+/*************************************************************************
+ *
+ * DIBToBitmap()
+ *
+ * Parameters:
+ *
+ * HDIB hDIB        - specifies the DIB to convert
+ *
+ * HPALETTE hPal    - specifies the palette to use with the bitmap
+ *
+ * Return Value:
+ *
+ * HBITMAP          - identifies the device-dependent bitmap
+ *
+ * Description:
+ *
+ * This function creates a bitmap from a DIB using the specified palette.
+ * If no palette is specified, default is used.
+ *
+ ************************************************************************/
+
+
+HBITMAP DIBToBitmap(HDIB hDIB, HPALETTE hPal)
+{
+   LPSTR lpDIBHdr, lpDIBBits;  // pointer to DIB header, pointer to DIB bits
+   HBITMAP hBitmap;            // handle to device-dependent bitmap
+   HDC hDC;                    // handle to DC
+   HPALETTE hOldPal = NULL;      // handle to a palette
+
+   /* if invalid handle, return NULL */
+
+   if (!hDIB) {
+      return NULL;
+      }
+
+   /* lock memory block and get a pointer to it */
+   lpDIBHdr = (LPSTR) GlobalLock(hDIB);
+
+   /* get a pointer to the DIB bits */
+   lpDIBBits = FindDIBBits(lpDIBHdr);
+
+   /* get a DC */
+   hDC = GetDC(NULL);
+   if (!hDC)
+   {
+      /* clean up and return NULL */
+      GlobalUnlock(hDIB);
+      return NULL;
+   }
+
+   /* select and realize palette */
+   if (hPal)
+      hOldPal = SelectPalette(hDC, hPal, FALSE);
+   RealizePalette(hDC);
+
+   /* create bitmap from DIB info. and bits */
+   hBitmap = CreateDIBitmap(hDC, (LPBITMAPINFOHEADER)lpDIBHdr, CBM_INIT,
+                            lpDIBBits, (LPBITMAPINFO)lpDIBHdr, DIB_RGB_COLORS)
+   ;
+
+   /* restore previous palette */
+   if (hOldPal)
+      SelectPalette(hDC, hOldPal, FALSE);
+
+   /* clean up */
+   ReleaseDC(NULL, hDC);
+   GlobalUnlock(hDIB);
+
+   /* return handle to the bitmap */
+   return hBitmap;
+}
+
+
+/*************************************************************************
+ *
+ * BitmapToDIB()
+ *
+ * Parameters:
+ *
+ * HBITMAP hBitmap  - specifies the bitmap to convert
+ *
+ * HPALETTE hPal    - specifies the palette to use with the bitmap
+ *
+ * Return Value:
+ *
+ * HDIB             - identifies the device-dependent bitmap
+ *
+ * Description:
+ *
+ * This function creates a DIB from a bitmap using the specified palette.
+ *
+ ************************************************************************/
+
+
+HDIB BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal)
+{
+   BITMAP bm;                   // bitmap structure
+   BITMAPINFOHEADER bi;         // bitmap header
+   BITMAPINFOHEADER FAR *lpbi;  // pointer to BITMAPINFOHEADER
+   DWORD dwLen;                 // size of memory block
+   HANDLE hDIB, h;              // handle to DIB, temp handle
+   HDC hDC;                     // handle to DC
+   WORD biBits;                 // bits per pixel
+
+   /* check if bitmap handle is valid */
+
+   if (!hBitmap)
+      return NULL;
+
+   /* if no palette is specified, use default palette */
+   if (hPal == NULL)
+      hPal = (HPALETTE) GetStockObject(DEFAULT_PALETTE);
+
+   /* fill in BITMAP structure */
+   GetObject(hBitmap, sizeof(bm), (LPSTR)&bm);
+
+   /* calculate bits per pixel */
+   biBits = bm.bmPlanes * bm.bmBitsPixel;
+
+   /* initialize BITMAPINFOHEADER */
+   bi.biSize = sizeof(BITMAPINFOHEADER);
+   bi.biWidth = bm.bmWidth;
+   bi.biHeight = bm.bmHeight;
+   bi.biPlanes = 1;
+   bi.biBitCount = biBits;
+   bi.biCompression = DIB_RGB_COLORS;
+   bi.biSizeImage = 0;
+   bi.biXPelsPerMeter = 0;
+   bi.biYPelsPerMeter = 0;
+   bi.biClrUsed = 0;
+   bi.biClrImportant = 0;
+
+   /* calculate size of memory block required to store BITMAPINFO */
+   dwLen = bi.biSize + PaletteSize((LPSTR)&bi);
+
+   /* get a DC */
+   hDC = GetDC(NULL);
+
+   /* select and realize our palette */
+   hPal = SelectPalette(hDC, hPal, FALSE);
+   RealizePalette(hDC);
+
+   /* alloc memory block to store our bitmap */
+   hDIB = GlobalAlloc(GHND, dwLen);
+
+   /* if we couldn't get memory block */
+   if (!hDIB)
+   {
+      /* clean up and return NULL */
+      SelectPalette(hDC, hPal, TRUE);
+      RealizePalette(hDC);
+      ReleaseDC(NULL, hDC);
+      return NULL;
+   }
+
+   /* lock memory and get pointer to it */
+   lpbi = (BITMAPINFOHEADER FAR *)GlobalLock(hDIB);
+
+   /* use our bitmap info. to fill BITMAPINFOHEADER */
+   *lpbi = bi;
+
+   /*  call GetDIBits with a NULL lpBits param, so it will calculate the
+    *  biSizeImage field for us
+    */
+   GetDIBits(hDC, hBitmap, 0, (WORD)bi.biHeight, NULL, (LPBITMAPINFO)lpbi,
+             DIB_RGB_COLORS);
+
+   /* get the info. returned by GetDIBits and unlock memory block */
+   bi = *lpbi;
+   GlobalUnlock(hDIB);
+
+   /* if the driver did not fill in the biSizeImage field, make one up */
+   if (bi.biSizeImage == 0)
+      bi.biSizeImage = WIDTHBYTES((DWORD)bm.bmWidth * biBits) * bm.bmHeight;
+
+   /* realloc the buffer big enough to hold all the bits */
+   dwLen = bi.biSize + PaletteSize((LPSTR)&bi) + bi.biSizeImage;
+   if (h = GlobalReAlloc(hDIB, dwLen, 0))
+      hDIB = h;
+   else
+   {
+      /* clean up and return NULL */
+      GlobalFree(hDIB);
+      hDIB = NULL;
+      SelectPalette(hDC, hPal, TRUE);
+      RealizePalette(hDC);
+      ReleaseDC(NULL, hDC);
+      return NULL;
+   }
+
+   /* lock memory block and get pointer to it */
+   lpbi = (BITMAPINFOHEADER FAR *)GlobalLock(hDIB);
+
+   /*  call GetDIBits with a NON-NULL lpBits param, and actualy get the
+    *  bits this time
+    */
+   if (GetDIBits(hDC, hBitmap, 0, (WORD)bi.biHeight, (LPSTR)lpbi + (WORD)lpbi
+                 ->biSize + PaletteSize((LPSTR)lpbi), (LPBITMAPINFO)lpbi,
+                 DIB_RGB_COLORS) == 0)
+   {
+      /* clean up and return NULL */
+      GlobalUnlock(hDIB);
+      hDIB = NULL;
+      SelectPalette(hDC, hPal, TRUE);
+      RealizePalette(hDC);
+      ReleaseDC(NULL, hDC);
+      return NULL;
+   }
+   bi = *lpbi;
+
+   /* clean up */
+   GlobalUnlock(hDIB);
+   SelectPalette(hDC, hPal, TRUE);
+   RealizePalette(hDC);
+   ReleaseDC(NULL, hDC);
+
+   /* return handle to the DIB */
+   return hDIB;
+}
+
+
+/*************************************************************************
+ *
+ * PalEntriesOnDevice()
+ *
+ * Parameter:
+ *
+ * HDC hDC          - device context
+ *
+ * Return Value:
+ *
+ * int              - number of palette entries on device
+ *
+ * Description:
+ *
+ * This function gets the number of palette entries on the specified device
+ *
+ ************************************************************************/
+
+
+int PalEntriesOnDevice(HDC hDC)
+{
+   int nColors;  // number of colors
+
+   /*  Find out the number of palette entries on this
+    *  device.
+    */
+
+   nColors = GetDeviceCaps(hDC, SIZEPALETTE);
+
+   /*  For non-palette devices, we'll use the # of system
+    *  colors for our palette size.
+    */
+   if (!nColors)
+      nColors = GetDeviceCaps(hDC, NUMCOLORS);
+   assert(nColors);
+   return nColors;
+}
+
+
+/*************************************************************************
+ *
+ * DIBHeight()
+ *
+ * Parameter:
+ *
+ * LPSTR lpbi       - pointer to packed-DIB memory block
+ *
+ * Return Value:
+ *
+ * DWORD            - height of the DIB
+ *
+ * Description:
+ *
+ * This function returns a handle to a palette which represents the system
+ * palette (each entry is an offset into the system palette instead of an
+ * RGB with a flag of PC_EXPLICIT).
+ *
+ ************************************************************************/
+
+
+HPALETTE GetSystemPalette(void)
+{
+   HDC hDC;                // handle to a DC
+   HPALETTE hPal = NULL;   // handle to a palette
+   HANDLE hLogPal;         // handle to a logical palette
+   LPLOGPALETTE lpLogPal;  // pointer to a logical palette
+   int i, nColors;         // loop index, number of colors
+
+   /* Find out how many palette entries we want. */
+
+   hDC = GetDC(NULL);
+   if (!hDC)
+      return NULL;
+   nColors = PalEntriesOnDevice(hDC);
+   ReleaseDC(NULL, hDC);
+
+   /* Allocate room for the palette and lock it. */
+   hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors * sizeof(
+                         PALETTEENTRY));
+
+   /* if we didn't get a logical palette, return NULL */
+   if (!hLogPal)
+      return NULL;
+
+   /* get a pointer to the logical palette */
+   lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal);
+
+   /* set some important fields */
+   lpLogPal->palVersion = PALVERSION;
+   lpLogPal->palNumEntries = nColors;
+   for (i = 0; i < nColors; i++)
+   {
+      lpLogPal->palPalEntry[i].peBlue = 0;
+      *((LPWORD)(&lpLogPal->palPalEntry[i].peRed)) = i;
+      lpLogPal->palPalEntry[i].peFlags = PC_EXPLICIT;
+   }
+
+   /*  Go ahead and create the palette.  Once it's created,
+    *  we no longer need the LOGPALETTE, so free it.
+    */
+   hPal = CreatePalette(lpLogPal);
+
+   /* clean up */
+   GlobalUnlock(hLogPal);
+   GlobalFree(hLogPal);
+   return hPal;
+}
diff --git a/src/wincap/dibutil.h b/src/wincap/dibutil.h
new file mode 100644
index 0000000..c094ea2
--- /dev/null
+++ b/src/wincap/dibutil.h
@@ -0,0 +1,40 @@
+/*
+ *  dibutil.h
+ *
+ *  Copyright (c) 1991 Microsoft Corporation. All rights reserved.
+ *
+ *  Header file for Device-Independent Bitmap (DIB) API.  Provides
+ *  function prototypes and constants for the following functions:
+ *
+ *  FindDIBBits()		- Sets pointer to the DIB bits
+ *  DIBWidth()			- Gets the DIB width
+ *  DIBHeight()			- Gets the DIB height
+ *  DIBNumColors()		- Calculates number of colors in the DIB's color table
+ *  PaletteSize()		- Calculates the buffer size required by a palette
+ *  CreateDIBPalette()	- Creates a palette from a DIB
+ *  DIBToBitmap()		- Creates a bitmap from a DIB
+ *  BitmapToDIB()		- Creates a DIB from a bitmap
+ *  PalEntriesOnDevice()- Gets the number of palette entries
+ *  GetSystemPalette()	- Gets the current palette
+ *
+ */
+#include "../wincap/dibapi.h"
+
+/* DIB constants */
+#define PALVERSION   0x300
+
+/* DIB macros */
+#define WIDTHBYTES(bits)	(((bits) + 31) / 32 * 4)
+#define IS_WIN30_DIB(lpbi)  ((*(LPDWORD)(lpbi)) == sizeof(BITMAPINFOHEADER))
+
+/* function prototypes */
+LPSTR    	FindDIBBits(LPSTR lpbi);
+DWORD		DIBWidth(LPSTR lpDIB);
+DWORD		DIBHeight(LPSTR lpDIB);
+WORD     	DIBNumColors(LPSTR lpbi);
+WORD     	PaletteSize(LPSTR lpbi);
+HPALETTE 	CreateDIBPalette(HDIB hDIB);
+HBITMAP  	DIBToBitmap(HDIB hDIB, HPALETTE hPal);
+HDIB     	BitmapToDIB(HBITMAP hBitmap, HPALETTE hPal);
+int			PalEntriesOnDevice(HDC hDC);
+HPALETTE 	GetSystemPalette(void);
diff --git a/src/wincap/errors.c b/src/wincap/errors.c
new file mode 100644
index 0000000..c038450
--- /dev/null
+++ b/src/wincap/errors.c
@@ -0,0 +1,51 @@
+/*
+ * Errors.c
+ *
+ * Contains error messages for WINCAP
+ *
+ * These error messages all have constants associated with
+ * them, contained in errors.h.
+ *
+ * Note that not all these messages are used in WINCAP.
+ *
+ * Copyright (c) 1991 Microsoft Corporation. All rights reserved.
+ */
+#include <windows.h>
+#include "errors.h"
+
+extern char szAppName[];
+
+static char *szErrors[] =
+{
+   "Not a DIB file!",
+   "Couldn't allocate memory!",
+   "Error reading file!",
+   "Error locking memory!",
+   "Error opening file!",
+   "Error creating palette!",
+   "Error getting a DC!",
+   "Error creating Device Dependent Bitmap",
+   "StretchBlt() failed!",
+   "StretchDIBits() failed!",
+   "SetDIBitsToDevice() failed!",
+   "Printer: StartDoc failed!",
+   "Printing: GetModuleHandle() couldn't find GDI!",
+   "Printer: SetAbortProc failed!",
+   "Printer: StartPage failed!",
+   "Printer: NEWFRAME failed!",
+   "Printer: EndPage failed!",
+   "Printer: EndDoc failed!",
+   "SetDIBits() failed!",
+   "File Not Found!",
+   "Invalid Handle",
+   "General Error on call to DIB function"
+};
+
+
+void DIBError(int ErrNo)
+{
+   if ((ErrNo < ERR_MIN) || (ErrNo >= ERR_MAX))
+      MessageBox(NULL, "Undefined Error!", szAppName, MB_OK | MB_ICONHAND);
+   else
+      MessageBox(NULL, szErrors[ErrNo], szAppName, MB_OK | MB_ICONHAND);
+}
diff --git a/src/wincap/errors.h b/src/wincap/errors.h
new file mode 100644
index 0000000..8df5b5c
--- /dev/null
+++ b/src/wincap/errors.h
@@ -0,0 +1,33 @@
+/* Header file for errors.c */
+/* Copyright (c) 1991 Microsoft Corporation. All rights reserved. */
+
+enum {
+      ERR_MIN = 0,                     // All error #s >= this value
+      ERR_NOT_DIB = 0,                 // Tried to load a file, NOT a DIB!
+      ERR_MEMORY,                      // Not enough memory!
+      ERR_READ,                        // Error reading file!
+      ERR_LOCK,                        // Error on a GlobalLock()!
+      ERR_OPEN,                        // Error opening a file!
+      ERR_CREATEPAL,                   // Error creating palette.
+      ERR_GETDC,                       // Couldn't get a DC.
+      ERR_CREATEDDB,                   // Error create a DDB.
+      ERR_STRETCHBLT,                  // StretchBlt() returned failure.
+      ERR_STRETCHDIBITS,               // StretchDIBits() returned failure.
+      ERR_SETDIBITSTODEVICE,           // SetDIBitsToDevice() failed.
+      ERR_STARTDOC,                    // Error calling StartDoc().
+      ERR_NOGDIMODULE,                 // Couldn't find GDI module in memory.
+      ERR_SETABORTPROC,                // Error calling SetAbortProc().
+      ERR_STARTPAGE,                   // Error calling StartPage().
+      ERR_NEWFRAME,                    // Error calling NEWFRAME escape.
+      ERR_ENDPAGE,                     // Error calling EndPage().
+      ERR_ENDDOC,                      // Error calling EndDoc().
+      ERR_SETDIBITS,                   // Error calling SetDIBits().
+      ERR_FILENOTFOUND,                // Error opening file in GetDib()
+      ERR_INVALIDHANDLE,               // Invalid Handle
+      ERR_DIBFUNCTION,                 // Error on call to DIB function
+      ERR_MAX                          // All error #s < this value
+     };
+
+
+void DIBError (int ErrNo);
+
diff --git a/src/wincap/file.c b/src/wincap/file.c
new file mode 100644
index 0000000..e24f0ec
--- /dev/null
+++ b/src/wincap/file.c
@@ -0,0 +1,410 @@
+/*
+ *  file.c
+ *
+ *  Source file for Device-Independent Bitmap (DIB) API.  Provides
+ *  the following functions:
+ *
+ *  SaveDIB()           - Saves the specified dib in a file
+ *  LoadDIB()           - Loads a DIB from a file
+ *  DestroyDIB()        - Deletes DIB when finished using it
+ *
+ * Development Team: Mark Bader
+ *                   Patrick Schreiber
+ *                   Garrett McAuliffe
+ *                   Eric Flo
+ *                   Tony Claflin
+ *
+ * Written by Microsoft Product Support Services, Developer Support.
+ * Copyright (c) 1991 Microsoft Corporation. All rights reserved.
+ *
+ * Modified by Frank J. Lhota to use Win32 CreateFile handles
+ * whenever WIN32 is defined.
+ */
+#include <windows.h>
+#include <string.h>
+#include <stdio.h>
+#include <math.h>
+#include <io.h>
+/* #include <direct.h> */
+#include <stdlib.h>
+#include <fcntl.h>
+#include "errors.h"
+#include "dibutil.h"
+#include "dibapi.h"
+
+/*
+ * Dib Header Marker - used in writing DIBs to files
+ */
+#define DIB_HEADER_MARKER   ((WORD) ('M' << 8) | 'B')
+
+#ifdef WIN32
+typedef HANDLE MYHFILE;
+#else					/* WIN32 */
+typedef int MYHFILE;
+#endif					/* WIN32 */
+
+/*********************************************************************
+ *
+ * Local Function Prototypes
+ *
+ *********************************************************************/
+
+
+HANDLE ReadDIBFile(MYHFILE);
+BOOL MyRead(MYHFILE, LPSTR, DWORD);
+BOOL SaveDIBFile(void);
+/* BOOL WriteDIB(LPSTR, HANDLE); */
+DWORD PASCAL MyWrite(MYHFILE, VOID FAR *, DWORD);
+
+/*************************************************************************
+ *
+ * LoadDIB()
+ *
+ * Loads the specified DIB from a file, allocates memory for it,
+ * and reads the disk file into the memory.
+ *
+ * Parameters:
+ *
+ * LPSTR lpFileName - specifies the file to load a DIB from
+ *
+ * Returns: A handle to a DIB, or NULL if unsuccessful.
+ *
+ *************************************************************************/
+
+HDIB LoadDIB(LPSTR lpFileName)
+{
+   HDIB hDIB;
+   MYHFILE hFile;
+   OFSTRUCT ofs;
+
+   /*
+    * Set the cursor to a hourglass, in case the loading operation
+    * takes more than a sec, the user will know what's going on.
+    */
+
+   SetCursor(LoadCursor(NULL, IDC_WAIT));
+#ifdef WIN32
+   hFile = CreateFile(
+      lpFileName,	     /* lpFileName            */
+      GENERIC_READ,	     /* dwDesiredAccess       */
+      FILE_SHARE_READ,	     /* dwShareMode           */
+      NULL,		     /* lpSecurityAttributes  */
+      OPEN_EXISTING,	     /* dwCreationDisposition */
+      FILE_ATTRIBUTE_NORMAL, /* dwFlagsAndAttributes  */
+      NULL );		     /* hTemplateFile         */
+ 
+   if (hFile != INVALID_HANDLE_VALUE)
+#else					/* WIN32 */
+   if ((hFile = OpenFile(lpFileName, &ofs, OF_READ)) != -1)
+#endif					/* WIN32 */
+   {
+      hDIB = ReadDIBFile(hFile);
+#ifdef WIN32
+      CloseHandle(hFile);
+#else					/* WIN32 */
+      _lclose(hFile);
+#endif					/* WIN32 */
+      SetCursor(LoadCursor(NULL, IDC_ARROW));
+      return hDIB;
+   }
+   else
+   {
+#if 0
+      DIBError(ERR_FILENOTFOUND);
+#endif
+      SetCursor(LoadCursor(NULL, IDC_ARROW));
+      return NULL;
+   }
+}
+
+
+/*************************************************************************
+ *
+ * SaveDIB()
+ *
+ * Saves the specified DIB into the specified file name on disk.  No
+ * error checking is done, so if the file already exists, it will be
+ * written over.
+ *
+ * Parameters:
+ *
+ * HDIB hDib - Handle to the dib to save
+ *
+ * LPSTR lpFileName - pointer to full pathname to save DIB under
+ *
+ * Return value: 0 if successful, or one of:
+ *        ERR_INVALIDHANDLE
+ *        ERR_OPEN
+ *        ERR_LOCK
+ *
+ *************************************************************************/
+
+
+WORD SaveDIB(HDIB hDib, LPSTR lpFileName)
+{
+   BITMAPFILEHEADER bmfHdr; // Header for Bitmap file
+   LPBITMAPINFOHEADER lpBI;   // Pointer to DIB info structure
+   MYHFILE fh;     // file handle for opened file
+#ifdef WIN32
+   DWORD dwNumberOfBytesWritten;
+#else					/* WIN32 */
+   OFSTRUCT of;     // OpenFile structure
+#endif					/* WIN32 */
+
+   if (!hDib)
+      return ERR_INVALIDHANDLE;
+#ifdef WIN32
+   fh = CreateFile(
+      lpFileName,	     /* lpFileName            */
+      GENERIC_WRITE,	     /* dwDesiredAccess       */
+      0,	     	     /* dwShareMode           */
+      NULL,		     /* lpSecurityAttributes  */
+      CREATE_ALWAYS,	     /* dwCreationDisposition */
+      FILE_ATTRIBUTE_NORMAL, /* dwFlagsAndAttributes  */
+      NULL );		     /* hTemplateFile         */
+   if (fh == INVALID_HANDLE_VALUE)
+#else					/* WIN32 */
+   fh = OpenFile(lpFileName, &of, OF_CREATE | OF_READWRITE);
+   if (fh == -1)
+#endif					/* WIN32 */
+      return ERR_OPEN;
+
+   /*
+    * Get a pointer to the DIB memory, the first of which contains
+    * a BITMAPINFO structure
+    */
+   lpBI = (LPBITMAPINFOHEADER)GlobalLock(hDib);
+   if (!lpBI)
+      return ERR_LOCK;
+
+   /*
+    * Fill in the fields of the file header
+    */
+
+   /* Fill in file type (first 2 bytes must be "BM" for a bitmap) */
+   bmfHdr.bfType = DIB_HEADER_MARKER;  // "BM"
+
+   /* Size is size of packed dib in memory plus size of file header */
+   bmfHdr.bfSize = GlobalSize(hDib) + sizeof(BITMAPFILEHEADER);
+   bmfHdr.bfReserved1 = 0;
+   bmfHdr.bfReserved2 = 0;
+
+   /*
+    * Now, calculate the offset the actual bitmap bits will be in
+    * the file -- It's the Bitmap file header plus the DIB header,
+    * plus the size of the color table.
+    */
+   bmfHdr.bfOffBits = (DWORD)sizeof(BITMAPFILEHEADER) + lpBI->biSize +
+                      PaletteSize((LPSTR)lpBI);
+
+   /* Write the file header */
+#ifdef WIN32
+   WriteFile(fh, (LPCVOID)&bmfHdr, sizeof(BITMAPFILEHEADER),
+      &dwNumberOfBytesWritten, NULL);
+#else					/* WIN32 */
+   _lwrite(fh, (LPSTR)&bmfHdr, sizeof(BITMAPFILEHEADER));
+#endif					/* WIN32 */
+
+   /*
+    * Write the DIB header and the bits -- use local version of
+    * MyWrite, so we can write more than 32767 bytes of data
+    */
+   MyWrite(fh, (LPSTR)lpBI, GlobalSize(hDib));
+   GlobalUnlock(hDib);
+#ifdef WIN32
+   CloseHandle(fh);
+#else					/* WIN32 */
+   _lclose(fh);
+#endif					/* WIN32 */
+   return 0; // Success code
+}
+
+
+/*************************************************************************
+ *
+ * DestroyDIB ()
+ *
+ * Purpose:  Frees memory associated with a DIB
+ *
+ * Returns:  Nothing
+ *
+ *************************************************************************/
+
+
+WORD DestroyDIB(HDIB hDib)
+{
+   GlobalFree(hDib);
+   return 0;
+}
+
+
+//************************************************************************
+//
+// Auxiliary Functions which the above procedures use
+//
+//************************************************************************
+
+
+/*************************************************************************
+
+  Function:  ReadDIBFile (MYHFILE)
+
+   Purpose:  Reads in the specified DIB file into a global chunk of
+             memory.
+
+   Returns:  A handle to a dib (hDIB) if successful.
+             NULL if an error occurs.
+
+  Comments:  BITMAPFILEHEADER is stripped off of the DIB.  Everything
+             from the end of the BITMAPFILEHEADER structure on is
+             returned in the global memory handle.
+
+*************************************************************************/
+
+
+HANDLE ReadDIBFile(MYHFILE hFile)
+{
+   BITMAPFILEHEADER bmfHeader;
+   DWORD dwBitsSize;
+#ifdef WIN32
+   DWORD dwNumberOfBytesRead = 0;
+#endif					/* WIN32 */
+
+   HANDLE hDIB;
+   LPSTR pDIB;
+
+   /*
+    * get length of DIB in bytes for use when reading
+    */
+
+#ifdef WIN32
+   dwBitsSize = GetFileSize(hFile, NULL);
+#else					/* WIN32 */
+   dwBitsSize = filelength(hFile);
+#endif					/* WIN32 */
+
+   /*
+    * Go read the DIB file header and check if it's valid.
+    */
+#ifdef WIN32
+   ReadFile(hFile, (LPVOID)&bmfHeader, sizeof(bmfHeader),
+      &dwNumberOfBytesRead, NULL);
+   if (dwNumberOfBytesRead != sizeof(bmfHeader)) {
+#else					/* WIN32 */
+   if ((_lread(hFile, (LPSTR)&bmfHeader, sizeof(bmfHeader)) != sizeof(
+       bmfHeader))) {
+#endif					/* WIN32 */
+       return NULL;
+      }
+   if (bmfHeader.bfType != DIB_HEADER_MARKER)
+   {
+      return NULL;
+   }
+   /*
+    * Allocate memory for DIB
+    */
+   hDIB = GlobalAlloc(GMEM_MOVEABLE | GMEM_ZEROINIT, dwBitsSize);
+   if (hDIB == 0)
+   {
+      return NULL;
+   }
+   pDIB = GlobalLock(hDIB);
+
+   /*
+    * Go read the bits.
+    */
+   if (!MyRead(hFile, pDIB, dwBitsSize - sizeof(BITMAPFILEHEADER)))
+   {
+      GlobalUnlock(hDIB);
+      GlobalFree(hDIB);
+      return NULL;
+   }
+   GlobalUnlock(hDIB);
+   return hDIB;
+}
+
+/*************************************************************************
+
+  Function:  MyRead (MYHFILE, LPSTR, DWORD)
+
+   Purpose:  Routine to read files greater than 64K in size.
+
+   Returns:  TRUE if successful.
+             FALSE if an error occurs.
+
+  Comments:
+
+*************************************************************************/
+
+
+BOOL MyRead(MYHFILE hFile, LPSTR lpBuffer, DWORD dwSize)
+{
+#ifdef WIN32
+   DWORD dwNumberOfBytesRead;
+
+   if(!ReadFile(hFile, (LPVOID)lpBuffer, dwSize, &dwNumberOfBytesRead, NULL))
+      return FALSE;
+   return (dwNumberOfBytesRead == dwSize);
+#else					/* WIN32 */
+   char huge *lpInBuf = (char huge *)lpBuffer;
+   int nBytes;
+
+   /*
+    * Read in the data in 32767 byte chunks (or a smaller amount if it's
+    * the last chunk of data read)
+    */
+
+   while (dwSize)
+   {
+      nBytes = (int)(dwSize > (DWORD)32767 ? 32767 : LOWORD (dwSize));
+      if (_lread(hFile, (LPSTR)lpInBuf, nBytes) != (WORD)nBytes)
+         return FALSE;
+      dwSize -= nBytes;
+      lpInBuf += nBytes;
+   }
+   return TRUE;
+#endif					/* WIN32 */
+}
+
+
+/****************************************************************************
+
+ FUNCTION   : MyWrite(MYHFILE fh, VOID FAR *pv, DWORD ul)
+
+ PURPOSE    : Writes data in steps of 32k till all the data is written.
+              Normal _lwrite uses a WORD as 3rd parameter, so it is
+              limited to 32767 bytes, but this procedure is not.
+
+ RETURNS    : 0 - If write did not proceed correctly.
+              number of bytes written otherwise.
+
+ ****************************************************************************/
+
+
+DWORD PASCAL MyWrite(MYHFILE iFileHandle, VOID FAR *lpBuffer, DWORD dwBytes)
+{
+   DWORD dwBytesTmp = dwBytes;       // Save # of bytes for return value
+#ifdef WIN32
+   if(!WriteFile(iFileHandle, (LPCVOID)lpBuffer, dwBytes, &dwBytesTmp, NULL))
+      return 0;
+#else					/* WIN32 */
+   BYTE huge *hpBuffer = lpBuffer;   // make a huge pointer to the data
+
+   /*
+    * Write out the data in 32767 byte chunks.
+    */
+
+   while (dwBytes > 32767)
+   {
+      if (_lwrite(iFileHandle, (LPSTR)hpBuffer, (WORD)32767) != 32767)
+         return 0;
+      dwBytes -= 32767;
+      hpBuffer += 32767;
+   }
+
+   /* Write out the last chunk (which is < 32767 bytes) */
+   if (_lwrite(iFileHandle, (LPSTR)hpBuffer, (WORD)dwBytes) != (WORD)dwBytes)
+      return 0;
+#endif					/* WIN32 */
+   return dwBytesTmp;
+}
diff --git a/src/wincap/license.txt b/src/wincap/license.txt
new file mode 100644
index 0000000..3e3a579
--- /dev/null
+++ b/src/wincap/license.txt
@@ -0,0 +1,40 @@
+THE INFORMATION AND CODE PROVIDED HEREUNDER (COLLECTIVELY REFERRED TO
+AS "SOFTWARE") IS PROVIDED AS IS WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN
+NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR
+ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL,
+CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF
+MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR
+LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE
+FOREGOING LIMITATION MAY NOT APPLY.
+
+This Software may be copied and distributed royalty-free subject to
+the following conditions:
+
+1. You must copy all Software without modification and must include
+   all pages, if the Software is distributed without inclusion in your
+   software product. If you are incorporating the Software in
+   conjunction with and as a part of your software product which adds
+   substantial value, you may modify and include portions of the
+   Software.
+
+2. You must place all copyright notices and other protective
+   disclaimers and notices contained on the Software on all copies of
+   the Software and your software product.
+
+3. Unless the Software is incorporated in your software product which
+   adds substantial value, you may not distribute this Software for
+   profit.
+
+4. You may not use Microsoft's name, logo, or trademarks to market
+   your software product.
+
+5. You agree to indemnify, hold harmless, and defend Microsoft and its
+   suppliers from and against any claims or lawsuits, including
+   attorneys' fees, that arise or result from the use or distribution
+   of your software product and any modifications to the Software.
+
+
+Copyright (c) 1991, 1992 Microsoft Corporation. All rights reserved.
diff --git a/src/xpm/Makefile b/src/xpm/Makefile
new file mode 100644
index 0000000..4dcbff5
--- /dev/null
+++ b/src/xpm/Makefile
@@ -0,0 +1,28 @@
+# Makefile for the C library part of XPM needed by Icon.
+# This file is a simplification of XPM's standard Makefile.
+
+include ../../Makedefs
+
+## if your system doesn't provide strcasecmp add -DNEED_STRCASECMP
+## if your system doesn't provide pipe remove -DZPIPE
+
+RM = rm -f
+AR = ar qc
+RANLIB = ranlib
+OBJS1 = data.o create.o misc.o rgb.o scan.o parse.o hashtable.o \
+	  XpmWrFFrP.o XpmRdFToP.o XpmCrPFData.o XpmCrDataFP.o \
+	  XpmWrFFrI.o XpmRdFToI.o XpmCrIFData.o XpmCrDataFI.o
+
+.c.o:
+	$(CC) -c $(CFLAGS) $(XPMDEFS) $*.c
+
+
+libXpm.a: $(OBJS1)
+	$(RM) $@
+	$(AR) $@ $(OBJS1)
+	$(RANLIB) $@ 2>/dev/null || :
+
+$(OBJS1): xpmP.h xpm.h
+
+Clean:
+	rm *.o *.a
diff --git a/src/xpm/XpmCrDataFI.c b/src/xpm/XpmCrDataFI.c
new file mode 100644
index 0000000..81c742b
--- /dev/null
+++ b/src/xpm/XpmCrDataFI.c
@@ -0,0 +1,417 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmCrDataFI.c:                                                              *
+*                                                                             *
+*  XPM library                                                                *
+*  Scan an image and possibly its mask and create an XPM array                *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:string.h"
+#else
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#endif
+
+LFUNC(CreateTransparentColor, int, (char **dataptr, unsigned int *data_size,
+				    char **colors, unsigned int cpp,
+				    unsigned int mask_pixel,
+				    char ***colorTable));
+
+LFUNC(CreateOtherColors, int, (char **dataptr, unsigned int *data_size,
+			       char **colors, XColor *xcolors,
+			       unsigned int ncolors, unsigned int cpp,
+			       unsigned int mask_pixel, char ***colorTable,
+			       unsigned int ncolors2, Pixel *pixels,
+			       char *rgb_fname));
+
+LFUNC(CreatePixels, void, (char **dataptr, unsigned int width,
+			   unsigned int height, unsigned int cpp,
+			   unsigned int *pixels, char **colors));
+
+LFUNC(CountExtensions, void, (XpmExtension *ext, unsigned int num,
+			      unsigned int *ext_size,
+			      unsigned int *ext_nlines));
+
+LFUNC(CreateExtensions, void, (char **dataptr, unsigned int offset,
+			       XpmExtension *ext, unsigned int num,
+			       unsigned int ext_nlines));
+
+int
+XpmCreateDataFromImage(display, data_return, image, shapeimage, attributes)
+    Display *display;
+    char ***data_return;
+    XImage *image;
+    XImage *shapeimage;
+    XpmAttributes *attributes;
+{
+    int ErrorStatus;
+    xpmInternAttrib attrib;
+
+    /*
+     * initialize return values 
+     */
+    if (data_return)
+	*data_return = NULL;
+
+    xpmInitInternAttrib(&attrib);
+
+    /*
+     * Scan image then create data 
+     */
+    ErrorStatus = xpmScanImage(display, image, shapeimage,
+			       attributes, &attrib);
+
+    if (ErrorStatus == XpmSuccess)
+	ErrorStatus = xpmCreateData(data_return, &attrib, attributes);
+
+    xpmFreeInternAttrib(&attrib);
+
+    return (ErrorStatus);
+}
+
+
+#undef RETURN
+#define RETURN(status) \
+  { if (header) { \
+        for (l = 0; l < header_nlines; l++) \
+	    if (header[l]) \
+		free(header[l]); \
+	free(header); \
+    } \
+    return(status); }
+
+int
+xpmCreateData(data_return, attrib, attributes)
+    char ***data_return;
+    xpmInternAttrib *attrib;
+    XpmAttributes *attributes;
+{
+    /* calculation variables */
+    int ErrorStatus;
+    char buf[BUFSIZ];
+    char **header = NULL, **data, **sptr, **sptr2, *s;
+    unsigned int header_size, header_nlines;
+    unsigned int data_size, data_nlines;
+    unsigned int extensions = 0, ext_size = 0, ext_nlines = 0;
+    unsigned int infos = 0, offset, l, n;
+
+    *data_return = NULL;
+
+    infos = attributes && (attributes->valuemask & XpmInfos);
+    extensions = attributes && (attributes->valuemask & XpmExtensions)
+	&& attributes->nextensions;
+
+    /* compute the number of extensions lines and size */
+    if (extensions)
+	CountExtensions(attributes->extensions, attributes->nextensions,
+			&ext_size, &ext_nlines);
+
+    /*
+     * alloc a temporary array of char pointer for the header section which
+     * is the hints line + the color table lines 
+     */
+    header_nlines = 1 + attrib->ncolors;
+    header_size = sizeof(char *) * header_nlines;
+    header = (char **) calloc(header_size, sizeof(char *));
+    if (!header)
+	RETURN(XpmNoMemory);
+
+    /*
+     * print the hints line 
+     */
+    s = buf;
+    sprintf(s, "%d %d %d %d", attrib->width, attrib->height,
+	    attrib->ncolors, attrib->cpp);
+    s += strlen(s);
+
+    if (attributes && (attributes->valuemask & XpmHotspot)) {
+	sprintf(s, " %d %d", attributes->x_hotspot, attributes->y_hotspot);
+	s += strlen(s);
+    }
+
+    if (extensions)
+	sprintf(s, " XPMEXT");
+
+    l = strlen(buf) + 1;
+    *header = (char *) malloc(l);
+    if (!*header)
+	RETURN(XpmNoMemory);
+    header_size += l;
+    strcpy(*header, buf);
+
+    /*
+     * print colors 
+     */
+
+    /* transparent color */
+    if (attrib->mask_pixel != UNDEF_PIXEL) {
+	ErrorStatus =
+	    CreateTransparentColor(header + 1, &header_size,
+				   attrib->colorStrings, attrib->cpp,
+				   (infos ? attributes->mask_pixel : 0),
+				   (infos ? attributes->colorTable : NULL));
+	if (ErrorStatus != XpmSuccess)
+	    RETURN(ErrorStatus);
+
+	offset = 1;
+    } else
+	offset = 0;
+
+    /* other colors */
+    ErrorStatus =
+	CreateOtherColors(header + 1 + offset, &header_size,
+			  attrib->colorStrings + offset,
+			  attrib->xcolors + offset, attrib->ncolors - offset,
+			  attrib->cpp, (infos ? attributes->mask_pixel : 0),
+			  (infos ? attributes->colorTable : NULL),
+			  (infos ? attributes->ncolors : 0),
+			  (infos ? attributes->pixels : NULL),
+			  (attributes &&
+			   (attributes->valuemask & XpmRgbFilename) ?
+			   attributes->rgb_fname : NULL));
+    if (ErrorStatus != XpmSuccess)
+	RETURN(ErrorStatus);
+
+    /*
+     * now we know the size needed, alloc the data and copy the header lines 
+     */
+    offset = attrib->width * attrib->cpp + 1;
+    data_size = header_size + (attrib->height + ext_nlines) * sizeof(char *)
+	+ attrib->height * offset + ext_size;
+
+    data = (char **) malloc(data_size);
+    if (!data)
+	RETURN(XpmNoMemory);
+
+    data_nlines = header_nlines + attrib->height + ext_nlines;
+    *data = (char *) (data + data_nlines);
+    n = attrib->ncolors;
+    for (l = 0, sptr = data, sptr2 = header; l <= n; l++, sptr++, sptr2++) {
+	strcpy(*sptr, *sptr2);
+	*(sptr + 1) = *sptr + strlen(*sptr2) + 1;
+    }
+
+    /*
+     * print pixels 
+     */
+    data[header_nlines] = (char *) data + header_size +
+	(attrib->height + ext_nlines) * sizeof(char *);
+
+    CreatePixels(data + header_nlines, attrib->width, attrib->height,
+		 attrib->cpp, attrib->pixelindex, attrib->colorStrings);
+
+    /*
+     * print extensions
+     */
+    if (extensions)
+	CreateExtensions(data + header_nlines + attrib->height - 1, offset,
+			 attributes->extensions, attributes->nextensions,
+			 ext_nlines);
+
+    *data_return = data;
+
+    RETURN(XpmSuccess);
+}
+
+
+static int
+CreateTransparentColor(dataptr, data_size, colors, cpp, mask_pixel, colorTable)
+char **dataptr;
+unsigned int *data_size;
+char **colors;
+unsigned int cpp;
+unsigned int mask_pixel;
+char ***colorTable;
+{
+    char buf[BUFSIZ];
+    unsigned int key, l;
+    char *s, *s2;
+
+    strncpy(buf, *colors, cpp);
+    s = buf + cpp;
+
+    if (colorTable && mask_pixel != UNDEF_PIXEL) {
+	for (key = 1; key <= NKEYS; key++) {
+	    if (s2 = colorTable[mask_pixel][key]) {
+		sprintf(s, "\t%s %s", xpmColorKeys[key - 1], s2);
+		s += strlen(s);
+	    }
+	}
+    } else
+	sprintf(s, "\tc %s", TRANSPARENT_COLOR);
+
+    l = strlen(buf) + 1;
+    s = (char *) malloc(l);
+    if (!s)
+	return(XpmNoMemory);
+    *data_size += l;
+    strcpy(s, buf);
+    *dataptr = s;
+    return(XpmSuccess);
+}
+
+static int
+CreateOtherColors(dataptr, data_size, colors, xcolors, ncolors, cpp,
+		  mask_pixel, colorTable, ncolors2, pixels, rgb_fname)
+char **dataptr;
+unsigned int *data_size;
+char **colors;
+XColor *xcolors;
+unsigned int ncolors;
+unsigned int cpp;
+unsigned int mask_pixel;
+char ***colorTable;
+unsigned int ncolors2;
+Pixel *pixels;
+char *rgb_fname;
+{
+    char buf[BUFSIZ];
+    unsigned int a, b, c, d, key, l;
+    char *s, *s2, *colorname;
+    xpmRgbName rgbn[MAX_RGBNAMES];
+    int rgbn_max = 0;
+
+    /* read the rgb file if any was specified */
+    if (rgb_fname)
+	rgbn_max = xpmReadRgbNames(rgb_fname, rgbn);
+
+    for (a = 0; a < ncolors; a++, colors++, xcolors++, dataptr++) {
+
+	strncpy(buf, *colors, cpp);
+	s = buf + cpp;
+
+	c = 1;
+	if (colorTable) {
+	    d = 0;
+	    for (b = 0; b < ncolors2; b++) {
+		if (b == mask_pixel) {
+		    d = 1;
+		    continue;
+		}
+		if (pixels[b - d] == xcolors->pixel)
+		    break;
+	    }
+	    if (b != ncolors2) {
+		c = 0;
+		for (key = 1; key <= NKEYS; key++) {
+		    if (s2 = colorTable[b][key]) {
+			sprintf(s, "\t%s %s", xpmColorKeys[key - 1], s2);
+			s += strlen(s);
+		    }
+		}
+	    }
+	}
+	if (c) {
+	    colorname = NULL;
+	    if (rgbn_max)
+		colorname = xpmGetRgbName(rgbn, rgbn_max, xcolors->red,
+					  xcolors->green, xcolors->blue);
+	    if (colorname)
+		sprintf(s, "\tc %s", colorname);
+	    else
+		sprintf(s, "\tc #%04X%04X%04X",
+			xcolors->red, xcolors->green, xcolors->blue);
+	    s += strlen(s);
+	}
+	l = strlen(buf) + 1;
+	s = (char *) malloc(l);
+	if (!s)
+	    return(XpmNoMemory);
+	*data_size += l;
+	strcpy(s, buf);
+	*dataptr = s;
+    }
+    xpmFreeRgbNames(rgbn, rgbn_max);
+    return(XpmSuccess);
+}
+
+static void
+CreatePixels(dataptr, width, height, cpp, pixels, colors)
+char **dataptr;
+unsigned int width;
+unsigned int height;
+unsigned int cpp;
+unsigned int *pixels;
+char **colors;
+{
+    char *s;
+    unsigned int x, y, h, offset;
+
+    h = height - 1;
+    offset = width * cpp + 1;
+    for (y = 0; /* test is inside loop */ ; y++, dataptr++) {
+	s = *dataptr;
+	for (x = 0; x < width; x++, pixels++) {
+	    strncpy(s, colors[*pixels], cpp);
+	    s += cpp;
+	}
+	*s = '\0';
+	if (y >= h)
+	    break;		/* LEAVE LOOP */
+	*(dataptr + 1) = *dataptr + offset;
+    }
+}
+
+static void
+CountExtensions(ext, num, ext_size, ext_nlines)
+XpmExtension *ext;
+unsigned int num;
+unsigned int *ext_size;
+unsigned int *ext_nlines;
+{
+    unsigned int x, y, a, size, nlines;
+    char **lines;
+
+    size = 0;
+    nlines = 0;
+    for (x = 0; x < num; x++, ext++) {
+	/* "+ 2" is for the name and the ending 0 */
+	nlines += ext->nlines + 2;
+	/* 8 = 7 (for "XPMEXT ") + 1 (for 0) */
+	size += strlen(ext->name) + 8;
+	a = ext->nlines;
+	for (y = 0, lines = ext->lines; y < a; y++, lines++)
+	    size += strlen(*lines) + 1;
+    }
+    *ext_size = size;
+    *ext_nlines = nlines;
+}
+
+static void
+CreateExtensions(dataptr, offset, ext, num, ext_nlines)
+char **dataptr;
+unsigned int offset;
+XpmExtension *ext;
+unsigned int num;
+unsigned int ext_nlines;
+{
+    unsigned int x, y, a, b;
+    char **sptr;
+
+    *(dataptr + 1) = *dataptr + offset;
+    dataptr++;
+    a = 0;
+    for (x = 0; x < num; x++, ext++) {
+	sprintf(*dataptr, "XPMEXT %s", ext->name);
+	a++;
+	if (a < ext_nlines)
+	    *(dataptr + 1) = *dataptr + strlen(ext->name) + 8;
+	dataptr++;
+	b = ext->nlines;
+	for (y = 0, sptr = ext->lines; y < b; y++, sptr++) {
+	    strcpy(*dataptr, *sptr);
+	    a++;
+	    if (a < ext_nlines)
+		*(dataptr + 1) = *dataptr + strlen(*sptr) + 1;
+	    dataptr++;
+	}
+    }
+    *dataptr = 0;
+}
diff --git a/src/xpm/XpmCrDataFP.c b/src/xpm/XpmCrDataFP.c
new file mode 100644
index 0000000..fd2e5e6
--- /dev/null
+++ b/src/xpm/XpmCrDataFP.c
@@ -0,0 +1,75 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmCrDataFP.c:                                                              *
+*                                                                             *
+*  XPM library                                                                *
+*  Scan a pixmap and possibly its mask and create an XPM array                *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:string.h"
+#else
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#endif
+
+int
+XpmCreateDataFromPixmap(display, data_return, pixmap, shapemask, attributes)
+    Display *display;
+    char ***data_return;
+    Pixmap pixmap;
+    Pixmap shapemask;
+    XpmAttributes *attributes;
+{
+    XImage *image = NULL;
+    XImage *shapeimage = NULL;
+    unsigned int width = 0;
+    unsigned int height = 0;
+    int ErrorStatus;
+    unsigned int dum;
+    int dummy;
+    Window win;
+
+    /*
+     * get geometry 
+     */
+    if (attributes && attributes->valuemask & XpmSize) {
+	width = attributes->width;
+	height = attributes->height;
+    } else {
+	if (pixmap)
+	    XGetGeometry(display, pixmap, &win, &dummy, &dummy,
+			 &width, &height, &dum, &dum);
+	else if (shapemask)
+	    XGetGeometry(display, shapemask, &win, &dummy, &dummy,
+			 &width, &height, &dum, &dum);
+    }
+
+    /*
+     * get the images 
+     */
+    if (pixmap)
+	image = XGetImage(display, pixmap, 0, 0, width, height,
+			  AllPlanes, ZPixmap);
+    if (shapemask)
+	shapeimage = XGetImage(display, shapemask, 0, 0, width, height,
+			       AllPlanes, ZPixmap);
+
+    /*
+     * create data from images 
+     */
+    ErrorStatus = XpmCreateDataFromImage(display, data_return, image,
+					 shapeimage, attributes);
+    if (image)
+	XDestroyImage(image);
+    if (shapeimage)
+	XDestroyImage(shapeimage);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmCrIFData.c b/src/xpm/XpmCrIFData.c
new file mode 100644
index 0000000..259bf47
--- /dev/null
+++ b/src/xpm/XpmCrIFData.c
@@ -0,0 +1,52 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmCrIFData.c:                                                              *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an Xpm array and create the image and possibly its mask              *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+int
+XpmCreateImageFromData(display, data, image_return,
+		       shapeimage_return, attributes)
+    Display *display;
+    char **data;
+    XImage **image_return;
+    XImage **shapeimage_return;
+    XpmAttributes *attributes;
+{
+    xpmData mdata;
+    int ErrorStatus;
+    xpmInternAttrib attrib;
+
+    /*
+     * initialize return values 
+     */
+    if (image_return)
+	*image_return = NULL;
+    if (shapeimage_return)
+	*shapeimage_return = NULL;
+
+    xpmOpenArray(data, &mdata);
+    xpmInitInternAttrib(&attrib);
+
+    ErrorStatus = xpmParseData(&mdata, &attrib, attributes);
+
+    if (ErrorStatus == XpmSuccess)
+	ErrorStatus = xpmCreateImage(display, &attrib, image_return,
+				     shapeimage_return, attributes);
+
+    if (ErrorStatus >= 0)
+	xpmSetAttributes(&attrib, attributes);
+    else if (attributes)
+	XpmFreeAttributes(attributes);
+
+    xpmFreeInternAttrib(&attrib);
+    XpmDataClose(&mdata);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmCrPFData.c b/src/xpm/XpmCrPFData.c
new file mode 100644
index 0000000..dddb90e
--- /dev/null
+++ b/src/xpm/XpmCrPFData.c
@@ -0,0 +1,92 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmCrPFData.c:                                                              *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an Xpm array and create the pixmap and possibly its mask             *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+int
+XpmCreatePixmapFromData(display, d, data, pixmap_return,
+			shapemask_return, attributes)
+    Display *display;
+    Drawable d;
+    char **data;
+    Pixmap *pixmap_return;
+    Pixmap *shapemask_return;
+    XpmAttributes *attributes;
+{
+    XImage *image, **imageptr = NULL;
+    XImage *shapeimage, **shapeimageptr = NULL;
+    int ErrorStatus;
+    XGCValues gcv;
+    GC gc;
+
+    /*
+     * initialize return values 
+     */
+    if (pixmap_return) {
+	*pixmap_return = 0;
+	imageptr = &image;
+    }
+    if (shapemask_return) {
+	*shapemask_return = 0;
+	shapeimageptr = &shapeimage;
+    }
+
+    /*
+     * create the images 
+     */
+    ErrorStatus = XpmCreateImageFromData(display, data, imageptr,
+					 shapeimageptr, attributes);
+    if (ErrorStatus < 0)
+	return (ErrorStatus);
+
+    /*
+     * create the pixmaps 
+     */
+    if (imageptr && image) {
+	*pixmap_return = XCreatePixmap(display, d, image->width,
+				       image->height, image->depth);
+	gcv.function = GXcopy;
+	gc = XCreateGC(display, *pixmap_return, GCFunction, &gcv);
+
+	XPutImage(display, *pixmap_return, gc, image, 0, 0, 0, 0,
+		  image->width, image->height);
+
+#ifdef Debug
+	/*
+	 * XDestroyImage free the image data but mnemosyne don't know about it
+	 * so I free them by hand to avoid mnemalyse report it as lost data.
+	 */
+	free(image->data);
+#endif
+	XDestroyImage(image);
+	XFreeGC(display, gc);
+    }
+    if (shapeimageptr && shapeimage) {
+	*shapemask_return = XCreatePixmap(display, d, shapeimage->width,
+					  shapeimage->height,
+					  shapeimage->depth);
+	gcv.function = GXcopy;
+	gc = XCreateGC(display, *shapemask_return, GCFunction, &gcv);
+
+	XPutImage(display, *shapemask_return, gc, shapeimage, 0, 0, 0, 0,
+		  shapeimage->width, shapeimage->height);
+
+#ifdef Debug
+	/*
+	 * XDestroyImage free the image data but mnemosyne don't know about it
+	 * so I free them by hand to avoid mnemalyse report it as lost data.
+	 */
+	free(shapeimage->data);
+#endif
+	XDestroyImage(shapeimage);
+	XFreeGC(display, gc);
+    }
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmRdFToData.c b/src/xpm/XpmRdFToData.c
new file mode 100644
index 0000000..5d68e73
--- /dev/null
+++ b/src/xpm/XpmRdFToData.c
@@ -0,0 +1,115 @@
+/* Copyright 1990,91 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmRdFToData.c:                                                             *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an XPM file and create an array of strings corresponding to it.      *
+*                                                                             *
+*  Developed by Dan Greening dgreen@cs.ucla.edu / dgreen@sti.com              *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+int
+XpmReadFileToData(filename, data_return)
+    char *filename;
+    char ***data_return;
+{
+    xpmData mdata;
+    char buf[BUFSIZ];
+    int l, n = 0;
+    XpmAttributes attributes;
+    xpmInternAttrib attrib;
+    int ErrorStatus;
+    XGCValues gcv;
+    GC gc;
+
+    attributes.valuemask = XpmReturnPixels|XpmReturnInfos|XpmReturnExtensions;
+    /*
+     * initialize return values 
+     */
+    if (data_return) {
+	*data_return = NULL;
+    }
+
+    if ((ErrorStatus = xpmReadFile(filename, &mdata)) != XpmSuccess)
+	return (ErrorStatus);
+    xpmInitInternAttrib(&attrib);
+    /*
+     * parse the header file 
+     */
+    mdata.Bos = '\0';
+    mdata.Eos = '\n';
+    mdata.Bcmt = mdata.Ecmt = NULL;
+    xpmNextWord(&mdata, buf);		/* skip the first word */
+    l = xpmNextWord(&mdata, buf);	/* then get the second word */
+    if ((l == 3 && !strncmp("XPM", buf, 3)) ||
+	(l == 4 && !strncmp("XPM2", buf, 4))) {
+	if (l == 3)
+	    n = 1;			/* handle XPM as XPM2 C */
+	else {
+	    l = xpmNextWord(&mdata, buf); /* get the type key word */
+
+	    /*
+	     * get infos about this type 
+	     */
+	    while (xpmDataTypes[n].type
+		   && strncmp(xpmDataTypes[n].type, buf, l))
+		n++;
+	}
+	if (xpmDataTypes[n].type) {
+	    if (n == 0) {		/* natural type */
+		mdata.Bcmt = xpmDataTypes[n].Bcmt;
+		mdata.Ecmt = xpmDataTypes[n].Ecmt;
+		xpmNextString(&mdata);	/* skip the end of headerline */
+		mdata.Bos = xpmDataTypes[n].Bos;
+	    } else {
+		xpmNextString(&mdata);	/* skip the end of headerline */
+		mdata.Bcmt = xpmDataTypes[n].Bcmt;
+		mdata.Ecmt = xpmDataTypes[n].Ecmt;
+		mdata.Bos = xpmDataTypes[n].Bos;
+		mdata.Eos = '\0';
+		xpmNextString(&mdata);	/* skip the assignment line */
+	    }
+	    mdata.Eos = xpmDataTypes[n].Eos;
+
+	    ErrorStatus = xpmParseData(&mdata, &attrib, &attributes);
+	} else
+	    ErrorStatus = XpmFileInvalid;
+    } else
+	ErrorStatus = XpmFileInvalid;
+
+    if (ErrorStatus == XpmSuccess) {
+	int i;
+	
+	/* maximum of allocated pixels will be the number of colors */
+	attributes.pixels = (Pixel *) malloc(sizeof(Pixel) * attrib.ncolors);
+	attrib.xcolors = (XColor*) malloc(sizeof(XColor) * attrib.ncolors);
+
+	if (!attributes.pixels || !attrib.xcolors)
+	    ErrorStatus = XpmNoMemory;
+	else {
+	    for (i = 0; i < attrib.ncolors; i++) {
+		/* Fake colors */
+		attrib.xcolors[i].pixel = attributes.pixels[i] = i + 1;
+	    }
+	    xpmSetAttributes(&attrib, &attributes);
+	    if (!(attrib.colorStrings =
+		  (char**) malloc(attributes.ncolors * sizeof(char*))))
+		ErrorStatus = XpmNoMemory;
+	    else {
+		attrib.ncolors = attributes.ncolors;
+		attributes.mask_pixel = attrib.mask_pixel;
+		for (i = 0; i < attributes.ncolors; i++)
+		    attrib.colorStrings[i] = attributes.colorTable[i][0];
+	    }
+	}
+    }
+    if (ErrorStatus == XpmSuccess)
+	ErrorStatus = xpmCreateData(data_return, &attrib, &attributes);
+    XpmFreeAttributes(&attributes);
+    xpmFreeInternAttrib(&attrib);
+    XpmDataClose(&mdata);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmRdFToI.c b/src/xpm/XpmRdFToI.c
new file mode 100644
index 0000000..af68f69
--- /dev/null
+++ b/src/xpm/XpmRdFToI.c
@@ -0,0 +1,110 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmRdFToI.c:                                                                *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an XPM file and create the image and possibly its mask               *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+xpmDataType xpmDataTypes[] =
+{
+ "", "!", "\n", '\0', '\n', "", "", "", "",	/* Natural type */
+ "C", "/*", "*/", '"', '"', ",\n", "static char *", "[] = {\n", "};\n",
+ "Lisp", ";", "\n", '"', '"', "\n", "(setq ", " '(\n", "))\n",
+#ifdef VMS
+ NULL
+#else
+ NULL, NULL, NULL, 0, 0, NULL, NULL, NULL, NULL
+#endif
+};
+
+int
+XpmReadFileToImage(display, filename, image_return,
+		   shapeimage_return, attributes)
+    Display *display;
+    char *filename;
+    XImage **image_return;
+    XImage **shapeimage_return;
+    XpmAttributes *attributes;
+{
+    xpmData mdata;
+    char buf[BUFSIZ];
+    int l, n = 0;
+    int ErrorStatus;
+    xpmInternAttrib attrib;
+
+    /*
+     * initialize return values 
+     */
+    if (image_return)
+	*image_return = NULL;
+    if (shapeimage_return)
+	*shapeimage_return = NULL;
+
+    if ((ErrorStatus = xpmReadFile(filename, &mdata)) != XpmSuccess)
+	return (ErrorStatus);
+
+    xpmInitInternAttrib(&attrib);
+
+    /*
+     * parse the header file 
+     */
+    mdata.Bos = '\0';
+    mdata.Eos = '\n';
+    mdata.Bcmt = mdata.Ecmt = NULL;
+    xpmNextWord(&mdata, buf);		/* skip the first word */
+    l = xpmNextWord(&mdata, buf);	/* then get the second word */
+    if ((l == 3 && !strncmp("XPM", buf, 3)) ||
+	(l == 4 && !strncmp("XPM2", buf, 4))) {
+	if (l == 3)
+	    n = 1;			/* handle XPM as XPM2 C */
+	else {
+	    l = xpmNextWord(&mdata, buf); /* get the type key word */
+
+	    /*
+	     * get infos about this type 
+	     */
+	    while (xpmDataTypes[n].type
+		   && strncmp(xpmDataTypes[n].type, buf, l))
+		n++;
+	}
+	if (xpmDataTypes[n].type) {
+	    if (n == 0) {		/* natural type */
+		mdata.Bcmt = xpmDataTypes[n].Bcmt;
+		mdata.Ecmt = xpmDataTypes[n].Ecmt;
+		xpmNextString(&mdata);	/* skip the end of headerline */
+		mdata.Bos = xpmDataTypes[n].Bos;
+	    } else {
+		xpmNextString(&mdata);	/* skip the end of headerline */
+		mdata.Bcmt = xpmDataTypes[n].Bcmt;
+		mdata.Ecmt = xpmDataTypes[n].Ecmt;
+		mdata.Bos = xpmDataTypes[n].Bos;
+		mdata.Eos = '\0';
+		xpmNextString(&mdata);	/* skip the assignment line */
+	    }
+	    mdata.Eos = xpmDataTypes[n].Eos;
+
+	    ErrorStatus = xpmParseData(&mdata, &attrib, attributes);
+
+	    if (ErrorStatus == XpmSuccess)
+		ErrorStatus = xpmCreateImage(display, &attrib, image_return,
+                                             shapeimage_return, attributes);
+	} else
+	    ErrorStatus = XpmFileInvalid;
+    } else
+	ErrorStatus = XpmFileInvalid;
+
+    if (ErrorStatus >= 0)
+	xpmSetAttributes(&attrib, attributes);
+    else if (attributes)
+	XpmFreeAttributes(attributes);
+
+    xpmFreeInternAttrib(&attrib);
+    XpmDataClose(&mdata);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmRdFToP.c b/src/xpm/XpmRdFToP.c
new file mode 100644
index 0000000..51732b5
--- /dev/null
+++ b/src/xpm/XpmRdFToP.c
@@ -0,0 +1,92 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmRdFToP.c:                                                                *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an XPM file and create the pixmap and possibly its mask              *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+int
+XpmReadFileToPixmap(display, d, filename, pixmap_return,
+		    shapemask_return, attributes)
+    Display *display;
+    Drawable d;
+    char *filename;
+    Pixmap *pixmap_return;
+    Pixmap *shapemask_return;
+    XpmAttributes *attributes;
+{
+    XImage *image, **imageptr = NULL;
+    XImage *shapeimage, **shapeimageptr = NULL;
+    int ErrorStatus;
+    XGCValues gcv;
+    GC gc;
+
+    /*
+     * initialize return values 
+     */
+    if (pixmap_return) {
+	*pixmap_return = 0;
+	imageptr = &image;
+    }
+    if (shapemask_return) {
+	*shapemask_return = 0;
+	shapeimageptr = &shapeimage;
+    }
+
+    /*
+     * create the images 
+     */
+    ErrorStatus = XpmReadFileToImage(display, filename, imageptr,
+				     shapeimageptr, attributes);
+    if (ErrorStatus < 0)
+	return (ErrorStatus);
+
+    /*
+     * create the pixmaps 
+     */
+    if (imageptr && image) {
+	*pixmap_return = XCreatePixmap(display, d, image->width,
+				       image->height, image->depth);
+	gcv.function = GXcopy;
+	gc = XCreateGC(display, *pixmap_return, GCFunction, &gcv);
+
+	XPutImage(display, *pixmap_return, gc, image, 0, 0, 0, 0,
+		  image->width, image->height);
+
+#ifdef Debug
+	/*
+	 * XDestroyImage free the image data but mnemosyne don't know about it
+	 * so I free them by hand to avoid mnemalyse report it as lost data.
+	 */
+	free(image->data);
+#endif
+	XDestroyImage(image);
+	XFreeGC(display, gc);
+    }
+    if (shapeimageptr && shapeimage) {
+	*shapemask_return = XCreatePixmap(display, d, shapeimage->width,
+					  shapeimage->height,
+					  shapeimage->depth);
+	gcv.function = GXcopy;
+	gc = XCreateGC(display, *shapemask_return, GCFunction, &gcv);
+
+	XPutImage(display, *shapemask_return, gc, shapeimage, 0, 0, 0, 0,
+		  shapeimage->width, shapeimage->height);
+
+#ifdef Debug
+	/*
+	 * XDestroyImage free the image data but mnemosyne don't know about it
+	 * so I free them by hand to avoid mnemalyse report it as lost data.
+	 */
+	free(shapeimage->data);
+#endif
+	XDestroyImage(shapeimage);
+	XFreeGC(display, gc);
+    }
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmWrFFrData.c b/src/xpm/XpmWrFFrData.c
new file mode 100644
index 0000000..3d567ec
--- /dev/null
+++ b/src/xpm/XpmWrFFrData.c
@@ -0,0 +1,113 @@
+/* Copyright 1990,91 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmWrFFrData.c:                                                             *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an Xpm array and write a file that corresponds to it.                *
+*                                                                             *
+*  Developed by Dan Greening dgreen@cs.ucla.edu / dgreen@sti.com              *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:string.h"
+#else
+#ifdef SYSV
+#include <string.h>
+#define index strchr
+#define rindex strrchr
+#else
+#include <strings.h>
+#endif
+#endif
+
+int
+XpmWriteFileFromData(filename, data)
+    char *filename;
+    char **data;
+{
+    xpmData mdata, mfile;
+    char *name, *dot, *s, *new_name = NULL;
+    int ErrorStatus;
+    XpmAttributes attributes;
+    xpmInternAttrib attrib;
+    int i;
+
+    attributes.valuemask = XpmReturnPixels|XpmReturnInfos|XpmReturnExtensions;
+    if ((ErrorStatus = xpmWriteFile(filename, &mfile)) != XpmSuccess)
+	return (ErrorStatus);
+
+    if (filename) {
+#ifdef VMS
+	name = filename;
+#else
+	if (!(name = rindex(filename, '/')))
+	    name = filename;
+	else
+	    name++;
+#endif
+	if (dot = index(name, '.')) {
+	    new_name = (char*)strdup(name);
+	    if (!new_name) {
+		new_name = NULL;
+		name = "image_name";
+	    } else {
+		/* change '.' to '_' to get a valid C syntax name */
+		name = s = new_name;
+		while (dot = index(s, '.')) {
+		    *dot = '_';
+		    s = dot;
+		}
+	    }
+	}
+    } else
+	name = "image_name";
+
+    xpmInitInternAttrib(&attrib);
+
+    /*
+     * Parse data then write it out 
+     */
+
+    xpmOpenArray(data, &mdata);
+
+    ErrorStatus = xpmParseData(&mdata, &attrib, &attributes);
+    if (ErrorStatus == XpmSuccess) {
+	attributes.mask_pixel = UNDEF_PIXEL;
+
+	/* maximum of allocated pixels will be the number of colors */
+	attributes.pixels = (Pixel *) malloc(sizeof(Pixel) * attrib.ncolors);
+	attrib.xcolors = (XColor*) malloc(sizeof(XColor) * attrib.ncolors);
+
+	if (!attributes.pixels || !attrib.xcolors)
+	    ErrorStatus == XpmNoMemory;
+	else {
+	    int i;
+
+	    for (i = 0; i < attrib.ncolors; i++) {
+		/* Fake colors */
+		attrib.xcolors[i].pixel = attributes.pixels[i] = i + 1;
+	    }
+	    xpmSetAttributes(&attrib, &attributes);
+	    if (!(attrib.colorStrings =
+		  (char**) malloc(attributes.ncolors * sizeof(char*))))
+		ErrorStatus == XpmNoMemory;
+	    else {
+		attrib.ncolors = attributes.ncolors;
+		for (i = 0; i < attributes.ncolors; i++)
+		    attrib.colorStrings[i] = attributes.colorTable[i][0];
+
+		attrib.name = name;
+		ErrorStatus = xpmWriteData(&mfile, &attrib, &attributes);
+	    }
+	}
+    }
+    if (new_name)
+	free(name);
+    XpmFreeAttributes(&attributes);
+    xpmFreeInternAttrib(&attrib);
+    XpmDataClose(&mfile);
+    XpmDataClose(&mdata);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/XpmWrFFrI.c b/src/xpm/XpmWrFFrI.c
new file mode 100644
index 0000000..5b3706c
--- /dev/null
+++ b/src/xpm/XpmWrFFrI.c
@@ -0,0 +1,341 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmWrFFrI.c:                                                                *
+*                                                                             *
+*  XPM library                                                                *
+*  Write an image and possibly its mask to an XPM file                        *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:string.h"
+#else
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#define index strchr
+#define rindex strrchr
+#else
+#include <strings.h>
+#endif
+#endif
+
+LFUNC(WriteTransparentColor, void, (FILE *file, char **colors,
+				    unsigned int cpp, unsigned int mask_pixel,
+				    char ***colorTable));
+
+LFUNC(WriteOtherColors, void, (FILE *file, char **colors, XColor *xcolors,
+			       unsigned int ncolors, unsigned int cpp,
+			       unsigned int mask_pixel, char ***colorTable,
+			       unsigned int ncolors2, Pixel *pixels,
+			       char *rgb_fname));
+
+LFUNC(WritePixels, int, (FILE *file, unsigned int width, unsigned int height,
+			 unsigned int cpp, unsigned int *pixels,
+			 char **colors));
+
+LFUNC(WriteExtensions, void, (FILE *file, XpmExtension *ext,
+			      unsigned int num));
+
+int
+XpmWriteFileFromImage(display, filename, image, shapeimage, attributes)
+    Display *display;
+    char *filename;
+    XImage *image;
+    XImage *shapeimage;
+    XpmAttributes *attributes;
+{
+    xpmData mdata;
+    char *name, *dot, *s, *new_name = NULL;
+    int ErrorStatus;
+    xpmInternAttrib attrib;
+
+    if ((ErrorStatus = xpmWriteFile(filename, &mdata)) != XpmSuccess)
+	return (ErrorStatus);
+
+    if (filename) {
+#ifdef VMS
+	name = filename;
+#else
+	if (!(name = rindex(filename, '/')))
+	    name = filename;
+	else
+	    name++;
+#endif
+	if (dot = index(name, '.')) {
+	    new_name = (char*)strdup(name);
+	    if (!new_name) {
+		new_name = NULL;
+		name = "image_name";
+	    } else {
+		/* change '.' to '_' to get a valid C syntax name */
+		name = s = new_name;
+		while (dot = index(s, '.')) {
+		    *dot = '_';
+		    s = dot;
+		}
+	    }
+	}
+    } else
+	name = "image_name";
+
+    xpmInitInternAttrib(&attrib);
+
+    /*
+     * Scan image then write it out 
+     */
+    ErrorStatus = xpmScanImage(display, image, shapeimage,
+			       attributes, &attrib);
+
+    if (ErrorStatus == XpmSuccess) {
+	attrib.name = name;
+	ErrorStatus = xpmWriteData(&mdata, &attrib, attributes);
+    }
+    xpmFreeInternAttrib(&attrib);
+    XpmDataClose(&mdata);
+    if (new_name)
+	free(name);
+
+    return (ErrorStatus);
+}
+
+
+int
+xpmWriteData(mdata, attrib, attributes)
+    xpmData *mdata;
+    xpmInternAttrib *attrib;
+    XpmAttributes *attributes;
+{
+    /* calculation variables */
+    unsigned int offset, infos;
+    FILE *file;
+    int ErrorStatus;
+
+    /* store this to speed up */
+    file = mdata->stream.file;
+
+    infos = attributes && (attributes->valuemask & XpmInfos);
+
+    /*
+     * print the header line 
+     */
+    fprintf(file, "/* XPM */\nstatic char * %s[] = {\n", attrib->name);
+
+    /*
+     * print the hints line 
+     */
+    if (infos && attributes->hints_cmt)
+	fprintf(file, "/*%s*/\n", attributes->hints_cmt);
+
+    fprintf(file, "\"%d %d %d %d", attrib->width, attrib->height,
+	    attrib->ncolors, attrib->cpp);
+
+    if (attributes && (attributes->valuemask & XpmHotspot))
+	fprintf(file, " %d %d", attributes->x_hotspot, attributes->y_hotspot);
+
+    if (attributes && (attributes->valuemask & XpmExtensions)
+	&& attributes->nextensions)
+	fprintf(file, " XPMEXT");
+
+    fprintf(file, "\",\n");
+
+    /*
+     * print colors 
+     */
+    if (infos && attributes->colors_cmt)
+	fprintf(file, "/*%s*/\n", attributes->colors_cmt);
+
+    /* transparent color */
+    if (attrib->mask_pixel != UNDEF_PIXEL) {
+	WriteTransparentColor(file, attrib->colorStrings, attrib->cpp,
+			      (infos ? attributes->mask_pixel : 0),
+			      (infos ? attributes->colorTable : NULL));
+	offset = 1;
+    } else
+	offset = 0;
+
+    /* other colors */
+    WriteOtherColors(file, attrib->colorStrings + offset,
+		     attrib->xcolors + offset, attrib->ncolors - offset,
+		     attrib->cpp, (infos ? attributes->mask_pixel : 0),
+		     (infos ? attributes->colorTable : NULL),
+		     (infos ? attributes->ncolors : 0),
+		     (infos ? attributes->pixels : NULL),
+		     (attributes && (attributes->valuemask & XpmRgbFilename) ?
+		      attributes->rgb_fname : NULL));
+
+    /*
+     * print pixels 
+     */
+    if (infos && attributes->pixels_cmt)
+	fprintf(file, "/*%s*/\n", attributes->pixels_cmt);
+
+    ErrorStatus = WritePixels(file, attrib->width, attrib->height, attrib->cpp,
+			      attrib->pixelindex, attrib->colorStrings);
+    if (ErrorStatus != XpmSuccess)
+	return(ErrorStatus);
+
+    /*
+     * print extensions
+     */
+    if (attributes && (attributes->valuemask & XpmExtensions)
+	&& attributes->nextensions)
+	WriteExtensions(file, attributes->extensions, attributes->nextensions);
+
+    /* close the array */
+    fprintf(file, "};\n");
+
+    return (XpmSuccess);
+}
+
+static void
+WriteTransparentColor(file, colors, cpp, mask_pixel, colorTable)
+FILE *file;
+char **colors;
+unsigned int cpp;
+unsigned int mask_pixel;
+char ***colorTable;
+{
+    unsigned int key, i;
+    char *s;
+
+    putc('"', file);
+    for (i = 0, s = *colors; i < cpp; i++, s++)
+	putc(*s, file);
+
+    if (colorTable && mask_pixel != UNDEF_PIXEL) {
+	for (key = 1; key <= NKEYS; key++) {
+	    if (s = colorTable[mask_pixel][key])
+		fprintf(file, "\t%s %s", xpmColorKeys[key - 1], s);
+	}
+    } else
+	fprintf(file, "\tc %s", TRANSPARENT_COLOR);
+
+    fprintf(file, "\",\n");
+}
+
+static void
+WriteOtherColors(file, colors, xcolors, ncolors, cpp, mask_pixel, colorTable,
+		 ncolors2, pixels, rgb_fname)
+FILE *file;
+char **colors;
+XColor *xcolors;
+unsigned int ncolors;
+unsigned int cpp;
+unsigned int mask_pixel;
+char ***colorTable;
+unsigned int ncolors2;
+Pixel *pixels;
+char *rgb_fname;
+{
+    unsigned int a, b, c, d, key;
+    char *s, *colorname;
+    xpmRgbName rgbn[MAX_RGBNAMES];
+    int rgbn_max = 0;
+
+    /* read the rgb file if any was specified */
+    if (rgb_fname)
+	rgbn_max = xpmReadRgbNames(rgb_fname, rgbn);
+
+    for (a = 0; a < ncolors; a++, colors++, xcolors++) {
+
+	putc('"', file);
+	for (b = 0, s = *colors; b < cpp; b++, s++)
+	    putc(*s, file);
+
+	c = 1;
+	if (colorTable) {
+	    d = 0;
+	    for (b = 0; b < ncolors2; b++) {
+		if (b == mask_pixel) {
+		    d = 1;
+		    continue;
+		}
+		if (pixels[b - d] == xcolors->pixel)
+		    break;
+	    }
+	    if (b != ncolors2) {
+		c = 0;
+		for (key = 1; key <= NKEYS; key++) {
+		    if (s = colorTable[b][key])
+			fprintf(file, "\t%s %s", xpmColorKeys[key - 1], s);
+		}
+	    }
+	}
+	if (c) {
+	    colorname = NULL;
+	    if (rgbn_max)
+		colorname = xpmGetRgbName(rgbn, rgbn_max, xcolors->red,
+					  xcolors->green, xcolors->blue);
+	    if (colorname)
+		fprintf(file, "\tc %s", colorname);
+	    else
+		fprintf(file, "\tc #%04X%04X%04X", xcolors->red,
+			xcolors->green, xcolors->blue);
+	}
+	fprintf(file, "\",\n");
+    }
+    xpmFreeRgbNames(rgbn, rgbn_max);
+}
+
+
+static int
+WritePixels(file, width, height, cpp, pixels, colors)
+FILE *file;
+unsigned int width;
+unsigned int height;
+unsigned int cpp;
+unsigned int *pixels;
+char **colors;
+{
+    char *s, *p, *buf;
+    unsigned int x, y, h;
+
+    h = height - 1;
+    p = buf = (char *) malloc(width * cpp + 3);
+    *buf = '"';
+    if (!buf)
+	return(XpmNoMemory);
+    p++;
+    for (y = 0; y < h; y++) {
+	s = p;
+	for (x = 0; x < width; x++, pixels++) {
+	    strncpy(s, colors[*pixels], cpp);
+	    s += cpp;
+	}
+	*s++ = '"';
+	*s = '\0';
+	fprintf(file, "%s,\n", buf);
+    }
+    /* duplicate some code to avoid a test in the loop */
+    s = p;
+    for (x = 0; x < width; x++, pixels++) {
+	strncpy(s, colors[*pixels], cpp);
+	s += cpp;
+    }
+    *s++ = '"';
+    *s = '\0';
+    fprintf(file, "%s", buf);
+
+    free(buf);
+    return(XpmSuccess);
+}
+
+static void
+WriteExtensions(file, ext, num)
+FILE *file;
+XpmExtension *ext;
+unsigned int num;
+{
+    unsigned int x, y, n;
+    char **line;
+
+    for (x = 0; x < num; x++, ext++) {
+	fprintf(file, ",\n\"XPMEXT %s\"", ext->name);
+	n = ext->nlines;
+	for (y = 0, line = ext->lines; y < n; y++, line++)
+	    fprintf(file, ",\n\"%s\"", *line);
+    }
+    fprintf(file, ",\n\"XPMENDEXT\"");
+}
diff --git a/src/xpm/XpmWrFFrP.c b/src/xpm/XpmWrFFrP.c
new file mode 100644
index 0000000..52eef29
--- /dev/null
+++ b/src/xpm/XpmWrFFrP.c
@@ -0,0 +1,75 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* XpmWrFFrP.c:                                                                *
+*                                                                             *
+*  XPM library                                                                *
+*  Write a pixmap and possibly its mask to an XPM file                        *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:string.h"
+#else
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#endif
+
+int
+XpmWriteFileFromPixmap(display, filename, pixmap, shapemask, attributes)
+    Display *display;
+    char *filename;
+    Pixmap pixmap;
+    Pixmap shapemask;
+    XpmAttributes *attributes;
+{
+    XImage *image = NULL;
+    XImage *shapeimage = NULL;
+    unsigned int width = 0;
+    unsigned int height = 0;
+    int ErrorStatus;
+    unsigned int dum;
+    int dummy;
+    Window win;
+
+    /*
+     * get geometry 
+     */
+    if (attributes && attributes->valuemask & XpmSize) {
+	width = attributes->width;
+	height = attributes->height;
+    } else {
+	if (pixmap)
+	    XGetGeometry(display, pixmap, &win, &dummy, &dummy,
+			 &width, &height, &dum, &dum);
+	else if (shapemask)
+	    XGetGeometry(display, shapemask, &win, &dummy, &dummy,
+			 &width, &height, &dum, &dum);
+    }
+
+    /*
+     * get the images 
+     */
+    if (pixmap)
+	image = XGetImage(display, pixmap, 0, 0, width, height,
+			  AllPlanes, ZPixmap);
+    if (shapemask)
+	shapeimage = XGetImage(display, shapemask, 0, 0, width, height,
+			       AllPlanes, ZPixmap);
+
+    /*
+     * write them out 
+     */
+    ErrorStatus = XpmWriteFileFromImage(display, filename, image, shapeimage,
+					attributes);
+    if (image)
+	XDestroyImage(image);
+    if (shapeimage)
+	XDestroyImage(shapeimage);
+
+    return (ErrorStatus);
+}
diff --git a/src/xpm/converters/ppm.README b/src/xpm/converters/ppm.README
new file mode 100644
index 0000000..b5e254f
--- /dev/null
+++ b/src/xpm/converters/ppm.README
@@ -0,0 +1,69 @@
+PPM Stuff 
+Convert portable pixmap to X11 Pixmap format (version 3) and vice versa
+-----------------------------------------------------------------------
+
+The program ppmtoxpm is a modified version of one sent out by Mark Snitily
+(mark@zok.uucp) and upgraded to XPM version 2 by Paul Breslaw
+(paul@mecazh.uu.ch).
+
+It converts Jeff Poskanzer's (jef@well.sf.ca.us) portable pixmap format
+(PBMPlus) into the new X11 pixmap format: XPM version 3 distributed by Arnaud
+Le Hors (lehors@mirsa.inria.fr).
+
+It is built using the PBMPlus libraries in the same way as any of the
+ppm utilities in the PBMPlus package.
+
+Paul Breslaw - Thu Nov 22 09:55:31 MET 1990
+--
+Paul Breslaw, Mecasoft SA,          |  telephone :  41 1 362 2040
+Guggachstrasse 10, CH-8057 Zurich,  |  e-mail    :  paul@mecazh.uu.ch
+Switzerland.                        |               mcsun!chx400!mecazh!paul
+--
+
+The program xpmtoppm is a modified version of the one distributed in the
+PBMPlus package by Jeff Poskanzer's which converts XPM version 1 or 3 files
+into a portable pixmap format.
+
+Upgraded to XPM version 3 by
+  Arnaud LE HORS     BULL Research France -- Koala Project
+  lehors@sa.inria.fr  Phone:(33) 93 65 77 71  Fax:(33) 93 65 77 66
+  Inria Sophia Antipolis B.P.109 06561 Valbonne Cedex France
+
+
+Installation
+-----------
+You should copy The ppmtoxpm.c, ppmtoxpm.1 and xpmtoppm.c, xpmtoppm.1 into
+your .../pbmplus/ppm directory.
+
+
+Patches
+-------
+* Rainer Sinkwitz sinkwitz@ifi.unizh.ch - 21 Nov 91:
+
+xpmtoppm.c:
+  - Bug fix, no advance of read ptr, would not read 
+    colors like "ac c black" because it would find 
+    the "c" of "ac" and then had problems with "c"
+    as color.
+    
+  - Now understands multword X11 color names
+  
+  - Now reads multiple color keys. Takes the color
+    of the hightest available key. Lines no longer need
+    to begin with key 'c'.
+    
+  - expanded line buffer to from 500 to 2048 for bigger files
+    
+ppmtoxpm.c:
+  - Bug fix, should should malloc space for rgbn[j].name+1 in line 441
+    caused segmentation faults
+    
+  - lowercase conversion of RGB names def'ed out,
+    considered harmful.
+    
+Suggestions:
+  ppmtoxpm should read /usr/lib/X11/rgb.txt by default.
+  With the Imakefiles of pbmplus it even gets compiled 
+  with -DRGB_DB=\"/usr/lib/X11/rgb.txt\"
+
+
diff --git a/src/xpm/converters/ppmtoxpm.1 b/src/xpm/converters/ppmtoxpm.1
new file mode 100644
index 0000000..2b35fa6
--- /dev/null
+++ b/src/xpm/converters/ppmtoxpm.1
@@ -0,0 +1,69 @@
+.TH ppmtoxpm 1 "Tue Apr 9 1991"
+.SH NAME
+ppmtoxpm - convert a portable pixmap into an X11 pixmap
+.SH SYNOPSIS
+ppmtoxpm [-name <xpmname>] [-rgb <rgb-textfile>] [<ppmfile>]
+.SH DESCRIPTION
+Reads a portable pixmap as input.
+Produces X11 pixmap  (version 3) as output which
+can be loaded directly by the XPM library.
+.PP
+The \fB-name\f option allows one to specify the prefix string which is printed
+in the resulting XPM output.  If not specified, will default to the
+filename (without extension) of the <ppmfile> argument.
+If \fB-name\f is not specified and <ppmfile>
+is not specified (i.e. piped input), the prefix string will default to
+the string "noname".
+.PP
+The \fB-rgb\f option allows one to specify an X11 rgb text file for the
+lookup of color name mnemonics.  This rgb text file is typically the
+/usr/lib/X11/rgb.txt of the MIT X11 distribution, but any file using the
+same format may be used.  When specified and
+a RGB value from the ppm input matches a RGB value from the <rgb-textfile>,
+then the corresponding color name mnemonic is printed in the XPM's colormap.
+If \fB-rgb\f is not specified, or if the RGB values don't match, then the color
+will be printed with the #RGB, #RRGGBB, #RRRGGGBBB, or #RRRRGGGGBBBB
+hexadecimal format.
+.PP
+All flags can be abbreviated to their shortest unique prefix.
+.PP
+For example, to convert the file "dot" (found in /usr/include/X11/bitmaps),
+from xbm to xpm one could specify
+.IP
+xbmtopbm dot | ppmtoxpm -name dot
+.PP
+or, with a rgb text file (in the local directory)
+.IP
+xbmtopbm dot | ppmtoxpm -name dot -rgb rgb.txt
+.SH BUGS
+An option to match the closest (rather than exact) color name mnemonic
+from the rgb text would be a desirable enhancement.
+.PP
+Truncation of the least significant bits of a RGB value may result in
+nonexact matches when performing color name mnemonic lookups.
+.SH "SEE ALSO"
+ppm(5)
+.br
+XPM Manual by Arnaud Le Hors lehors@mirsa.inria.fr 
+.SH AUTHOR
+Copyright (C) 1990 by Mark W. Snitily.
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted, provided
+that the above copyright notice appear in all copies and that both that
+copyright notice and this permission notice appear in supporting
+documentation.  This software is provided "as is" without express or
+implied warranty.
+
+This tool was developed for Schlumberger Technologies, ATE Division, and
+with their permission is being made available to the public with the above
+copyright notice and permission notice.
+
+Upgraded to XPM2 by
+   Paul Breslaw, Mecasoft SA, Zurich, Switzerland (paul@mecazh.uu.ch)
+   Thu Nov  8 16:01:17 1990
+
+Upgraded to XPM version 3 by
+   Arnaud Le Hors (lehors@mirsa.inria.fr)
+   Tue Apr 9 1991
+
diff --git a/src/xpm/converters/ppmtoxpm.c b/src/xpm/converters/ppmtoxpm.c
new file mode 100644
index 0000000..395b4a8
--- /dev/null
+++ b/src/xpm/converters/ppmtoxpm.c
@@ -0,0 +1,481 @@
+/* ppmtoxpm.c - read a portable pixmap and produce a (version 3) X11 pixmap
+**
+** Copyright (C) 1990 by Mark W. Snitily
+**
+** Permission to use, copy, modify, and distribute this software and its
+** documentation for any purpose and without fee is hereby granted, provided
+** that the above copyright notice appear in all copies and that both that
+** copyright notice and this permission notice appear in supporting
+** documentation.  This software is provided "as is" without express or
+** implied warranty.
+**
+** This tool was developed for Schlumberger Technologies, ATE Division, and
+** with their permission is being made available to the public with the above
+** copyright notice and permission notice.
+**
+** Upgraded to XPM2 by
+**   Paul Breslaw, Mecasoft SA, Zurich, Switzerland (paul@mecazh.uu.ch)
+**   Thu Nov  8 16:01:17 1990
+**
+** Upgraded to XPM version 3 by
+**   Arnaud Le Hors (lehors@mirsa.inria.fr)
+**   Tue Apr 9 1991
+**
+** Rainer Sinkwitz sinkwitz@ifi.unizh.ch - 21 Nov 91:
+**  - Bug fix, should should malloc space for rgbn[j].name+1 in line 441
+**    caused segmentation faults
+**    
+**  - lowercase conversion of RGB names def'ed out,
+**    considered harmful.
+*/
+
+#include <stdio.h>
+#include <ctype.h>
+#include "ppm.h"
+#include "ppmcmap.h"
+
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#ifndef index
+#define index strchr
+#endif
+#else					/* SYSV */
+#include <strings.h>
+#endif					/* SYSV */
+
+/* Max number of colors allowed in ppm input. */
+#define MAXCOLORS    256
+
+/* Max number of rgb mnemonics allowed in rgb text file. */
+#define MAX_RGBNAMES 1024
+
+/* Lower bound and upper bound of character-pixels printed in XPM output.
+   Be careful, don't want the character '"' in this range. */
+/*#define LOW_CHAR  '#'  <-- minimum ascii character allowed */
+/*#define HIGH_CHAR '~'  <-- maximum ascii character allowed */
+#define LOW_CHAR  '`'
+#define HIGH_CHAR 'z'
+
+#define max(a,b) ((a) > (b) ? (a) : (b))
+
+void read_rgb_names();			/* forward reference */
+void gen_cmap();			/* forward reference */
+
+typedef struct {			/* rgb values and ascii names (from
+					 * rgb text file) */
+    int r, g, b;			/* rgb values, range of 0 -> 65535 */
+    char *name;				/* color mnemonic of rgb value */
+}      rgb_names;
+
+typedef struct {			/* character-pixel mapping */
+    char *cixel;			/* character string printed for
+					 * pixel */
+    char *rgbname;			/* ascii rgb color, either color
+					 * mnemonic or #rgb value */
+}      cixel_map;
+
+pixel **pixels;
+
+main(argc, argv)
+    int argc;
+    char *argv[];
+
+{
+    FILE *ifd;
+    register pixel *pP;
+    int argn, rows, cols, ncolors, row, col, i;
+    pixval maxval;			/* pixval == unsigned char or
+					 * unsigned short */
+    colorhash_table cht;
+    colorhist_vector chv;
+
+    /* Used for rgb value -> rgb mnemonic mapping */
+    int map_rgb_names = 0;
+    rgb_names rgbn[MAX_RGBNAMES];
+    int rgbn_max;
+
+    /* Used for rgb value -> character-pixel string mapping */
+    cixel_map cmap[MAXCOLORS];
+    int charspp;			/* chars per pixel */
+
+    char out_name[100], rgb_fname[100], *cp;
+    char *usage = "[-name <xpm-name>] [-rgb <rgb-textfile>] [ppmfile]";
+
+    ppm_init(&argc, argv);
+    out_name[0] = rgb_fname[0] = '\0';
+
+    argn = 1;
+
+    /* Check for command line options. */
+    while (argn < argc && argv[argn][0] == '-') {
+
+	/* Case "-", use stdin for input. */
+	if (argv[argn][1] == '\0')
+	    break;
+
+	/* Case "-name <xpm-filename>", get output filename. */
+	if (strncmp(argv[argn], "-name", max(strlen(argv[argn]), 2)) == 0) {
+	    argn++;
+	    if (argn == argc || sscanf(argv[argn], "%s", out_name) != 1)
+		pm_usage(usage);
+	}
+	/* Case "-rgb <rgb-filename>", get rgb mnemonics filename. */
+	else if (strncmp(argv[argn], "-rgb", max(strlen(argv[argn]), 2)) == 0) {
+	    argn++;
+	    if (argn == argc || sscanf(argv[argn], "%s", rgb_fname) != 1)
+		pm_usage(usage);
+	    map_rgb_names = 1;
+	}
+	/* Nothing else allowed... */
+	else
+	    pm_usage(usage);
+
+	argn++;
+    }
+
+    /* Input file specified, open it and set output filename if necessary. */
+    if (argn < argc) {
+
+	/* Open the input file. */
+	ifd = pm_openr(argv[argn]);
+
+	/* If output filename not specified, use input filename as default. */
+	if (out_name[0] == '\0') {
+	    strcpy(out_name, argv[argn]);
+	    if (cp = index(out_name, '.'))
+		*cp = '\0';		/* remove extension */
+	}
+
+	/*
+	 * If (1) input file was specified as "-" we're using stdin, or (2)
+	 * output filename was specified as "-", set output filename to the
+	 * default. 
+	 */
+	if (!strcmp(out_name, "-"))
+	    strcpy(out_name, "noname");
+
+	argn++;
+    }
+    /* No input file specified.  Using stdin so set default output filename. */
+    else {
+	ifd = stdin;
+	if (out_name[0] == '\0')
+	    strcpy(out_name, "noname");
+    }
+
+    /* Only 0 or 1 input files allowed. */
+    if (argn != argc)
+	pm_usage(usage);
+
+    /*
+     * "maxval" is the largest value that can be be found in the ppm file.
+     * All pixel components are relative to this value. 
+     */
+    pixels = ppm_readppm(ifd, &cols, &rows, &maxval);
+    pm_close(ifd);
+
+    /* Figure out the colormap. */
+    fprintf(stderr, "(Computing colormap...");
+    fflush(stderr);
+    chv = ppm_computecolorhist(pixels, cols, rows, MAXCOLORS, &ncolors);
+    if (chv == (colorhist_vector) 0)
+	pm_error(
+	 "too many colors - try running the pixmap through 'ppmquant 256'",
+		 0, 0, 0, 0, 0);
+    fprintf(stderr, "  Done.  %d colors found.)\n", ncolors);
+
+    /* Make a hash table for fast color lookup. */
+    cht = ppm_colorhisttocolorhash(chv, ncolors);
+
+    /*
+     * If a rgb text file was specified, read in the rgb mnemonics. Does not
+     * return if fatal error occurs. 
+     */
+    if (map_rgb_names)
+	read_rgb_names(rgb_fname, rgbn, &rgbn_max);
+
+    /* Now generate the character-pixel colormap table. */
+    gen_cmap(chv, ncolors, maxval, map_rgb_names, rgbn, rgbn_max,
+	     cmap, &charspp);
+
+    /* Write out the XPM file. */
+
+    printf("/* XPM */\n");
+    printf("static char *%s[] = {\n", out_name);
+    printf("/* width height ncolors chars_per_pixel */\n");
+    printf("\"%d %d %d %d\",\n", cols, rows, ncolors, charspp);
+    printf("/* colors */\n");
+    for (i = 0; i < ncolors; i++) {
+	printf("\"%s c %s\",\n", cmap[i].cixel, cmap[i].rgbname);
+    }
+    printf("/* pixels */\n");
+    for (row = 0; row < rows; row++) {
+	printf("\"");
+	for (col = 0, pP = pixels[row]; col < cols; col++, pP++) {
+	    printf("%s", cmap[ppm_lookupcolor(cht, pP)].cixel);
+	}
+	printf("\"%s\n", (row == (rows - 1) ? "" : ","));
+    }
+    printf("};\n");
+
+    exit(0);
+
+}					/* main */
+
+/*---------------------------------------------------------------------------*/
+/* This routine reads a rgb text file.  It stores the rgb values (0->65535)
+   and the rgb mnemonics (malloc'ed) into the "rgbn" array.  Returns the
+   number of entries stored in "rgbn_max". */
+void
+read_rgb_names(rgb_fname, rgbn, rgbn_max)
+    char *rgb_fname;
+    rgb_names rgbn[MAX_RGBNAMES];
+int *rgbn_max;
+
+{
+    FILE *rgbf;
+    int i, items, red, green, blue;
+    char line[512], name[512], *rgbname, *n, *m;
+
+    /* Open the rgb text file.  Abort if error. */
+    if ((rgbf = fopen(rgb_fname, "r")) == NULL)
+	pm_error("error opening rgb text file \"%s\"", rgb_fname, 0, 0, 0, 0);
+
+    /* Loop reading each line in the file. */
+    for (i = 0; fgets(line, sizeof(line), rgbf); i++) {
+
+	/* Quit if rgb text file is too large. */
+	if (i == MAX_RGBNAMES) {
+	    fprintf(stderr,
+	    "Too many entries in rgb text file, truncated to %d entries.\n",
+		    MAX_RGBNAMES);
+	    fflush(stderr);
+	    break;
+	}
+	/* Read the line.  Skip if bad. */
+	items = sscanf(line, "%d %d %d %[^\n]\n", &red, &green, &blue, name);
+	if (items != 4) {
+	    fprintf(stderr, "rgb text file syntax error on line %d\n", i + 1);
+	    fflush(stderr);
+	    i--;
+	    continue;
+	}
+	/* Make sure rgb values are within 0->255 range.  Skip if bad. */
+	if (red < 0 || red > 0xFF ||
+	    green < 0 || green > 0xFF ||
+	    blue < 0 || blue > 0xFF) {
+	    fprintf(stderr, "rgb value for \"%s\" out of range, ignoring it\n",
+		    name);
+	    fflush(stderr);
+	    i--;
+	    continue;
+	}
+	/* Allocate memory for ascii name.  Abort if error. */
+	if (!(rgbname = (char *) malloc(strlen(name) + 1)))
+	    pm_error("out of memory allocating rgb name", 0, 0, 0, 0, 0);
+	    
+#ifdef NAMESLOWCASE
+	/* Copy string to ascii name and lowercase it. */
+	for (n = name, m = rgbname; *n; n++)
+	    *m++ = isupper(*n) ? tolower(*n) : *n;
+	*m = '\0';
+#else
+	strcpy(rgbname, name);
+#endif
+
+	/* Save the rgb values and ascii name in the array. */
+	rgbn[i].r = red << 8;
+	rgbn[i].g = green << 8;
+	rgbn[i].b = blue << 8;
+	rgbn[i].name = rgbname;
+    }
+
+    /* Return the max number of rgb names. */
+    *rgbn_max = i - 1;
+
+    fclose(rgbf);
+
+}					/* read_rgb_names */
+
+/*---------------------------------------------------------------------------*/
+/* Given a number and a base, (base == HIGH_CHAR-LOW_CHAR+1), this routine
+   prints the number into a malloc'ed string and returns it.  The length of
+   the string is specified by "digits".  The ascii characters of the printed
+   number range from LOW_CHAR to HIGH_CHAR.  The string is LOW_CHAR filled,
+   (e.g. if LOW_CHAR==0, HIGH_CHAR==1, digits==5, i=3, routine would return
+   the malloc'ed string "00011"). */
+char *
+gen_numstr(i, base, digits)
+    int i, base, digits;
+{
+    char *str, *p;
+    int d;
+
+    /* Allocate memory for printed number.  Abort if error. */
+    if (!(str = (char *) malloc(digits + 1)))
+	pm_error("out of memory", 0, 0, 0, 0, 0);
+
+    /* Generate characters starting with least significant digit. */
+    p = str + digits;
+    *p-- = '\0';			/* nul terminate string */
+    while (p >= str) {
+	d = i % base;
+	i /= base;
+	*p-- = (char) ((int) LOW_CHAR + d);
+    }
+
+    return str;
+
+}					/* gen_numstr */
+
+/*---------------------------------------------------------------------------*/
+/* This routine generates the character-pixel colormap table. */
+void
+gen_cmap(chv, ncolors, maxval, map_rgb_names, rgbn, rgbn_max,
+	 cmap, charspp)
+/* input: */
+    colorhist_vector chv;		/* contains rgb values for colormap */
+    int ncolors;			/* number of entries in colormap */
+    pixval maxval;			/* largest color value, all rgb
+					 * values relative to this, (pixval
+					 * == unsigned short) */
+    int map_rgb_names;			/* == 1 if mapping rgb values to rgb
+					 * mnemonics */
+    rgb_names rgbn[MAX_RGBNAMES];	/* rgb mnemonics from rgb text file */
+int rgbn_max;				/* number of rgb mnemonics in table */
+
+/* output: */
+cixel_map cmap[MAXCOLORS];		/* pixel strings and ascii rgb
+					 * colors */
+int *charspp;				/* characters per pixel */
+
+{
+    int i, j, base, cpp, mval, red, green, blue, r, g, b, matched;
+    char *str;
+
+    /*
+     * Figure out how many characters per pixel we'll be using.  Don't want
+     * to be forced to link with libm.a, so using a division loop rather
+     * than a log function. 
+     */
+    base = (int) HIGH_CHAR - (int) LOW_CHAR + 1;
+    for (cpp = 0, j = ncolors; j; cpp++)
+	j /= base;
+    *charspp = cpp;
+
+    /*
+     * Determine how many hex digits we'll be normalizing to if the rgb
+     * value doesn't match a color mnemonic. 
+     */
+    mval = (int) maxval;
+    if (mval <= 0x000F)
+	mval = 0x000F;
+    else if (mval <= 0x00FF)
+	mval = 0x00FF;
+    else if (mval <= 0x0FFF)
+	mval = 0x0FFF;
+    else
+	mval = 0xFFFF;
+
+    /*
+     * Generate the character-pixel string and the rgb name for each
+     * colormap entry. 
+     */
+    for (i = 0; i < ncolors; i++) {
+
+	/*
+	 * The character-pixel string is simply a printed number in base
+	 * "base" where the digits of the number range from LOW_CHAR to
+	 * HIGH_CHAR and the printed length of the number is "cpp". 
+	 */
+	cmap[i].cixel = gen_numstr(i, base, cpp);
+
+	/* Fetch the rgb value of the current colormap entry. */
+	red = PPM_GETR(chv[i].color);
+	green = PPM_GETG(chv[i].color);
+	blue = PPM_GETB(chv[i].color);
+
+	/*
+	 * If the ppm color components are not relative to 15, 255, 4095,
+	 * 65535, normalize the color components here. 
+	 */
+	if (mval != (int) maxval) {
+	    red = (red * mval) / (int) maxval;
+	    green = (green * mval) / (int) maxval;
+	    blue = (blue * mval) / (int) maxval;
+	}
+
+	/*
+	 * If the "-rgb <rgbfile>" option was specified, attempt to map the
+	 * rgb value to a color mnemonic. 
+	 */
+	if (map_rgb_names) {
+
+	    /*
+	     * The rgb values of the color mnemonics are normalized relative
+	     * to 255 << 8, (i.e. 0xFF00).  [That's how the original MIT
+	     * code did it, really should have been "v * 65535 / 255"
+	     * instead of "v << 8", but have to use the same scheme here or
+	     * else colors won't match...]  So, if our rgb values aren't
+	     * already 16-bit values, need to shift left. 
+	     */
+	    if (mval == 0x000F) {
+		r = red << 12;
+		g = green << 12;
+		b = blue << 12;
+		/* Special case hack for "white". */
+		if (0xF000 == r && r == g && g == b)
+		    r = g = b = 0xFF00;
+	    } else if (mval == 0x00FF) {
+		r = red << 8;
+		g = green << 8;
+		b = blue << 8;
+	    } else if (mval == 0x0FFF) {
+		r = red << 4;
+		g = green << 4;
+		b = blue << 4;
+	    } else {
+		r = red;
+		g = green;
+		b = blue;
+	    }
+
+	    /*
+	     * Just perform a dumb linear search over the rgb values of the
+	     * color mnemonics.  One could speed things up by sorting the
+	     * rgb values and using a binary search, or building a hash
+	     * table, etc... 
+	     */
+	    for (matched = 0, j = 0; j <= rgbn_max; j++)
+		if (r == rgbn[j].r && g == rgbn[j].g && b == rgbn[j].b) {
+
+		    /* Matched.  Allocate string, copy mnemonic, and exit. */
+		    if (!(str = (char *) malloc(strlen(rgbn[j].name) + 1)))
+			pm_error("out of memory", 0, 0, 0, 0, 0);
+		    strcpy(str, rgbn[j].name);
+		    cmap[i].rgbname = str;
+		    matched = 1;
+		    break;
+		}
+	    if (matched)
+		continue;
+	}
+
+	/*
+	 * Either not mapping to color mnemonics, or didn't find a match.
+	 * Generate an absolute #RGB value string instead. 
+	 */
+	if (!(str = (char *) malloc(mval == 0x000F ? 5 :
+				    mval == 0x00FF ? 8 :
+				    mval == 0x0FFF ? 11 :
+				    14)))
+	    pm_error("out of memory", 0, 0, 0, 0, 0);
+
+	sprintf(str, mval == 0x000F ? "#%X%X%X" :
+		mval == 0x00FF ? "#%02X%02X%02X" :
+		mval == 0x0FFF ? "#%03X%03X%03X" :
+		"#%04X%04X%04X", red, green, blue);
+	cmap[i].rgbname = str;
+    }
+
+}					/* gen_cmap */
diff --git a/src/xpm/converters/xpm1to3.pl b/src/xpm/converters/xpm1to3.pl
new file mode 100644
index 0000000..d102964
--- /dev/null
+++ b/src/xpm/converters/xpm1to3.pl
@@ -0,0 +1,90 @@
+#!/usr/local/bin/perl
+#
+# Usage: xpm1to3.pl xpmv1-file > xpmv3-file
+#
+# Note:  perl (available by ftp on prep.ai.mit.edu) script to convert 
+#        "enhanced" xpm v1 X11 pixmap files to xpm v3 (C includable format)
+#        pixmap files...
+# +---------------------------------------------------------------------------
+# WHO:    Richard Hess                    CORP:   Consilium
+# TITLE:  Staff Engineer                  VOICE:  [415] 691-6342
+#     [ X-SWAT Team:  Special Projects ]  USNAIL: 640 Clyde Court
+# UUCP:   ...!uunet!cimshop!rhess                 Mountain View, CA 94043
+# +---------------------------------------------------------------------------
+
+sub checkname {
+    if ($_[0] ne $_[1]) {
+	printf STDERR "warning, name inconsitencies in %s %s!=%s\n", 
+                      $_[2], $_[0], $_[1];
+    }
+}
+
+sub checkmono {
+    if ($_[0] ne $_[1]) { return 0; }
+    return 1;
+}
+
+printf "/* XPM */\n";
+($name, $format) = (<> =~ /^#define\s+(\w+)_format\s+(\d+)\s*$/);
+($name2, $width) = (<> =~ /^#define\s+(\w+)_width\s+(\d+)\s*$/);
+&checkname($name, $name2, "width");
+($name2, $height) = (<> =~ /^#define\s+(\w+)_height\s+(\d+)\s*$/);
+&checkname($name, $name2, "height");
+($name2, $ncolors) = (<> =~ /^#define\s+(\w+)_ncolors\s+(\d+)\s*$/);
+&checkname($name, $name2, "ncolors");
+($name2, $chars_per_pixel) = (<> =~
+/^#define\s+(\w+)_chars_per_pixel\s+(\d+)\s*$/);
+&checkname($name, $name2, "chars per pixel");
+
+($name2) = (<> =~ /^static char \*\s*(\w+)_mono\[]\s+=\s+{\s*$/);
+$mono = &checkmono($name, $name2);
+
+if ($mono) {
+  $idx = 0;
+  while ( ($_ = <>) =~ m/^\s*"[^"]+"\s*,\s*"[^"]+"(,)?\s*$/ ) {
+    ($codes[$idx], $mono_name[$idx]) = /^\s*"([^"]+)"\s*,\s*"([^"]+)"(,)?\s*$/;
+    $idx++;
+  }
+  if ($idx != $ncolors) {
+    printf STDERR "Warning, ncolors mismatch reading mono %d != %d\n",
+$ncolors, $idx;
+  }
+
+  ($name2) = (<> =~ /^static char \*\s*(\w+)_colors\[]\s+=\s+{\s*$/);
+  &checkname($name, $name2, "colors");
+}
+
+printf "static char * %s[] = {\n", $name;
+printf "/* %s pixmap\n * width height ncolors chars_per_pixel */\n", $name;
+printf "\"%s %s %s %s \",\n", $width, $height, $ncolors, $chars_per_pixel;
+
+$idx = 0;
+while ( ($_ = <>) =~ m/^\s*"[^"]+"\s*,\s*"[^"]+"(,)?\s*$/ ) {
+  ($codes[$idx], $color_name[$idx]) = /^\s*"([^"]+)"\s*,\s*"([^"]+)"(,)?\s*$/;
+  $idx++;
+}
+if ($idx != $ncolors) {
+  printf STDERR "Warning, ncolors mismatch reading color %d != %d\n",
+$ncolors, $idx;
+}
+
+for ($idx=0; $idx<$ncolors; $idx++) {
+  if ($mono) {
+    printf "\"%s m %s c %s \t s c%d \",\n", $codes[$idx],
+$mono_name[$idx], $color_name[$idx], $idx;
+  }
+  else {
+    printf "\"%s c %s \t s c%d \",\n", $codes[$idx], $color_name[$idx], $idx;
+  }
+}
+
+($name2) = ( <> =~ /^static char \*\s*(\w+)_pixels\[]\s+=\s+{\s*$/);
+&checkname($name, $name2, "pixels");
+
+printf "/* pixels */\n";
+while ( ! ( ($_ = <>) =~ /^}\s*;\s*$/) ) {
+	printf "%s", $_;
+}
+printf "} ;\n";
+
+# -----------------------------------------------------------------------<eof>
diff --git a/src/xpm/converters/xpmtoppm.1 b/src/xpm/converters/xpmtoppm.1
new file mode 100644
index 0000000..e4f414c
--- /dev/null
+++ b/src/xpm/converters/xpmtoppm.1
@@ -0,0 +1,28 @@
+.TH xpmtoppm 1 "16 August 1990"
+.SH NAME
+xpmtoppm - convert an X11 pixmap into a portable pixmap
+.SH SYNOPSIS
+.B xpmtoppm
+.RI [ xpmfile ]
+.SH DESCRIPTION
+Reads an X11 pixmap (XPM version 1 or 3) as input.
+Produces a portable pixmap as output.
+.SH KNOWN BUGS
+The support to XPM version 3 is limited. Comments can only be single lines
+and there must be for every pixel a default colorname for a color type visual.
+.SH "SEE ALSO"
+ppmtoxpm(1), ppm(5)
+.br
+XPM Manual by Arnaud Le Hors lehors@mirsa.inria.fr
+.SH AUTHOR
+Copyright (C) 1991 by Jef Poskanzer.
+.\" Permission to use, copy, modify, and distribute this software and its
+.\" documentation for any purpose and without fee is hereby granted, provided
+.\" that the above copyright notice appear in all copies and that both that
+.\" copyright notice and this permission notice appear in supporting
+.\" documentation.  This software is provided "as is" without express or
+.\" implied warranty.
+
+Upgraded to support XPM version 3 by
+    Arnaud Le Hors (lehors@mirsa.inria.fr)
+    Tue Apr 9 1991
diff --git a/src/xpm/converters/xpmtoppm.c b/src/xpm/converters/xpmtoppm.c
new file mode 100644
index 0000000..9842267
--- /dev/null
+++ b/src/xpm/converters/xpmtoppm.c
@@ -0,0 +1,433 @@
+/* xpmtoppm.c - read an X11 pixmap file and produce a portable pixmap
+**
+** Copyright (C) 1991 by Jef Poskanzer.
+**
+** Permission to use, copy, modify, and distribute this software and its
+** documentation for any purpose and without fee is hereby granted, provided
+** that the above copyright notice appear in all copies and that both that
+** copyright notice and this permission notice appear in supporting
+** documentation.  This software is provided "as is" without express or
+** implied warranty.
+**
+** Upgraded to support XPM version 3 by
+**   Arnaud Le Hors (lehors@mirsa.inria.fr)
+**   Tue Apr 9 1991
+**
+** Rainer Sinkwitz sinkwitz@ifi.unizh.ch - 21 Nov 91:
+**  - Bug fix, no advance of read ptr, would not read 
+**    colors like "ac c black" because it would find 
+**    the "c" of "ac" and then had problems with "c"
+**    as color.
+**    
+**  - Now understands multword X11 color names
+**  
+**  - Now reads multiple color keys. Takes the color
+**    of the hightest available key. Lines no longer need
+**    to begin with key 'c'.
+**    
+**  - expanded line buffer to from 500 to 2048 for bigger files
+*/
+
+#include "ppm.h"
+
+void ReadXPMFile();
+static void getline();
+
+/* number of xpmColorKeys */
+#define NKEYS 5
+
+char *xpmColorKeys[] =
+{
+ "s",					/* key #1: symbol */
+ "m",					/* key #2: mono visual */
+ "g4",					/* key #3: 4 grays visual */
+ "g",					/* key #4: gray visual */
+ "c",					/* key #5: color visual */
+};
+
+#ifdef NEED_STRSTR
+/* for systems which do not provide it */
+static char *
+strstr(s1, s2)
+    char *s1, *s2;
+{
+    int ls2 = strlen(s2);
+
+    if (ls2 == 0)
+	return (s1);
+    while (strlen(s1) >= ls2) {
+	if (strncmp(s1, s2, ls2) == 0)
+	    return (s1);
+	s1++;
+    }
+    return (0);
+}
+
+#endif
+
+void
+main(argc, argv)
+    int argc;
+    char *argv[];
+
+{
+    FILE *ifp;
+    pixel *pixrow, *colors;
+    register pixel *pP;
+    int rows, cols, ncolors, chars_per_pixel, row;
+    register int col;
+    int *data;
+    register int *ptr;
+
+    ppm_init(&argc, argv);
+
+    if (argc > 2)
+	pm_usage("[xpmfile]");
+
+    if (argc == 2)
+	ifp = pm_openr(argv[1]);
+    else
+	ifp = stdin;
+
+    ReadXPMFile(
+	    ifp, &cols, &rows, &ncolors, &chars_per_pixel, &colors, &data);
+
+    pm_close(ifp);
+
+    ppm_writeppminit(stdout, cols, rows, (pixval) PPM_MAXMAXVAL, 0);
+    pixrow = ppm_allocrow(cols);
+
+    for (row = 0, ptr = data; row < rows; ++row) {
+	for (col = 0, pP = pixrow; col < cols; ++col, ++pP, ++ptr)
+	    *pP = colors[*ptr];
+	ppm_writeppmrow(stdout, pixrow, cols, (pixval) PPM_MAXMAXVAL, 0);
+    }
+
+    exit(0);
+}
+
+#define MAX_LINE 2048
+
+void
+ReadXPMFile(stream, widthP, heightP, ncolorsP,
+	    chars_per_pixelP, colorsP, dataP)
+    FILE *stream;
+    int *widthP;
+    int *heightP;
+    int *ncolorsP;
+    int *chars_per_pixelP;
+    pixel **colorsP;
+    int **dataP;
+{
+    char line[MAX_LINE], str1[MAX_LINE], str2[MAX_LINE];
+    char *t1;
+    char *t2;
+    int format, v, datasize;
+    int *ptr;
+    int *ptab;
+    register int i, j;
+    int flag;
+
+    unsigned int curkey, key, highkey;	/* current color key */
+    unsigned int lastwaskey;		/* key read */
+    char curbuf[BUFSIZ];		/* current buffer */
+
+    *widthP = *heightP = *ncolorsP = *chars_per_pixelP = format = -1;
+    flag = 0;				/* to avoid getting twice a line */
+
+    /* First try to read as an XPM version 3 file */
+
+    /* Read the header line */
+    getline(line, sizeof(line), stream);
+    if (sscanf(line, "/* %s */", str1) == 1
+	&& !strncmp(str1, "XPM", 3)) {
+
+	/* Read the assignment line */
+	getline(line, sizeof(line), stream);
+	if (strncmp(line, "static char", 11))
+	    pm_error("error scanning assignment line", 0, 0, 0, 0, 0);
+
+	/* Read the hints line */
+	getline(line, sizeof(line), stream);
+	/* skip the comment line if any */
+	if (!strncmp(line, "/*", 2)) {
+	    while (!strstr(line, "*/"))
+		getline(line, sizeof(line), stream);
+	    getline(line, sizeof(line), stream);
+	}
+	if (sscanf(line, "\"%d %d %d %d\",", widthP, heightP,
+		   ncolorsP, chars_per_pixelP) != 4)
+	    pm_error("error scanning hints line", 0, 0, 0, 0, 0);
+
+	/* Allocate space for color table. */
+	if (*chars_per_pixelP <= 2) {
+	    /* Up to two chars per pixel, we can use an indexed table. */
+	    v = 1;
+	    for (i = 0; i < *chars_per_pixelP; ++i)
+		v *= 256;
+	    *colorsP = ppm_allocrow(v);
+	} else {
+	    /* Over two chars per pixel, we fall back on linear search. */
+	    *colorsP = ppm_allocrow(*ncolorsP);
+	    ptab = (int *) malloc(*ncolorsP * sizeof(int));
+	}
+
+	/* Read the color table */
+	for (i = 0; i < *ncolorsP; i++) {
+	    getline(line, sizeof(line), stream);
+	    /* skip the comment line if any */
+	    if (!strncmp(line, "/*", 2))
+		getline(line, sizeof(line), stream);
+
+	    /* read the chars */
+	    if ((t1 = index(line, '"')) == NULL)
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	    else
+		t1++;
+	    strncpy(str1, t1, *chars_per_pixelP);
+	    str1[*chars_per_pixelP] = '\0';
+	    t1++; t1++;
+
+	    v = 0;
+	    for (j = 0; j < *chars_per_pixelP; ++j)
+		v = (v << 8) + str1[j];
+	    /*
+	     * read color keys and values 
+	     */
+	    curkey = 0; 
+	    highkey = 1;
+	    lastwaskey = 0;
+	    t2 = t1;
+	    while ( 1 ) {
+		for (t1=t2 ;; t1++)
+		    if (*t1 != ' ' && *t1 != '	')
+			break;
+		for (t2 = t1;; t2++)
+		    if (*t2 == ' ' || *t2 == '	' || *t2 == '"')
+			break;
+		if (t2 == t1) break;
+		strncpy(str2, t1, t2 - t1);
+		str2[t2 - t1] = '\0';
+	        
+		if (!lastwaskey) {
+		    for (key = 1; key < NKEYS + 1; key++)
+			if (!strcmp(xpmColorKeys[key - 1], str2))
+			    break;
+		} else 
+		    key = NKEYS + 1;
+		if (key > NKEYS) {			/* append name */
+		    if (!curkey) 
+			pm_error("error scanning color table", 0, 0, 0, 0, 0);
+		    if (!lastwaskey) 
+			strcat(curbuf, " ");		/* append space */
+		    strcat(curbuf, str2);		/* append buf */
+		    lastwaskey = 0;
+		}
+		if (key <= NKEYS) { 			/* new key */
+		    if (curkey > highkey) {	/* flush string */
+			if (*chars_per_pixelP <= 2)
+			    /* Index into table. */
+			    (*colorsP)[v] = ppm_parsecolor(curbuf,
+						(pixval) PPM_MAXMAXVAL);
+			else {
+			    /* Set up linear search table. */
+			    (*colorsP)[i] = ppm_parsecolor(curbuf,
+						(pixval) PPM_MAXMAXVAL);
+			    ptab[i] = v;
+			}
+			highkey = curkey;
+		    }
+		    curkey = key;			/* set new key  */
+		    curbuf[0] = '\0';		/* reset curbuf */
+		    lastwaskey = 1;
+		}
+	    if (*t2 == '"') break;
+	    }
+	    if (curkey > highkey) {
+		if (*chars_per_pixelP <= 2)
+		    /* Index into table. */
+		    (*colorsP)[v] = ppm_parsecolor(curbuf,
+					(pixval) PPM_MAXMAXVAL);
+		else {
+		    /* Set up linear search table. */
+		    (*colorsP)[i] = ppm_parsecolor(curbuf,
+					(pixval) PPM_MAXMAXVAL);
+		    ptab[i] = v;
+		}
+		highkey = curkey;
+	    }
+	    if (highkey == 1) 
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	}
+	/* Read pixels. */
+	getline(line, sizeof(line), stream);
+	/* skip the comment line if any */
+	if (!strncmp(line, "/*", 2))
+	    getline(line, sizeof(line), stream);
+
+    } else {				/* try as an XPM version 1 file */
+
+	/* Read the initial defines. */
+	for (;;) {
+	    if (flag)
+		getline(line, sizeof(line), stream);
+	    else
+		flag++;
+
+	    if (sscanf(line, "#define %s %d", str1, &v) == 2) {
+		if ((t1 = rindex(str1, '_')) == NULL)
+		    t1 = str1;
+		else
+		    ++t1;
+		if (!strcmp(t1, "format"))
+		    format = v;
+		else if (!strcmp(t1, "width"))
+		    *widthP = v;
+		else if (!strcmp(t1, "height"))
+		    *heightP = v;
+		else if (!strcmp(t1, "ncolors"))
+		    *ncolorsP = v;
+		else if (!strcmp(t1, "pixel"))
+		    *chars_per_pixelP = v;
+	    } else if (!strncmp(line, "static char", 11)) {
+		if ((t1 = rindex(line, '_')) == NULL)
+		    t1 = line;
+		else
+		    ++t1;
+		break;
+	    }
+	}
+	if (format == -1)
+	    pm_error("missing or invalid format", 0, 0, 0, 0, 0);
+	if (format != 1)
+	    pm_error("can't handle XPM version %d", format, 0, 0, 0, 0);
+	if (*widthP == -1)
+	    pm_error("missing or invalid width", 0, 0, 0, 0, 0);
+	if (*heightP == -1)
+	    pm_error("missing or invalid height", 0, 0, 0, 0, 0);
+	if (*ncolorsP == -1)
+	    pm_error("missing or invalid ncolors", 0, 0, 0, 0, 0);
+	if (*chars_per_pixelP == -1)
+	    pm_error("missing or invalid chars_per_pixel", 0, 0, 0, 0, 0);
+	if (*chars_per_pixelP > 2)
+	    pm_message("warning, chars_per_pixel > 2 uses a lot of memory"
+		       ,0, 0, 0, 0, 0);
+
+	/* If there's a monochrome color table, skip it. */
+	if (!strncmp(t1, "mono", 4)) {
+	    for (;;) {
+		getline(line, sizeof(line), stream);
+		if (!strncmp(line, "static char", 11))
+		    break;
+	    }
+	}
+	/* Allocate space for color table. */
+	if (*chars_per_pixelP <= 2) {
+	    /* Up to two chars per pixel, we can use an indexed table. */
+	    v = 1;
+	    for (i = 0; i < *chars_per_pixelP; ++i)
+		v *= 256;
+	    *colorsP = ppm_allocrow(v);
+	} else {
+	    /* Over two chars per pixel, we fall back on linear search. */
+	    *colorsP = ppm_allocrow(*ncolorsP);
+	    ptab = (int *) malloc(*ncolorsP * sizeof(int));
+	}
+
+	/* Read color table. */
+	for (i = 0; i < *ncolorsP; ++i) {
+	    getline(line, sizeof(line), stream);
+
+	    if ((t1 = index(line, '"')) == NULL)
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	    if ((t2 = index(t1 + 1, '"')) == NULL)
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	    if (t2 - t1 - 1 != *chars_per_pixelP)
+		pm_error("wrong number of chars per pixel in color table",
+			 0, 0, 0, 0, 0);
+	    strncpy(str1, t1 + 1, t2 - t1 - 1);
+	    str1[t2 - t1 - 1] = '\0';
+
+	    if ((t1 = index(t2 + 1, '"')) == NULL)
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	    if ((t2 = index(t1 + 1, '"')) == NULL)
+		pm_error("error scanning color table", 0, 0, 0, 0, 0);
+	    strncpy(str2, t1 + 1, t2 - t1 - 1);
+	    str2[t2 - t1 - 1] = '\0';
+
+	    v = 0;
+	    for (j = 0; j < *chars_per_pixelP; ++j)
+		v = (v << 8) + str1[j];
+	    if (*chars_per_pixelP <= 2)
+		/* Index into table. */
+		(*colorsP)[v] = ppm_parsecolor(str2,
+					       (pixval) PPM_MAXMAXVAL);
+	    else {
+		/* Set up linear search table. */
+		(*colorsP)[i] = ppm_parsecolor(str2,
+					       (pixval) PPM_MAXMAXVAL);
+		ptab[i] = v;
+	    }
+	}
+
+	/* Read pixels. */
+	for (;;) {
+	    getline(line, sizeof(line), stream);
+	    if (!strncmp(line, "static char", 11))
+		break;
+	}
+    }
+    datasize = *widthP * *heightP;
+    *dataP = (int *) malloc(datasize * sizeof(int));
+    if (*dataP == 0)
+	pm_error("out of memory", 0, 0, 0, 0, 0);
+    i = 0;
+    ptr = *dataP;
+    for (;;) {
+	if (flag)
+	    getline(line, sizeof(line), stream);
+	else
+	    flag++;
+
+	/* Find the open quote. */
+	if ((t1 = index(line, '"')) == NULL)
+	    pm_error("error scanning pixels", 0, 0, 0, 0, 0);
+	++t1;
+
+	/* Handle pixels until a close quote or the end of the image. */
+	while (*t1 != '"') {
+	    v = 0;
+	    for (j = 0; j < *chars_per_pixelP; ++j)
+		v = (v << 8) + *t1++;
+	    if (*chars_per_pixelP <= 2)
+		/* Index into table. */
+		*ptr++ = v;
+	    else {
+		/* Linear search into table. */
+		for (j = 0; j < *ncolorsP; ++j)
+		    if (ptab[j] == v)
+			goto gotit;
+		pm_error("unrecognized pixel in line \"%s\"", line,
+			 0, 0, 0, 0);
+	gotit:
+		*ptr++ = j;
+	    }
+	    ++i;
+	    if (i >= datasize)
+		return;
+	}
+    }
+}
+
+
+static void
+getline(line, size, stream)
+    char *line;
+    int size;
+    FILE *stream;
+{
+    if (fgets(line, MAX_LINE, stream) == NULL)
+	pm_error("EOF / read error", 0, 0, 0, 0, 0);
+    if (strlen(line) == MAX_LINE - 1)
+	pm_error("line too long", 0, 0, 0, 0, 0);
+}
diff --git a/src/xpm/create.c b/src/xpm/create.c
new file mode 100644
index 0000000..238a2bb
--- /dev/null
+++ b/src/xpm/create.c
@@ -0,0 +1,963 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* create.c:                                                                   *
+*                                                                             *
+*  XPM library                                                                *
+*  Create an X image and possibly its related shape mask                     *
+*  from the given xpmInternAttrib.                                            *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:ctype.h"
+#else
+#include <ctype.h>
+#endif
+
+LFUNC(xpmVisualType, int, (Visual *visual));
+
+LFUNC(SetColor, int, (Display * display, Colormap colormap, char *colorname,
+		      unsigned int color_index, Pixel * image_pixel,
+		      Pixel * mask_pixel, unsigned int * mask_pixel_index,
+		      Pixel ** pixels, unsigned int * npixels,
+		      XpmAttributes *attributes));
+
+LFUNC(CreateColors, int, (Display *display, XpmAttributes *attributes,
+			  char ***ct, unsigned int ncolors, Pixel *ip,
+			  Pixel *mp, unsigned int *mask_pixel, Pixel **pixels,
+			  unsigned int *npixels));
+
+LFUNC(CreateXImage, int, (Display * display, Visual * visual,
+			  unsigned int depth, unsigned int width,
+			  unsigned int height, XImage ** image_return));
+
+LFUNC(SetImagePixels, void, (XImage * image, unsigned int width,
+			     unsigned int height, unsigned int *pixelindex,
+			     Pixel * pixels));
+
+LFUNC(SetImagePixels32, void, (XImage * image, unsigned int width,
+			       unsigned int height, unsigned int *pixelindex,
+			       Pixel * pixels));
+
+LFUNC(SetImagePixels16, void, (XImage * image, unsigned int width,
+			       unsigned int height, unsigned int *pixelindex,
+			       Pixel * pixels));
+
+LFUNC(SetImagePixels8, void, (XImage * image, unsigned int width,
+			      unsigned int height, unsigned int *pixelindex,
+			      Pixel * pixels));
+
+LFUNC(SetImagePixels1, void, (XImage * image, unsigned int width,
+			      unsigned int height, unsigned int *pixelindex,
+			      Pixel * pixels));
+
+#ifdef NEED_STRCASECMP
+
+LFUNC(strcasecmp, int, (char *s1, char *s2));
+
+/*
+ * in case strcasecmp is not provided by the system here is one
+ * which does the trick
+ */
+static int
+strcasecmp(s1, s2)
+    register char *s1, *s2;
+{
+    register int c1, c2;
+
+    while (*s1 && *s2) {
+	c1 = isupper(*s1) ? tolower(*s1) : *s1;
+	c2 = isupper(*s2) ? tolower(*s2) : *s2;
+	if (c1 != c2)
+	    return (1);
+	s1++;
+	s2++;
+    }
+    if (*s1 || *s2)
+	return (1);
+    return (0);
+}
+
+#endif
+
+/*
+ * return the default color key related to the given visual 
+ */
+static int
+xpmVisualType(visual)
+    Visual *visual;
+{
+    switch (visual->class) {
+    case StaticGray:
+    case GrayScale:
+	switch (visual->map_entries) {
+	case 2:
+	    return (MONO);
+	case 4:
+	    return (GRAY4);
+	default:
+	    return (GRAY);
+	}
+    default:
+	return (COLOR);
+    }
+}
+
+/*
+ * set the color pixel related to the given colorname,
+ * return 0 if success, 1 otherwise.
+ */
+
+static int
+SetColor(display, colormap, colorname, color_index,
+	 image_pixel, mask_pixel, mask_pixel_index,
+	 pixels, npixels, attributes)
+    Display *display;
+    Colormap colormap;
+    char *colorname;
+    unsigned int color_index;
+    Pixel *image_pixel, *mask_pixel;
+    unsigned int *mask_pixel_index;
+    Pixel **pixels;
+    unsigned int *npixels;
+    XpmAttributes *attributes;
+{
+    XColor xcolor;
+
+    if (strcasecmp(colorname, TRANSPARENT_COLOR)) {
+	if (!XParseColor(display, colormap, colorname, &xcolor)) return(1);
+	else if (!XAllocColor(display, colormap, &xcolor))
+	{
+	  if (attributes && (attributes->valuemask & XpmCloseness) &&
+	      attributes->closeness != 0)
+          {
+	    XColor *cols;
+	    unsigned int ncols,i,closepix;
+	    long int closediff,closeness = attributes->closeness;
+
+	    if (attributes && attributes->valuemask & XpmDepth)
+	      ncols = 1 << attributes->depth;
+	    else
+	      ncols = 1 << DefaultDepth(display, DefaultScreen(display));
+
+	    cols = (XColor*)calloc(ncols,sizeof(XColor));
+	    for (i = 0; i < ncols; ++i) cols[i].pixel = i;
+	    XQueryColors(display,colormap,cols,ncols);
+
+	    for (i = 0, closediff = 0x7FFFFFFF; i < ncols; ++i)
+	    {
+#define COLOR_FACTOR       3
+#define BRIGHTNESS_FACTOR  1
+
+	      long int newclosediff = 
+		COLOR_FACTOR * (
+		  abs((long)xcolor.red   - (long)cols[i].red)   +
+	          abs((long)xcolor.green - (long)cols[i].green) +
+	          abs((long)xcolor.blue  - (long)cols[i].blue)) +
+		BRIGHTNESS_FACTOR * abs(
+		  ((long)xcolor.red+(long)xcolor.green+(long)xcolor.blue) -
+		  ((long)cols[i].red+(long)cols[i].green+(long)cols[i].blue));
+
+	      if (newclosediff < closediff)
+	      { closepix = i; closediff = newclosediff; }
+	    }
+
+	    if ((long)cols[closepix].red   >= (long)xcolor.red   - closeness &&
+		(long)cols[closepix].red   <= (long)xcolor.red   + closeness &&
+		(long)cols[closepix].green >= (long)xcolor.green - closeness &&
+		(long)cols[closepix].green <= (long)xcolor.green + closeness &&
+		(long)cols[closepix].blue  >= (long)xcolor.blue  - closeness &&
+		(long)cols[closepix].blue  <= (long)xcolor.blue  + closeness)
+	    {
+	      xcolor = cols[closepix]; free(cols);
+	      if (!XAllocColor(display, colormap, &xcolor)) return (1);
+	    }
+	    else { free(cols); return (1); }
+	  }
+	  else return (1);
+	}
+	*image_pixel = xcolor.pixel;
+	*mask_pixel = 1;
+	(*pixels)[*npixels] = xcolor.pixel;
+	(*npixels)++;
+    } else {
+	*image_pixel = 0;
+	*mask_pixel = 0;
+	*mask_pixel_index = color_index;/* store the color table index */
+    }
+    return (0);
+}
+
+static int
+CreateColors(display, attributes, ct, ncolors,
+	     ip, mp, mask_pixel, pixels, npixels)
+    Display *display;
+    XpmAttributes *attributes;
+    char ***ct;
+    unsigned int ncolors;
+    Pixel *ip;
+    Pixel *mp;
+    unsigned int *mask_pixel;		/* mask pixel index */
+    Pixel **pixels;			/* allocated pixels */
+    unsigned int *npixels;		/* number of allocated pixels */
+{
+    /* variables stored in the XpmAttributes structure */
+    Visual *visual;
+    Colormap colormap;
+    XpmColorSymbol *colorsymbols;
+    unsigned int numsymbols;
+
+    char *colorname;
+    unsigned int a, b, l;
+    Boolean pixel_defined;
+    unsigned int key;
+    XpmColorSymbol *cs;
+    char **cts;
+    int ErrorStatus = XpmSuccess;
+    char *s;
+    int cts_index;
+
+    /*
+     * retrieve information from the XpmAttributes 
+     */
+    if (attributes && attributes->valuemask & XpmColorSymbols) {
+	colorsymbols = attributes->colorsymbols;
+	numsymbols = attributes->numsymbols;
+    } else
+	numsymbols = 0;
+
+    if (attributes && attributes->valuemask & XpmVisual)
+	visual = attributes->visual;
+    else
+	visual = DefaultVisual(display, DefaultScreen(display));
+
+    if (attributes && attributes->valuemask & XpmColormap)
+	colormap = attributes->colormap;
+    else
+	colormap = DefaultColormap(display, DefaultScreen(display));
+
+    key = xpmVisualType(visual);
+    switch(key)
+    {
+     case MONO:  cts_index = 2; break;
+     case GRAY4: cts_index = 3; break;
+     case GRAY:  cts_index = 4; break;
+     case COLOR: cts_index = 5; break;
+    }
+
+    for (a = 0; a < ncolors; a++, ct++, ip++, mp++) {
+	colorname = NULL;
+	pixel_defined = False;
+	cts = *ct;
+
+	/*
+	 * look for a defined symbol 
+	 */
+	if (numsymbols && cts[1]) {
+	    s = cts[1];
+	    for (l = 0, cs = colorsymbols; l < numsymbols; l++, cs++)
+		if ((!cs->name && cs->value && cts[cts_index] &&
+		     !strcasecmp(cs->value,cts[cts_index])) ||
+		    cs->name && !strcmp(cs->name, s))
+		    break;
+	    if (l != numsymbols) {
+		if (cs->name && cs->value)
+		    colorname = cs->value;
+		else
+		    pixel_defined = True;
+	    }
+	}
+	if (!pixel_defined) {		/* pixel not given as symbol value */
+	    if (colorname) {		/* colorname given as symbol value */
+		if (!SetColor(display, colormap, colorname, a, ip, mp,
+			      mask_pixel, pixels, npixels, attributes))
+		    pixel_defined = True;
+		else
+		    ErrorStatus = XpmColorError;
+	    }
+	    b = key;
+	    while (!pixel_defined && b > 1) {
+		if (cts[b]) {
+		    if (!SetColor(display, colormap, cts[b], a, ip, mp,
+				  mask_pixel, pixels, npixels, attributes)) {
+			pixel_defined = True;
+			break;
+		    } else
+			ErrorStatus = XpmColorError;
+		}
+		b--;
+	    }
+	    b = key + 1;
+	    while (!pixel_defined && b < NKEYS + 1) {
+		if (cts[b]) {
+		    if (!SetColor(display, colormap, cts[b], a, ip, mp,
+				  mask_pixel, pixels, npixels, attributes)) {
+			pixel_defined = True;
+			break;
+		    } else
+			ErrorStatus = XpmColorError;
+		}
+		b++;
+	    }
+	    if (!pixel_defined)
+		return (XpmColorFailed);
+	} else {
+	    *ip = colorsymbols[l].pixel;
+	    *mp = 1;
+	}
+    }
+    return (ErrorStatus);
+}    
+
+/* function call in case of error, frees only locally allocated variables */
+#undef RETURN
+#ifdef Debug
+/*
+ * XDestroyImage free the image data but mnemosyne don't know about it
+ * so I free them by hand to avoid mnemalyse report it as lost data.
+ */
+#define RETURN(status) \
+    { if (image) { \
+	free(image->data); \
+	XDestroyImage(image); } \
+    if (shapeimage) { \
+	free(shapeimage->data); \
+	XDestroyImage(shapeimage); } \
+    if (image_pixels) free(image_pixels); \
+    if (mask_pixels) free(mask_pixels); \
+    if (npixels) XFreeColors(display, colormap, pixels, npixels, 0); \
+    if (pixels) free(pixels); \
+    return (status); }
+
+#else
+
+#define RETURN(status) \
+    { if (image) XDestroyImage(image); \
+    if (shapeimage) XDestroyImage(shapeimage); \
+    if (image_pixels) free(image_pixels); \
+    if (mask_pixels) free(mask_pixels); \
+    if (npixels) XFreeColors(display, colormap, pixels, npixels, 0); \
+    if (pixels) free(pixels); \
+    return (status); }
+
+#endif
+
+xpmCreateImage(display, attrib, image_return, shapeimage_return, attributes)
+    Display *display;
+    xpmInternAttrib *attrib;
+    XImage **image_return;
+    XImage **shapeimage_return;
+    XpmAttributes *attributes;
+{
+    /* variables stored in the XpmAttributes structure */
+    Visual *visual;
+    Colormap colormap;
+    unsigned int depth;
+
+    /* variables to return */
+    XImage *image = NULL;
+    XImage *shapeimage = NULL;
+    unsigned int mask_pixel;
+    int ErrorStatus;
+
+    /* calculation variables */
+    Pixel *image_pixels = NULL;
+    Pixel *mask_pixels = NULL;
+    Pixel *pixels = NULL;		/* allocated pixels */
+    unsigned int npixels = 0;		/* number of allocated pixels */
+
+    /*
+     * retrieve information from the XpmAttributes 
+     */
+    if (attributes && attributes->valuemask & XpmVisual)
+	visual = attributes->visual;
+    else
+	visual = DefaultVisual(display, DefaultScreen(display));
+
+    if (attributes && attributes->valuemask & XpmColormap)
+	colormap = attributes->colormap;
+    else
+	colormap = DefaultColormap(display, DefaultScreen(display));
+
+    if (attributes && attributes->valuemask & XpmDepth)
+	depth = attributes->depth;
+    else
+	depth = DefaultDepth(display, DefaultScreen(display));
+
+    ErrorStatus = XpmSuccess;
+
+    /*
+     * malloc pixels index tables 
+     */
+
+    image_pixels = (Pixel *) malloc(sizeof(Pixel) * attrib->ncolors);
+    if (!image_pixels)
+	return(XpmNoMemory);
+
+    mask_pixels = (Pixel *) malloc(sizeof(Pixel) * attrib->ncolors);
+    if (!mask_pixels)
+	RETURN(ErrorStatus);
+
+    mask_pixel = UNDEF_PIXEL;
+
+    /* maximum of allocated pixels will be the number of colors */
+    pixels = (Pixel *) malloc(sizeof(Pixel) * attrib->ncolors);
+    if (!pixels)
+	RETURN(ErrorStatus);
+
+    /*
+     * get pixel colors, store them in index tables 
+     */
+
+    ErrorStatus = CreateColors(display, attributes, attrib->colorTable,
+			       attrib->ncolors, image_pixels, mask_pixels,
+			       &mask_pixel, &pixels, &npixels);
+    if (ErrorStatus != XpmSuccess && (ErrorStatus < 0 || attributes &&
+	(attributes->valuemask & XpmExactColors) && attributes->exactColors))
+	RETURN(ErrorStatus);
+
+    /*
+     * create the image 
+     */
+    if (image_return) {
+	ErrorStatus = CreateXImage(display, visual, depth,
+				    attrib->width, attrib->height, &image);
+	if (ErrorStatus != XpmSuccess)
+	    RETURN(ErrorStatus);
+
+	/*
+	 * set the image data 
+	 *
+	 * In case depth is 1 or bits_per_pixel is 4, 6, 8, 24 or 32 use
+	 * optimized functions, otherwise use slower but sure general one. 
+	 *
+	 */
+
+	if (image->depth == 1)
+	    SetImagePixels1(image, attrib->width, attrib->height,
+			    attrib->pixelindex, image_pixels);
+	else if (image->bits_per_pixel == 8)
+	    SetImagePixels8(image, attrib->width, attrib->height,
+			    attrib->pixelindex, image_pixels);
+	else if (image->bits_per_pixel == 16)
+	    SetImagePixels16(image, attrib->width, attrib->height,
+			     attrib->pixelindex, image_pixels);
+	else if (image->bits_per_pixel == 32)
+	    SetImagePixels32(image, attrib->width, attrib->height,
+			     attrib->pixelindex, image_pixels);
+	else
+	    SetImagePixels(image, attrib->width, attrib->height,
+			   attrib->pixelindex, image_pixels);
+    }
+
+    /*
+     * create the shape mask image 
+     */
+    if (mask_pixel != UNDEF_PIXEL && shapeimage_return) {
+	ErrorStatus = CreateXImage(display, visual, 1, attrib->width,
+				    attrib->height, &shapeimage);
+	if (ErrorStatus != XpmSuccess)
+	    RETURN(ErrorStatus);
+
+	SetImagePixels1(shapeimage, attrib->width, attrib->height,
+			attrib->pixelindex, mask_pixels);
+    }
+    free(mask_pixels);
+    free(pixels);
+
+    /*
+     * if requested store used pixels in the XpmAttributes structure 
+     */
+    if (attributes &&
+	(attributes->valuemask & XpmReturnInfos
+	 || attributes->valuemask & XpmReturnPixels)) {
+	if (mask_pixel != UNDEF_PIXEL) {
+	    Pixel *pixels, *p1, *p2;
+	    unsigned int a;
+
+	    attributes->npixels = attrib->ncolors - 1;
+	    pixels = (Pixel *) malloc(sizeof(Pixel) * attributes->npixels);
+	    if (pixels) {
+		p1 = image_pixels;
+		p2 = pixels;
+		for (a = 0; a < attrib->ncolors; a++, p1++)
+		    if (a != mask_pixel)
+			*p2++ = *p1;
+		attributes->pixels = pixels;
+	    } else {
+		/* if error just say we can't return requested data */
+		attributes->valuemask &= ~XpmReturnPixels;
+		attributes->valuemask &= ~XpmReturnInfos;
+		attributes->pixels = NULL;
+		attributes->npixels = 0;
+	    }
+	    free(image_pixels);
+	} else {
+	    attributes->pixels = image_pixels;
+	    attributes->npixels = attrib->ncolors;
+	}
+	attributes->mask_pixel = mask_pixel;
+    } else
+	free(image_pixels);
+
+
+    /*
+     * return created images 
+     */
+    if (image_return)
+	*image_return = image;
+
+    if (shapeimage_return)
+	*shapeimage_return = shapeimage;
+
+    return (ErrorStatus);
+}
+
+
+/*
+ * Create an XImage
+ */
+static int
+CreateXImage(display, visual, depth, width, height, image_return)
+    Display *display;
+    Visual *visual;
+    unsigned int depth;
+    unsigned int width;
+    unsigned int height;
+    XImage **image_return;
+{
+    int bitmap_pad;
+
+    /* first get bitmap_pad */
+    if (depth > 16)
+	bitmap_pad = 32;
+    else if (depth > 8)
+	bitmap_pad = 16;
+    else
+	bitmap_pad = 8;
+
+    /* then create the XImage with data = NULL and bytes_per_line = 0 */
+
+    *image_return = XCreateImage(display, visual, depth, ZPixmap, 0, 0,
+				 width, height, bitmap_pad, 0);
+    if (!*image_return)
+	return (XpmNoMemory);
+
+    /* now that bytes_per_line must have been set properly alloc data */
+
+    (*image_return)->data =
+	(char *) malloc((*image_return)->bytes_per_line * height);
+
+    if (!(*image_return)->data) {
+	XDestroyImage(*image_return);
+	*image_return = NULL;
+	return (XpmNoMemory);
+    }
+    return (XpmSuccess);
+}
+
+
+/*
+ * The functions below are written from X11R5 MIT's code (XImUtil.c)
+ *
+ * The idea is to have faster functions than the standard XPutPixel function
+ * to build the image data. Indeed we can speed up things by suppressing tests
+ * performed for each pixel. We do the same tests but at the image level.
+ * We also assume that we use only ZPixmap images with null offsets.
+ */
+
+LFUNC(_putbits, void, (register char *src, int dstoffset,
+		       register int numbits, register char *dst));
+
+LFUNC(_XReverse_Bytes, int, (register unsigned char *bpt, register int nb));
+
+static unsigned char Const _reverse_byte[0x100] = {
+			    0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
+			    0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0,
+			    0x08, 0x88, 0x48, 0xc8, 0x28, 0xa8, 0x68, 0xe8,
+			    0x18, 0x98, 0x58, 0xd8, 0x38, 0xb8, 0x78, 0xf8,
+			    0x04, 0x84, 0x44, 0xc4, 0x24, 0xa4, 0x64, 0xe4,
+			    0x14, 0x94, 0x54, 0xd4, 0x34, 0xb4, 0x74, 0xf4,
+			    0x0c, 0x8c, 0x4c, 0xcc, 0x2c, 0xac, 0x6c, 0xec,
+			    0x1c, 0x9c, 0x5c, 0xdc, 0x3c, 0xbc, 0x7c, 0xfc,
+			    0x02, 0x82, 0x42, 0xc2, 0x22, 0xa2, 0x62, 0xe2,
+			    0x12, 0x92, 0x52, 0xd2, 0x32, 0xb2, 0x72, 0xf2,
+			    0x0a, 0x8a, 0x4a, 0xca, 0x2a, 0xaa, 0x6a, 0xea,
+			    0x1a, 0x9a, 0x5a, 0xda, 0x3a, 0xba, 0x7a, 0xfa,
+			    0x06, 0x86, 0x46, 0xc6, 0x26, 0xa6, 0x66, 0xe6,
+			    0x16, 0x96, 0x56, 0xd6, 0x36, 0xb6, 0x76, 0xf6,
+			    0x0e, 0x8e, 0x4e, 0xce, 0x2e, 0xae, 0x6e, 0xee,
+			    0x1e, 0x9e, 0x5e, 0xde, 0x3e, 0xbe, 0x7e, 0xfe,
+			    0x01, 0x81, 0x41, 0xc1, 0x21, 0xa1, 0x61, 0xe1,
+			    0x11, 0x91, 0x51, 0xd1, 0x31, 0xb1, 0x71, 0xf1,
+			    0x09, 0x89, 0x49, 0xc9, 0x29, 0xa9, 0x69, 0xe9,
+			    0x19, 0x99, 0x59, 0xd9, 0x39, 0xb9, 0x79, 0xf9,
+			    0x05, 0x85, 0x45, 0xc5, 0x25, 0xa5, 0x65, 0xe5,
+			    0x15, 0x95, 0x55, 0xd5, 0x35, 0xb5, 0x75, 0xf5,
+			    0x0d, 0x8d, 0x4d, 0xcd, 0x2d, 0xad, 0x6d, 0xed,
+			    0x1d, 0x9d, 0x5d, 0xdd, 0x3d, 0xbd, 0x7d, 0xfd,
+			    0x03, 0x83, 0x43, 0xc3, 0x23, 0xa3, 0x63, 0xe3,
+			    0x13, 0x93, 0x53, 0xd3, 0x33, 0xb3, 0x73, 0xf3,
+			    0x0b, 0x8b, 0x4b, 0xcb, 0x2b, 0xab, 0x6b, 0xeb,
+			    0x1b, 0x9b, 0x5b, 0xdb, 0x3b, 0xbb, 0x7b, 0xfb,
+			    0x07, 0x87, 0x47, 0xc7, 0x27, 0xa7, 0x67, 0xe7,
+			    0x17, 0x97, 0x57, 0xd7, 0x37, 0xb7, 0x77, 0xf7,
+			    0x0f, 0x8f, 0x4f, 0xcf, 0x2f, 0xaf, 0x6f, 0xef,
+			     0x1f, 0x9f, 0x5f, 0xdf, 0x3f, 0xbf, 0x7f, 0xff
+};
+
+static int
+_XReverse_Bytes(bpt, nb)
+    register unsigned char *bpt;
+    register int nb;
+{
+    do {
+	*bpt = _reverse_byte[*bpt];
+	bpt++;
+    } while (--nb > 0);
+    return 0;
+}
+
+
+void
+xpm_xynormalizeimagebits(bp, img)
+    register unsigned char *bp;
+    register XImage *img;
+{
+    register unsigned char c;
+
+    if (img->byte_order != img->bitmap_bit_order) {
+	switch (img->bitmap_unit) {
+
+	case 16:
+	    c = *bp;
+	    *bp = *(bp + 1);
+	    *(bp + 1) = c;
+	    break;
+
+	case 32:
+	    c = *(bp + 3);
+	    *(bp + 3) = *bp;
+	    *bp = c;
+	    c = *(bp + 2);
+	    *(bp + 2) = *(bp + 1);
+	    *(bp + 1) = c;
+	    break;
+	}
+    }
+    if (img->bitmap_bit_order == MSBFirst)
+	_XReverse_Bytes(bp, img->bitmap_unit >> 3);
+}
+
+void
+xpm_znormalizeimagebits(bp, img)
+    register unsigned char *bp;
+    register XImage *img;
+{
+    register unsigned char c;
+
+    switch (img->bits_per_pixel) {
+
+    case 4:
+	*bp = ((*bp >> 4) & 0xF) | ((*bp << 4) & ~0xF);
+	break;
+
+    case 16:
+	c = *bp;
+	*bp = *(bp + 1);
+	*(bp + 1) = c;
+	break;
+
+    case 24:
+	c = *(bp + 2);
+	*(bp + 2) = *bp;
+	*bp = c;
+	break;
+
+    case 32:
+	c = *(bp + 3);
+	*(bp + 3) = *bp;
+	*bp = c;
+	c = *(bp + 2);
+	*(bp + 2) = *(bp + 1);
+	*(bp + 1) = c;
+	break;
+    }
+}
+
+static unsigned char Const _lomask[0x09] = {
+		     0x00, 0x01, 0x03, 0x07, 0x0f, 0x1f, 0x3f, 0x7f, 0xff};
+static unsigned char Const _himask[0x09] = {
+		     0xff, 0xfe, 0xfc, 0xf8, 0xf0, 0xe0, 0xc0, 0x80, 0x00};
+
+static void
+_putbits(src, dstoffset, numbits, dst)
+    register char *src;			/* address of source bit string */
+    int dstoffset;			/* bit offset into destination;
+					 * range is 0-31 */
+    register int numbits;		/* number of bits to copy to
+					 * destination */
+    register char *dst;			/* address of destination bit string */
+{
+    register unsigned char chlo, chhi;
+    int hibits;
+
+    dst = dst + (dstoffset >> 3);
+    dstoffset = dstoffset & 7;
+    hibits = 8 - dstoffset;
+    chlo = *dst & _lomask[dstoffset];
+    for (;;) {
+	chhi = (*src << dstoffset) & _himask[dstoffset];
+	if (numbits <= hibits) {
+	    chhi = chhi & _lomask[dstoffset + numbits];
+	    *dst = (*dst & _himask[dstoffset + numbits]) | chlo | chhi;
+	    break;
+	}
+	*dst = chhi | chlo;
+	dst++;
+	numbits = numbits - hibits;
+	chlo = (unsigned char) (*src & _himask[hibits]) >> hibits;
+	src++;
+	if (numbits <= dstoffset) {
+	    chlo = chlo & _lomask[numbits];
+	    *dst = (*dst & _himask[numbits]) | chlo;
+	    break;
+	}
+	numbits = numbits - dstoffset;
+    }
+}
+
+/*
+ * Default method to write pixels into a Z image data structure.
+ * The algorithm used is:
+ *
+ *	copy the destination bitmap_unit or Zpixel to temp
+ *	normalize temp if needed
+ *	copy the pixel bits into the temp
+ *	renormalize temp if needed
+ *	copy the temp back into the destination image data
+ */
+
+static void
+SetImagePixels(image, width, height, pixelindex, pixels)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    unsigned int *pixelindex;
+    Pixel *pixels;
+{
+    register char *src;
+    register char *dst;
+    register unsigned int *iptr;
+    register int x, y, i;
+    register char *data;
+    Pixel pixel, px;
+    int nbytes, depth, ibu, ibpp;
+
+    data = image->data;
+    iptr = pixelindex;
+    depth = image->depth;
+    if (image->depth == 1) {
+	ibu = image->bitmap_unit;
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		pixel = pixels[*iptr];
+		for (i = 0, px = pixel;
+		     i < sizeof(unsigned long); i++, px >>= 8)
+		    ((unsigned char *) &pixel)[i] = px;
+		src = &data[XYINDEX(x, y, image)];
+		dst = (char *) &px;
+		px = 0;
+		nbytes = ibu >> 3;
+		for (i = nbytes; --i >= 0;)
+		    *dst++ = *src++;
+		XYNORMALIZE(&px, image);
+		_putbits((char *) &pixel, (x % ibu), 1, (char *) &px);
+		XYNORMALIZE(&px, image);
+		src = (char *) &px;
+		dst = &data[XYINDEX(x, y, image)];
+		for (i = nbytes; --i >= 0;)
+		    *dst++ = *src++;
+	    }
+    } else {
+	ibpp = image->bits_per_pixel;
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		pixel = pixels[*iptr];
+		if (depth == 4)
+		    pixel &= 0xf;
+		for (i = 0, px = pixel;
+		     i < sizeof(unsigned long); i++, px >>= 8)
+		    ((unsigned char *) &pixel)[i] = px;
+		src = &data[ZINDEX(x, y, image)];
+		dst = (char *) &px;
+		px = 0;
+		nbytes = (ibpp + 7) >> 3;
+		for (i = nbytes; --i >= 0;)
+		    *dst++ = *src++;
+		ZNORMALIZE(&px, image);
+		_putbits((char *) &pixel, (x * ibpp) & 7, ibpp, (char *) &px);
+		ZNORMALIZE(&px, image);
+		src = (char *) &px;
+		dst = &data[ZINDEX(x, y, image)];
+		for (i = nbytes; --i >= 0;)
+		    *dst++ = *src++;
+	    }
+    }
+}
+
+/*
+ * write pixels into a 32-bits Z image data structure
+ */
+
+#ifndef WORD64
+static unsigned long byteorderpixel = MSBFirst << 24;
+
+#endif
+
+static void
+SetImagePixels32(image, width, height, pixelindex, pixels)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    unsigned int *pixelindex;
+    Pixel *pixels;
+{
+    register unsigned char *addr;
+    register unsigned char *data;
+    register unsigned int *iptr;
+    register int x, y;
+    Pixel pixel;
+
+    data = (unsigned char *) image->data;
+    iptr = pixelindex;
+#ifndef WORD64
+    if (*((char *) &byteorderpixel) == image->byte_order) {
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		*((unsigned long *)addr) = pixels[*iptr];
+	    }
+    } else
+#endif
+    if (image->byte_order == MSBFirst)
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		pixel = pixels[*iptr];
+		addr[0] = pixel >> 24;
+		addr[1] = pixel >> 16;
+		addr[2] = pixel >> 8;
+		addr[3] = pixel;
+	    }
+    else
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		pixel = pixels[*iptr];
+		addr[0] = pixel;
+		addr[1] = pixel >> 8;
+		addr[2] = pixel >> 16;
+		addr[3] = pixel >> 24;
+	    }
+}
+
+/*
+ * write pixels into a 16-bits Z image data structure
+ */
+
+static void
+SetImagePixels16(image, width, height, pixelindex, pixels)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    unsigned int *pixelindex;
+    Pixel *pixels;
+{
+    register unsigned char *addr;
+    register unsigned char *data;
+    register unsigned int *iptr;
+    register int x, y;
+
+    data = (unsigned char *) image->data;
+    iptr = pixelindex;
+    if (image->byte_order == MSBFirst)
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX16(x, y, image)];
+		addr[0] = pixels[*iptr] >> 8;
+		addr[1] = pixels[*iptr];
+	    }
+    else
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX16(x, y, image)];
+		addr[0] = pixels[*iptr];
+		addr[1] = pixels[*iptr] >> 8;
+	    }
+}
+
+/*
+ * write pixels into a 8-bits Z image data structure
+ */
+
+static void
+SetImagePixels8(image, width, height, pixelindex, pixels)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    unsigned int *pixelindex;
+    Pixel *pixels;
+{
+    register char *data;
+    register unsigned int *iptr;
+    register int x, y;
+
+    data = image->data;
+    iptr = pixelindex;
+    for (y = 0; y < height; y++)
+	for (x = 0; x < width; x++, iptr++)
+	    data[ZINDEX8(x, y, image)] = pixels[*iptr];
+}
+
+/*
+ * write pixels into a 1-bit depth image data structure and **offset null**
+ */
+
+static void
+SetImagePixels1(image, width, height, pixelindex, pixels)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    unsigned int *pixelindex;
+    Pixel *pixels;
+{
+    register unsigned int *iptr;
+    register int x, y;
+    register char *data;
+
+    if (image->byte_order != image->bitmap_bit_order)
+	SetImagePixels(image, width, height, pixelindex, pixels);
+    else {
+	data = image->data;
+	iptr = pixelindex;
+	if (image->bitmap_bit_order == MSBFirst)
+	    for (y = 0; y < height; y++)
+		for (x = 0; x < width; x++, iptr++) {
+		    if (pixels[*iptr] & 1)
+			data[ZINDEX1(x, y, image)] |= 0x80 >> (x & 7);
+		    else
+			data[ZINDEX1(x, y, image)] &= ~(0x80 >> (x & 7));
+		}
+	else
+	    for (y = 0; y < height; y++)
+		for (x = 0; x < width; x++, iptr++) {
+		    if (pixels[*iptr] & 1)
+			data[ZINDEX1(x, y, image)] |= 1 << (x & 7);
+		    else
+			data[ZINDEX1(x, y, image)] &= ~(1 << (x & 7));
+		}
+    }
+}
diff --git a/src/xpm/data.c b/src/xpm/data.c
new file mode 100644
index 0000000..87901d9
--- /dev/null
+++ b/src/xpm/data.c
@@ -0,0 +1,422 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* data.c:                                                                     *
+*                                                                             *
+*  XPM library                                                                *
+*  IO utilities                                                               *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+/* Official version number */
+static char *RCS_Version = "$XpmVersion: 3.2c $";
+
+/* Internal version number */
+static char *RCS_Id = "$Id: xpm.shar,v 3.13 1992/12/29 16:05:26 lehors Exp $";
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:stat.h"
+#include "sys$library:ctype.h"
+#else
+#include <sys/stat.h>
+#include <ctype.h>
+#endif
+
+FUNC(atoui, unsigned int, (char *p, unsigned int l, unsigned int *ui_return));
+LFUNC(ParseComment, int, (xpmData *mdata));
+
+unsigned int
+atoui(p, l, ui_return)
+    register char *p;
+    unsigned int l;
+    unsigned int *ui_return;
+{
+    register int n, i;
+
+    n = 0;
+    for (i = 0; i < l; i++)
+	if (*p >= '0' && *p <= '9')
+	    n = n * 10 + *p++ - '0';
+	else
+	    break;
+
+    if (i != 0 && i == l) {
+	*ui_return = n;
+	return 1;
+    } else
+	return 0;
+}
+
+static int
+ParseComment(mdata)
+    xpmData *mdata;
+{
+    FILE *file = mdata->stream.file;
+    register int c;
+    register unsigned int n = 0, a;
+    unsigned int notend;
+    char *s, *s2;
+
+    s = mdata->Comment;
+    *s = mdata->Bcmt[0];
+
+    /* skip the string beginning comment */
+    s2 = mdata->Bcmt;
+    do {
+	c = getc(file);
+	*++s = c;
+	n++;
+	s2++;
+    } while (c == *s2 && *s2 != '\0'
+	     && c != EOF && c != mdata->Bos);
+
+    if (*s2 != '\0') {
+	/* this wasn't the beginning of a comment */
+	/* put characters back in the order that we got them */
+	for (a = n; a > 0; a--, s--)
+	    ungetc(*s, file);
+	return 0;
+    }
+
+    /* store comment */
+    mdata->Comment[0] = *s;
+    s = mdata->Comment;
+    notend = 1;
+    n = 0;
+    while (notend) {
+	s2 = mdata->Ecmt;
+	while (*s != *s2 && c != EOF && c != mdata->Bos) {
+	    c = getc(file);
+	    *++s = c;
+	    n++;
+	}
+	mdata->CommentLength = n;
+	do {
+	    c = getc(file);
+	    n++;
+	    *++s = c;
+	    s2++;
+	} while (c == *s2 && *s2 != '\0'
+		 && c != EOF && c != mdata->Bos);
+	if (*s2 == '\0') {
+	    /* this is the end of the comment */
+	    notend = 0;
+	    ungetc(*s, file);
+	}
+    }
+}
+
+/*
+ * skip to the end of the current string and the beginning of the next one
+ */
+xpmNextString(mdata)
+    xpmData *mdata;
+{
+    if (!mdata->type)
+	mdata->cptr = (mdata->stream.data)[++mdata->line];
+    else {
+	register int c;
+	FILE *file = mdata->stream.file;
+
+	/* get to the end of the current string */
+	if (mdata->Eos)
+	    while ((c = getc(file)) != mdata->Eos && c != EOF);
+
+	/* then get to the beginning of the next string
+	 * looking for possible comment */
+	if (mdata->Bos) {
+	    while ((c = getc(file)) != mdata->Bos && c != EOF)
+		if (mdata->Bcmt && c == mdata->Bcmt[0])
+		    ParseComment(mdata);
+	    
+	} else {			/* XPM2 natural */
+	    while (mdata->Bcmt && (c = getc(file)) == mdata->Bcmt[0])
+		ParseComment(mdata);
+	    ungetc(c, file);
+	}
+    }
+}
+
+
+/*
+ * skip whitespace and compute the following unsigned int,
+ * returns 1 if one is found and 0 if not
+ */
+int
+xpmNextUI(mdata, ui_return)
+    xpmData *mdata;
+    unsigned int *ui_return;
+{
+    char buf[BUFSIZ];
+    int l;
+
+    l = xpmNextWord(mdata, buf);
+    return atoui(buf, l, ui_return);
+}
+
+/*
+ * skip whitespace and return the following word
+ */
+unsigned int
+xpmNextWord(mdata, buf)
+    xpmData *mdata;
+    char *buf;
+{
+    register unsigned int n = 0;
+    int c;
+
+    if (!mdata->type) {
+	while (isspace(c = *mdata->cptr) && c != mdata->Eos)
+	    mdata->cptr++;
+	do {
+	    c = *mdata->cptr++;
+	    *buf++ = c;
+	    n++;
+	} while (!isspace(c) && c != mdata->Eos);
+	n--;
+	mdata->cptr--;
+    } else {
+	FILE *file = mdata->stream.file;
+	while (isspace(c = getc(file)) && c != mdata->Eos);
+	while (!isspace(c) && c != mdata->Eos && c != EOF) {
+	    *buf++ = c;
+	    n++;
+	    c = getc(file);
+	}
+	ungetc(c, file);
+    }
+    return (n);
+}
+
+/*
+ * return end of string - WARNING: malloc!
+ */
+int
+xpmGetString(mdata, sptr, l)
+    xpmData *mdata;
+    char **sptr;
+    unsigned int *l;
+{
+    unsigned int i, n = 0;
+    int c;
+    char *p, *q, buf[BUFSIZ];
+
+    if (!mdata->type) {
+	if (mdata->cptr) {
+	    char *start;
+	    while (isspace(c = *mdata->cptr) && c != mdata->Eos)
+		mdata->cptr++;
+	    start = mdata->cptr;
+	    while (c = *mdata->cptr)
+		mdata->cptr++;
+	    n = mdata->cptr - start + 1;
+	    p = (char *) malloc(n);
+	    if (!p)
+		return (XpmNoMemory);
+	    strncpy(p, start, n);
+	}
+    } else {
+	FILE *file = mdata->stream.file;
+	while (isspace(c = getc(file)) && c != mdata->Eos);
+	if (c == EOF)
+	    return (XpmFileInvalid);
+	p = NULL;
+	i = 0;
+	q = buf;
+	p = (char *) malloc(1);
+	while (c != mdata->Eos && c != EOF) {
+	    if (i == BUFSIZ) {
+		/* get to the end of the buffer */
+		/* malloc needed memory */
+		q = (char *) realloc(p, n + i);
+		if (!q) {
+		    free(p);
+		    return (XpmNoMemory);
+		}
+		p = q;
+		q += n;
+		/* and copy what we already have */
+		strncpy(q, buf, i);
+		n += i;
+		i = 0;
+		q = buf;
+	    }
+	    *q++ = c;
+	    i++;
+	    c = getc(file);
+	}
+	if (c == EOF) {
+	    free(p);
+	    return (XpmFileInvalid);
+	}
+	if (n + i != 0) {
+	    /* malloc needed memory */
+	    q = (char *) realloc(p, n + i + 1);
+	    if (!q) {
+		free(p);
+		return (XpmNoMemory);
+	    }
+	    p = q;
+	    q += n;
+	    /* and copy the buffer */
+	    strncpy(q, buf, i);
+	    n += i;
+	    p[n++] = '\0';
+	} else {
+	    *p = '\0';
+	    n = 1;
+	}
+	ungetc(c, file);
+    }
+    *sptr = p;
+    *l = n;
+    return (XpmSuccess);
+}
+
+/*
+ * get the current comment line
+ */
+xpmGetCmt(mdata, cmt)
+    xpmData *mdata;
+    char **cmt;
+{
+    if (!mdata->type)
+	*cmt = NULL;
+    else
+	if (mdata->CommentLength) {
+	    *cmt = (char *) malloc(mdata->CommentLength + 1);
+	    strncpy(*cmt, mdata->Comment, mdata->CommentLength);
+	    (*cmt)[mdata->CommentLength] = '\0';
+	    mdata->CommentLength = 0;
+	} else
+	    *cmt = NULL;
+}
+
+/*
+ * open the given file to be read as an xpmData which is returned.
+ */
+int
+xpmReadFile(filename, mdata)
+    char *filename;
+    xpmData *mdata;
+{
+    char *compressfile, buf[BUFSIZ];
+    struct stat status;
+
+    if (!filename) {
+	mdata->stream.file = (stdin);
+	mdata->type = XPMFILE;
+    } else {
+#ifdef ZPIPE
+	if (((int)strlen(filename) > 2) &&
+	    !strcmp(".Z", filename + (strlen(filename) - 2))) {
+	    mdata->type = XPMPIPE;
+	    sprintf(buf, "uncompress -c %s", filename);
+	    if (!(mdata->stream.file = popen(buf, "r")))
+		return (XpmOpenFailed);
+
+	} else {
+	    if (!(compressfile = (char *) malloc(strlen(filename) + 3)))
+		return (XpmNoMemory);
+
+	    strcpy(compressfile, filename);
+	    strcat(compressfile, ".Z");
+	    if (!stat(compressfile, &status)) {
+		sprintf(buf, "uncompress -c %s", compressfile);
+		if (!(mdata->stream.file = popen(buf, "r"))) {
+		    free(compressfile);
+		    return (XpmOpenFailed);
+		}
+		mdata->type = XPMPIPE;
+	    } else {
+#endif
+		if (!(mdata->stream.file = fopen(filename, "r"))) {
+#ifdef ZPIPE
+		    free(compressfile);
+#endif
+		    return (XpmOpenFailed);
+		}
+		mdata->type = XPMFILE;
+#ifdef ZPIPE
+	    }
+	    free(compressfile);
+	}
+#endif
+    }
+    mdata->CommentLength = 0;
+    return (XpmSuccess);
+}
+
+/*
+ * open the given file to be written as an xpmData which is returned
+ */
+int
+xpmWriteFile(filename, mdata)
+    char *filename;
+    xpmData *mdata;
+{
+    char buf[BUFSIZ];
+
+    if (!filename) {
+	mdata->stream.file = (stdout);
+	mdata->type = XPMFILE;
+    } else {
+#ifdef ZPIPE
+	if ((int)strlen(filename) > 2
+	    && !strcmp(".Z", filename + ((int)strlen(filename) - 2))) {
+	    sprintf(buf, "compress > %s", filename);
+	    if (!(mdata->stream.file = popen(buf, "w")))
+		return (XpmOpenFailed);
+
+	    mdata->type = XPMPIPE;
+	} else {
+#endif
+	    if (!(mdata->stream.file = fopen(filename, "w")))
+		return (XpmOpenFailed);
+
+	    mdata->type = XPMFILE;
+#ifdef ZPIPE
+	}
+#endif
+    }
+    return (XpmSuccess);
+}
+
+/*
+ * open the given array to be read or written as an xpmData which is returned
+ */
+void
+xpmOpenArray(data, mdata)
+    char **data;
+    xpmData *mdata;
+{
+    mdata->type = XPMARRAY;
+    mdata->stream.data = data;
+    mdata->cptr = *data;
+    mdata->line = 0;
+    mdata->CommentLength = 0;
+    mdata->Bcmt = mdata->Ecmt = NULL;
+    mdata->Bos = mdata->Eos = '\0';
+}
+
+/*
+ * close the file related to the xpmData if any
+ */
+XpmDataClose(mdata)
+    xpmData *mdata;
+{
+    switch (mdata->type) {
+    case XPMARRAY:
+	break;
+    case XPMFILE:
+	if (mdata->stream.file != (stdout) && mdata->stream.file != (stdin))
+	    fclose(mdata->stream.file);
+	break;
+#ifdef ZPIPE
+    case XPMPIPE:
+	pclose(mdata->stream.file);
+	break;
+#endif
+    }
+}
diff --git a/src/xpm/doc/CHANGES b/src/xpm/doc/CHANGES
new file mode 100644
index 0000000..22f28a5
--- /dev/null
+++ b/src/xpm/doc/CHANGES
@@ -0,0 +1,422 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/**************************************************************************\
+* 									   *
+*  			HISTORY of user-visible changes			   *
+* 									   *
+\**************************************************************************/
+
+3.2c		(92/12/29)
+
+    ENHANCEMENTS:
+    	- parsing optimized for single and double characters color
+		- patch originally from Martin Brunecky 
+				       marbru@build1.auto-trol.com
+
+    BUGS CORRECTED:
+	- XpmFreeExtensions was calling free on some argument without checking
+	it was not NULL.
+	- strdup was not correctly defined for systems which do not provide
+	it.	- Hans-Peter Lichtin <lich@zellweger.ch>
+	- some bug in XpmCrDataFI.c
+	        - Sven Delmas garfield@avalanche.cs.tu-berlin.de
+
+    NOTE:
+    	- there is still a bug with the creation of the clipmask on display of
+	depth 2 but I can't find a fix because unfortunately I don't have such
+	a rendering system and nobody gets the time to investigate for me.
+
+3.2b		(92/10/19)
+
+    ENHANCEMENTS:
+	- Create XpmReadFileToData and XpmWriteFileFromData
+		- Dan Greening <dgreen@sti.com>
+    	- added "close colors" support and ability to redefine color values
+	  as pixels at load time, as well as color names
+		- Jason Patterson <jasonp@fitmail.qut.edu.au>
+	- errors while parsing or allocating colors now revert to other
+	  visual defaults, creating pixmap/image as expected, and returning
+	  XpmSuccess. The old behaviour of XpmColorError being returned and no
+	  pixmap/image being created can be retained by setting the
+	  exactColors attribute.
+		- Jason Patterson <jasonp@fitmail.qut.edu.au>
+
+    BUGS CORRECTED:
+	- SVR4 defines for including <string.h> instead of <strings.h>
+		- Jason Patterson <jasonp@fitmail.qut.edu.au>
+	- attributes->extensions and attributes->nextensions fields were not 
+	  set correctly when no extensions present in file.
+		- Simon_Scott Cornish <cornish@ecr.mu.oz.au>
+
+3.2a		(92/08/17)
+
+    ENHANCEMENTS:
+    	- use the mock lisp hashing function instead of the gnu emacs one,
+	it is faster in some cases and never slower (I've not found any case).
+
+    BUGS CORRECTED:
+	- function prototypes for ansi compilers.
+	- some memory initialization bugs (purify is just great for this).
+	- empty strings in extensions are now correctly handled.
+
+3.2		(92/07/06)
+
+    NEW FEATURES:
+	- both format and functions handle extensions data. This allow people
+	to store additional data related to a pixmap. See documentation for
+	detail.
+	- sxpm supports the new option '-c' to use a private colormap. This is
+	useful when displaying pixmaps using a lot of colors.
+	- sxpm supports the new option '-v' (verbose) to get possible
+	extensions print out on standard error.
+
+    ENHANCEMENTS:
+    	- most of the code has been reworked to be improved and thus almost
+	every function is faster. It takes less than 6 seconds of real time on
+	a sun4 to display, with sxpm, a 487x635 pixmap using 213 colors, while
+	it takes 32 seconds with the old library! It takes 18 seconds to
+	display a 1279x1023 screen dump using 14 colors while xwud takes 10
+	seconds.
+	Of course performance improvements are not always that great, they
+	depend on the size and number of colors but I'm sure everybody will
+	appreciate ;-)
+	I know how to improve it more but this will require changes in the
+	architecture so this is not for now. Some optimizations have been
+	contributed by gregor@kafka.saic.com (gregg hanna) and
+	jnc@csl.biosci.arizona.edu (John N. Calley).
+	- the Imakefile is modified to let you install sxpm - Rainer Klute
+           <klute@irb.informatik.uni-dortmund.de>
+	- xpmP.h declares popen for Sequent platforms - Clinton Jeffery
+	   <cjeffery@cs.arizona.edu>
+	- XpmWriteFileFromImage/Pixmap rather than truncating the pixmap name
+	to the first dot changes dots to underscores to get a valid C syntax
+	name.
+
+
+    BUGS CORRECTED:
+	- there was a bug in the image creation function for some 24 bits
+	displays. It is fixed.
+	- allocated color pixels are now freed when an error occurs -
+	   nusser@dec1.wu-wien.ac.at (Stefan Nusser)
+
+    CHANGES TO THE DOC:
+	- the documentation describes the new XpmExtension structure and how
+	to use it with read and write functions.
+
+3.1		(92/02/03)
+
+    ENHANCEMENTS:
+    	- sxpm now have more standard options (mainly suggested by 
+	Rainer Sinkwitz <sinkwitz@ifi.unizh.ch>):
+
+	Usage:  sxpm [options...]
+	Where options are:
+
+	[-d host:display]            Display to connect to.
+	[-g geom]                    Geometry of window.
+	[-hints]                     Set ResizeInc for window.
+	[-icon filename]             Set pixmap for iconWindow.
+	[-s symbol_name color_name]  Overwrite color defaults.
+	[-p symbol_name pixel_value] Overwrite color defaults.
+	[-plaid]                     Read the included plaid pixmap.
+	[filename]                   Read from file 'filename', and from
+				     standard input if 'filename' is '-'.
+	[-o filename]                Write to file 'filename', and to standard
+				     output if 'filename' is '-'.
+	[-nod]                       Don't display in window.
+	[-rgb filename]              Search color names in the rgb text file
+				     'filename'.
+
+	if no input is specified sxpm reads from stdandard input.
+
+
+	- Xpm functions and Ppm converters now deal with multiword colornames.
+	  patches from Rainer Sinkwitz <sinkwitz@ifi.unizh.ch>.
+
+
+3.0		(91/10/03)
+
+	Functions name and defines have been modified again (sorry for that)
+	as follows:
+
+	     XpmReadPixmapFile    XpmReadFileToPixmap
+	     XpmWritePixmapFile   XpmWriteFileFromPixmap
+
+	     XpmPixmapColorError  XpmColorError
+	     XpmPixmapSuccess     XpmSuccess
+	     XpmPixmapOpenFailed  XpmOpenFailed
+	     XpmPixmapFileInvalid XpmFileInvalid
+	     XpmPixmapNoMemory    XpmNoMemory
+	     XpmPixmapColorFailed XpmColorFailed
+
+	To update code using Xpm you can use the included shell script called
+	rename with the sed commands files name-3.0b-3.0c and name-3.0c-3.0.
+	Old names still valid though.
+
+    NEW FEATURES:
+	- four new functions to work with images instead of pixmaps:
+
+	     XpmReadFileToImage
+	     XpmWriteFileFromImage
+	     XpmCreateImageFromData
+	     XpmCreateDataFromImage
+
+    ENHANCEMENTS:
+    	Algorithms to create and scan images and pixmaps are based on the
+	MIT's R5 code, thus they are much cleaner than old ones and should
+	avoid any problem with any visual (yes, I trust MIT folks :-)
+
+    BUGS CORRECTED:
+	Imakefile use INCDIR instead of ROOTDIR.
+
+    CHANGES TO THE DOC:
+	- the documentation presents the four new functions.
+
+3.0c		(91/09/18)
+
+	In answer to request of people functions, types and defines names have
+	been changed as follows:
+
+	     XCreatePixmapFromData	 XpmCreatePixmapFromData
+	     XCreateDataFromPixmap	 XpmCreateDataFromPixmap
+	     XReadPixmapFile		 XpmReadPixmapFile
+	     XWritePixmapFile		 XpmWritePixmapFile
+	     XFreeXpmAttributes		 XpmFreeAttributes
+
+	     PixmapColorError		 XpmPixmapColorError
+	     PixmapSuccess		 XpmPixmapSuccess
+	     PixmapOpenFailed		 XpmPixmapOpenFailed
+	     PixmapFileInvalid		 XpmPixmapFileInvalid
+	     PixmapNoMemory		 XpmPixmapNoMemory
+	     PixmapColorFailed		 XpmPixmapColorFailed
+
+	     ColorSymbol		 XpmColorSymbol
+
+	Generally speaking every public name begins with 'Xpm' and every
+	private one with 'xpm'. This should avoid any possible conflict.
+
+	Some files have also be renamed accordingly.
+
+    NEW FEATURES:
+	- support for VMS and two new options for sxpm: icon and hints (see
+	manual for details) Richard Hess <rhess%pleione%cimshop@uunet.UU.NET>
+	- DEFINES in Imakefile and Makefile.noXtree allows you to set the
+	following:
+
+	    	 ZPIPE for un/compressing piped feature (default is on)
+		 NEED_STRCASECMP for system which doesn't provide one (default
+				 is off)
+
+	- xpmtoppm.c has is own strstr function which is used if NEED_STRSTR
+	is defined when compiling - Hugues.Leroy@irisa.fr (Hugues Leroy).
+	
+    BUGS CORRECTED:
+	- many bugs have been fixed, especially for ansi compilers -
+	       Doyle C. Davidson (doyle@doyled.b23b.ingr.com) and
+	       Clifford D. Morrison (cdm%bigdaddy%edsr@uunet.UU.NET)
+	- parser is again a little more improved
+
+3.0b		(91/09/12)
+
+	This is a complete new version with a new API and where files and
+	structures have been renamed. So this should be taken as a new
+	starting release.
+	This release should be quickly followed by the 3.0 because I'm planning
+	to send it for X11R5 contrib which ends October 5th.
+
+    NEW FEATURES:
+	- support for transparent color.
+	- support for hotspot.
+	- a new function: XCreateDataFromPixmap to create an XPM data from a
+	pixmap in order to be able to create a new pixmap from this data using
+	the XCreatePixmapFromData function later on.
+	- a new structure: XpmAttributes which replace the XpmInfo structure
+	and which leads to a much simpler API with less arguments.
+	- arguments such as visual, colormap and depth are optionnal, default
+	values are taken if omitted.
+	- parsing and allocating color failures don't simply break anymore. If
+	another default color can be found it is used and a PixmapColorError
+	is returned. In case no color can be found then it breaks and returns
+	PixmapColorFailed.
+	- for this reason the ErrorStatus codes are redefined as follows:
+
+		   null     if full success
+		   positive if partial success
+		   negative if failure
+
+	with:
+		#define PixmapColorError    1
+		#define PixmapSuccess       0
+		#define PixmapOpenFailed   -1
+		#define PixmapFileInvalid  -2
+		#define PixmapNoMemory     -3
+		#define PixmapColorFailed  -4
+
+	- sxpm prints out a warning when a requested color could not be parsed
+	or alloc'ed, and an error when none has been found.
+	- sxpm handles pixmap with transparent color. For this purpose the
+	plaid_mask.xpm is added to the distribution.
+
+    BUGS CORRECTED:
+	- I've again improved the memory management.
+	- the parser is also improved.
+	- when writting a pixmap to a file the variable name could be
+	"plaid.xpm" which is not valid in C. Now the extension name is cut off
+	to give "plaid" as variable name.
+	- reading multiple words colornames such as "peach puff" where leading
+	to non readable Xpm files. They are now skipped to have only single
+	word colorname. Lionel Mallet (mallet@ipvpel.unipv.it).
+	- parser was triggered by the "/" character inside string.
+	Doyle C. Davidson (doyle@doyled.b23b.ingr.com). This is corrected.
+	- sxpm maps the window only if the option "-nod" is not selected. 
+
+    CHANGES TO THE DOC:
+	- the documentation presents the new API and features.
+
+3.0a		(91/04/10)
+
+	This is an alpha version because it supports the new version of XPM,
+	but the library interface is still the same. Indeed it will change in
+	future release to get rid of obsolete stuff such as the type argument
+	of the XWritePixmapFile function.
+
+    ******************************* WARNING *********************************
+	The format is not anymore XPM2, it is XPM version 3 which is XPM2
+	limited to the C syntax with the key word "XPM" in place of "XPM2 C".
+	The interface library has not changed yet but the type argument of
+	XWritePixmapFile and the type member of XpmInfo are not used anymore.
+	Meanwhile the library which is now called libXpm.a is backward
+	compatible as XPM2 files can be read. But the XWritePixmapFile
+	function only writes out XPM version 3 files.
+    *************************************************************************
+
+    NEW FEATURES:
+	- the library doesn't use global variables anymore, thus it should be
+	able to share it.
+	- sxpm has been rewritten on top of Xt, it can be used to convert
+	files from XPM2 to XPM version 3.
+	- xpm1to2c.perl has been upgraded to the new XPM version and renamed
+	as xpm1to3.perl
+	- ppmtoxpm2.c and ppmtoxpm2.1 have been upgraded too and renamed
+	ppmtoxpm.c and ppmtoxpm.1. In addition the xpmtoppm.c and xpmtoppm.1
+	of the pbmplus package have been upgraded too. xpmtoppm can thus
+	convert XPM version 1 and 3 to a portable pixmap. These files should
+	replace the original ones which are part of the pbmplus package. See
+	the ppm.README file for more details.
+	- the library contains RCS variables which allows you to get revision
+	numbers with ident (which is part of the RCS package). The Id number
+	is an internal rcs number for my eyes only. The official one is found
+	in Version.
+
+    BUGS CORRECTED:
+	- the memory management has been much improved in order to avoid
+	memory leaks.
+	- the XImage building algorythm has been changed to support correctly
+	different visual depths. There is special code to handle depths 1, 4,
+	6, 8, 24, and 32 to build the image and send it in one whack, and
+	other depths are supported by building the image with XPutPixel which
+	is slow but sure.
+	- similar algorithms are used to read pixmaps and write them out.
+
+    CHANGES TO THE DOC:
+	- the documentation presents the new XPM format.
+
+
+2.8		(90/12/19)
+
+    ******************************* WARNING *********************************
+        Since the last release two structures have been modified and have now
+	bigger sizes, so ANY CODE USING THE libXPM2 NEEDS TO BE RECOMPILED.
+    *************************************************************************
+
+    NEW FEATURES:
+	- the ColorSymbol struct contains the new member 'pixel' which allow
+	to override default colors by giving a pixel value (in such a case
+	symbol value must be set to NULL),
+	- the XpmInfo struct contains the new member 'rgb_fname' in which one
+	can specify an rgb text file name while writing a pixmap with the 
+	XWritePixmapFile function (otherwise this member should be set to
+	NULL). This way colorname will be searched and written out if found
+	instead of the RGB value,
+	- Imakefile originally provided by stolcke@ICSI.Berkeley.EDU,
+	- the old Makefile is now distributed as Makefile.noXtree and presents
+	install targets,
+	- the demo application is renamed sxpm (Show XPM), creates a window of
+	the size of the pixmap if no geometry is specified, prints out
+	messages instead of status when an error occurs, handles the new
+	option -p for overriding colors by giving a pixel value (not really
+	useful but is just here to show this new feature), handles the new
+	option -rgb for specifying an rgb text file, and ends on
+	keypress as buttonpress,
+	- defines for SYSV have been provided by Paul Breslaw
+	<paul@mecazh.uucp>,
+	- the distribution includes a new directory called converters which
+	contains xpm1to2 and xpm1to2c perl converters and a ppmtoxpm2
+	converter provided by Paul Breslaw who upgraded the original ppmtoxpm
+	written by Mark W. Snitily <mark@zok.uucp>.
+
+    CHANGES TO THE DOC:
+	- this file is created and will give old users a quick reference to
+	changes made from one release to the next one,
+	- documentation is changed to present the new ColorSymbol structure
+	and the way to override colors by giving a pixel value, and to present
+	the new XpmInfo structure and how to use it,
+	- a man page for sxpm is added to the distrib,
+	- the README file talks about sxpm and no more demo, and have
+	reference to the different converters.
+
+2.7		(90/11/12)
+
+    NEW FEATURES:
+	- XReadPixmapFile reads from stdin if filename is NULL,
+	- XWritePixmapFile writes to stdin if filename is NULL,
+	- the demo application handles the new option -nod for no displaying
+	the pixmap in a window (useful when used as converter).
+
+    CHANGES TO THE DOC:
+	- documentation about the new feature.
+
+2.6		(90/10/29)
+
+    NEW FEATURES:
+	- from nazgul@alphalpha.com (Kee Hinckley): changes to make the
+	library usable as C++ code, and on Apollo without any warning.
+
+    BUGS CORRECTED:
+	- from nazgul@alphalpha.com (Kee Hinckley): the xpm include files was
+	declaring XWritePixmapFile as taking in arg a Pixmap pointer instead
+	of a Pixmap.
+
+2.5		(90/10/17)
+
+    BUGS CORRECTED:
+	- XWritePixmapFile was not closing the file while ending normaly.
+
+2.4		(90/09/06)
+
+    NEW FEATURES:
+	- XReadPixmapFile reads from a piped uncompress if the given filename
+	ends by .Z or if filename.Z exists,
+	- XWritePixmapFile writes to a piped compress if the given filename
+	ends by .Z.
+
+    BUGS CORRECTED:
+	- demo now deals with window manager.
+
+    CHANGES TO THE DOC:
+	- documentation about compressed files management.
+
+2.3		(90/08/30)
+
+    BUGS CORRECTED:
+	- handle monochrom display correctly,
+	- comments can be empty.
+
+2.2		(90/08/27)
+
+    BUGS CORRECTED:
+	- when reading some invalid free was dumping core on some machine.
+
+2.1		(90/08/24)
+
+    First distribution of XPM2.
+
diff --git a/src/xpm/doc/COPYRIGHT b/src/xpm/doc/COPYRIGHT
new file mode 100644
index 0000000..951b7c3
--- /dev/null
+++ b/src/xpm/doc/COPYRIGHT
@@ -0,0 +1,30 @@
+/*
+ * Copyright 1990-92 GROUPE BULL
+ *
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that the above copyright notice appear in all copies and that both that
+ * copyright notice and this permission notice appear in supporting
+ * documentation, and that the name of GROUPE BULL not be used in advertising
+ * or publicity pertaining to distribution of the software without specific,
+ * written prior permission.  GROUPE BULL makes no representations about the
+ * suitability of this software for any purpose.  It is provided "as is"
+ * without express or implied warranty.
+ *
+ * GROUPE BULL disclaims all warranties with regard to this software,
+ * including all implied warranties of merchantability and fitness,
+ * in no event shall GROUPE BULL be liable for any special,
+ * indirect or consequential damages or any damages
+ * whatsoever resulting from loss of use, data or profits,
+ * whether in an action of contract, negligence or other tortious
+ * action, arising out of or in connection with the use 
+ * or performance of this software.
+ *
+ */
+
+Arnaud LE HORS      BULL Research FRANCE -- Koala Project 
+                    (XPM - X PixMap format version 2 & 3)
+    Internet:       lehors@sophia.inria.fr
+Surface Mail:       Arnaud LE HORS, INRIA - Sophia Antipolis, 
+                    2004, route des Lucioles, 06565 Valbonne Cedex -- FRANCE
+ Voice phone:       (33) 93.65.77.71, Fax: (33) 93 65 77 66, Telex: 97 00 50 F
diff --git a/src/xpm/doc/FILES b/src/xpm/doc/FILES
new file mode 100644
index 0000000..1538e04
--- /dev/null
+++ b/src/xpm/doc/FILES
@@ -0,0 +1,42 @@
+CHANGES
+COPYRIGHT
+FILES
+Imakefile
+Makefile
+Makefile.noXtree
+README
+XpmCrDataFP.c
+XpmCrPFData.c
+XpmRdFToP.c
+XpmWrFFrP.c
+XpmCrDataFI.c
+XpmCrIFData.c
+XpmRdFToI.c
+XpmWrFFrI.c
+XpmRdFToData.c
+XpmWrFFrData.c
+colas.sty
+create.c
+data.c
+hashtable.c
+misc.c
+parse.c
+plaid.xpm
+plaid_mask.xpm
+rgb.c
+scan.c
+sxpm.c
+sxpm.man
+xpm.h
+xpm.tex
+xpmP.h
+converters
+converters/xpm1to3.pl
+converters/ppmtoxpm.1
+converters/ppmtoxpm.c
+converters/xpmtoppm.1
+converters/xpmtoppm.c
+converters/ppm.README
+rename
+name-3.0b-3.0c
+name-3.0c-3.0
diff --git a/src/xpm/doc/Imakefile b/src/xpm/doc/Imakefile
new file mode 100644
index 0000000..860aec4
--- /dev/null
+++ b/src/xpm/doc/Imakefile
@@ -0,0 +1,59 @@
+# Copyright 1990-92 GROUPE BULL -- See licence conditions in file COPYRIGHT
+#
+# XPM Imakefile - Arnaud LE HORS
+#
+
+
+#if (ProjectX < 5)
+    STD_DEFINES = LibraryDefines
+    CDEBUGFLAGS = LibraryCDebugFlags
+#else
+/* R5 needs another .tmpl file to find these #def's.  This .tmpl file will */
+/* also set STD_DEFINES and CDEBUGFLAGS properly.                          */
+#include <Library.tmpl>
+#endif
+
+       INCLUDES = -I.
+   INSTALLFLAGS = $(INSTINCFLAGS)
+       LINTLIBS = $(LINTXTOLL) $(LINTXLIB) 
+
+#ifdef OsNameDefines
+OS_NAME_DEFINES = OsNameDefines
+#endif
+
+## if your system doesn't provide strcasecmp add -DNEED_STRCASECMP
+## if your system doesn't provide strdup add -DNEED_STRDUP
+## if your system doesn't provide pipe remove -DZPIPE
+DEFINES = -DZPIPE
+
+HEADERS = xpm.h
+  SRCS1 = data.c create.c misc.c rgb.c scan.c parse.c \
+	  XpmWrFFrP.c XpmRdFToP.c XpmCrPFData.c XpmCrDataFP.c \
+	  XpmWrFFrI.c XpmRdFToI.c XpmCrIFData.c XpmCrDataFI.c \
+	  hashtable.c XpmRdFToData.c XpmWrFFrData.c
+   SRCS = $(SRCS1) sxpm.c
+  OBJS1 = data.o create.o misc.o rgb.o scan.o parse.o \
+	  XpmWrFFrP.o XpmRdFToP.o XpmCrPFData.o XpmCrDataFP.o \
+	  XpmWrFFrI.o XpmRdFToI.o XpmCrIFData.o XpmCrDataFI.o \
+	  hashtable.o XpmRdFToData.o XpmWrFFrData.o
+   OBJS = sxpm.o
+
+NormalLibraryObjectRule()
+
+NormalLibraryTarget(Xpm,$(OBJS1))
+LintLibraryTarget(Xpm,$(SRCS1))
+InstallLibrary(Xpm,$(USRLIBDIR))
+InstallLintLibrary(Xpm,$(LINTLIBDIR))
+
+InstallMultiple($(HEADERS),$(INCDIR))
+DependTarget()
+NormalLintTarget($(SRCS1))
+
+
+        DEPLIBS = libXpm.a $(DEPXTOOLLIB) $(DEPXLIB)
+LOCAL_LIBRARIES = libXpm.a $(XTOOLLIB) $(XLIB)
+
+ComplexProgramTarget(sxpm)
+
+clean::	
+	$(RM) sxpmout.xpm
diff --git a/src/xpm/doc/Makefile b/src/xpm/doc/Makefile
new file mode 100644
index 0000000..4f08519
--- /dev/null
+++ b/src/xpm/doc/Makefile
@@ -0,0 +1,433 @@
+# Makefile generated by imake - do not edit!
+# $XConsortium: imake.c,v 1.65 91/07/25 17:50:17 rws Exp $
+#
+# The cpp used on this machine replaces all newlines and multiple tabs and
+# spaces in a macro expansion with a single space.  Imake tries to compensate
+# for this, but is not always successful.
+#
+
+# -------------------------------------------------------------------------
+# Makefile generated from "Imake.tmpl" and </tmp/IIf.a10758>
+# $XConsortium: Imake.tmpl,v 1.139 91/09/16 08:52:48 rws Exp $
+#
+# Platform-specific parameters may be set in the appropriate <vendor>.cf
+# configuration files.  Site-specific parameters should be set in the file
+# site.def.  Full rebuilds are recommended if any parameters are changed.
+#
+# If your C preprocessor does not define any unique symbols, you will need
+# to set BOOTSTRAPCFLAGS when rebuilding imake (usually when doing
+# "make World" the first time).
+#
+
+# -------------------------------------------------------------------------
+# site-specific configuration parameters that need to come before
+# the platform-specific parameters - edit site.def to change
+
+# site:  $XConsortium: site.def,v 1.2 91/07/30 20:26:44 rws Exp $
+
+# -------------------------------------------------------------------------
+# platform-specific configuration parameters - edit sun.cf to change
+
+# platform:  $XConsortium: sun.cf,v 1.72.1.1 92/03/18 13:13:37 rws Exp $
+
+# operating system:  SunOS 4.1.1
+
+# $XConsortium: sunLib.rules,v 1.7 91/12/20 11:19:47 rws Exp $
+
+# -------------------------------------------------------------------------
+# site-specific configuration parameters that go after
+# the platform-specific parameters - edit site.def to change
+
+# site:  $XConsortium: site.def,v 1.2 91/07/30 20:26:44 rws Exp $
+
+              TOP = .
+      CURRENT_DIR = .
+
+               AR = ar clq
+  BOOTSTRAPCFLAGS =
+               CC = cc
+               AS = as
+
+         COMPRESS = compress
+              CPP = /lib/cpp $(STD_CPP_DEFINES)
+    PREPROCESSCMD = cc -E $(STD_CPP_DEFINES)
+          INSTALL = install
+               LD = ld
+             LINT = lint
+      LINTLIBFLAG = -C
+         LINTOPTS = -axz
+               LN = ln -s
+               MV = mv
+               CP = cp
+
+           RANLIB = ranlib
+  RANLIBINSTFLAGS =
+
+               RM = rm -f
+            TROFF = ptroff -t
+         MSMACROS = -ms
+              TBL = tbl
+              EQN = eqn
+     STD_INCLUDES =
+  STD_CPP_DEFINES =
+      STD_DEFINES =
+ EXTRA_LOAD_FLAGS =
+  EXTRA_LIBRARIES =
+             TAGS = ctags
+
+    SHAREDCODEDEF = -DSHAREDCODE
+         SHLIBDEF = -DSUNSHLIB
+
+    PROTO_DEFINES =
+
+     INSTPGMFLAGS =
+
+     INSTBINFLAGS = -m 0755
+     INSTUIDFLAGS = -m 4755
+     INSTLIBFLAGS = -m 0644
+     INSTINCFLAGS = -m 0444
+     INSTMANFLAGS = -m 0444
+     INSTDATFLAGS = -m 0444
+    INSTKMEMFLAGS = -g kmem -m 2755
+
+     TOP_INCLUDES = -I$(INCROOT)
+
+      CDEBUGFLAGS = -O
+        CCOPTIONS = -pipe
+
+      ALLINCLUDES = $(INCLUDES) $(EXTRA_INCLUDES) $(TOP_INCLUDES) $(STD_INCLUDES)
+       ALLDEFINES = $(ALLINCLUDES) $(STD_DEFINES) $(EXTRA_DEFINES) $(PROTO_DEFINES) $(DEFINES)
+           CFLAGS = $(CDEBUGFLAGS) $(CCOPTIONS) $(ALLDEFINES)
+        LINTFLAGS = $(LINTOPTS) -DLINT $(ALLDEFINES)
+
+           LDLIBS = $(SYS_LIBRARIES) $(EXTRA_LIBRARIES)
+
+        LDOPTIONS = $(CDEBUGFLAGS) $(CCOPTIONS) $(LOCAL_LDFLAGS) -L$(USRLIBDIR)
+
+   LDCOMBINEFLAGS = -X -r
+      DEPENDFLAGS =
+
+        MACROFILE = sun.cf
+           RM_CMD = $(RM) *.CKP *.ln *.BAK *.bak *.o core errs ,* *~ *.a .emacs_* tags TAGS make.log MakeOut
+
+    IMAKE_DEFINES =
+
+         IRULESRC = $(CONFIGDIR)
+        IMAKE_CMD = $(IMAKE) -DUseInstalled -I$(IRULESRC) $(IMAKE_DEFINES)
+
+     ICONFIGFILES = $(IRULESRC)/Imake.tmpl $(IRULESRC)/Imake.rules \
+			$(IRULESRC)/Project.tmpl $(IRULESRC)/site.def \
+			$(IRULESRC)/$(MACROFILE) $(EXTRA_ICONFIGFILES)
+
+# -------------------------------------------------------------------------
+# X Window System Build Parameters
+# $XConsortium: Project.tmpl,v 1.138.1.1 92/11/11 09:49:19 rws Exp $
+
+# -------------------------------------------------------------------------
+# X Window System make variables; this need to be coordinated with rules
+
+          PATHSEP = /
+        USRLIBDIR = /usr/lib/X11R5
+           BINDIR = /usr/bin/X11R5
+          INCROOT = /usr/include/X11R5
+     BUILDINCROOT = $(TOP)
+      BUILDINCDIR = $(BUILDINCROOT)/X11
+      BUILDINCTOP = ..
+           INCDIR = $(INCROOT)/X11
+           ADMDIR = /usr/adm
+           LIBDIR = /usr/lib/X11R5
+        CONFIGDIR = $(LIBDIR)/config
+       LINTLIBDIR = $(USRLIBDIR)/lint
+
+          FONTDIR = $(LIBDIR)/fonts
+         XINITDIR = $(LIBDIR)/xinit
+           XDMDIR = $(LIBDIR)/xdm
+           TWMDIR = $(LIBDIR)/twm
+          MANPATH = /usr/man
+    MANSOURCEPATH = $(MANPATH)/man
+        MANSUFFIX = n
+     LIBMANSUFFIX = 3
+           MANDIR = $(MANSOURCEPATH)$(MANSUFFIX)
+        LIBMANDIR = $(MANSOURCEPATH)$(LIBMANSUFFIX)
+           NLSDIR = $(LIBDIR)/nls
+        PEXAPIDIR = $(LIBDIR)/PEX
+      XAPPLOADDIR = $(LIBDIR)/app-defaults
+       FONTCFLAGS = -t
+
+     INSTAPPFLAGS = $(INSTDATFLAGS)
+
+            IMAKE = imake
+           DEPEND = makedepend
+              RGB = rgb
+
+            FONTC = bdftopcf
+
+        MKFONTDIR = mkfontdir
+        MKDIRHIER = /bin/sh $(BINDIR)/mkdirhier
+
+        CONFIGSRC = $(TOP)/config
+       DOCUTILSRC = $(TOP)/doc/util
+        CLIENTSRC = $(TOP)/clients
+          DEMOSRC = $(TOP)/demos
+           LIBSRC = $(TOP)/lib
+          FONTSRC = $(TOP)/fonts
+       INCLUDESRC = $(TOP)/X11
+        SERVERSRC = $(TOP)/server
+          UTILSRC = $(TOP)/util
+        SCRIPTSRC = $(UTILSRC)/scripts
+       EXAMPLESRC = $(TOP)/examples
+       CONTRIBSRC = $(TOP)/../contrib
+           DOCSRC = $(TOP)/doc
+           RGBSRC = $(TOP)/rgb
+        DEPENDSRC = $(UTILSRC)/makedepend
+         IMAKESRC = $(CONFIGSRC)
+         XAUTHSRC = $(LIBSRC)/Xau
+          XLIBSRC = $(LIBSRC)/X
+           XMUSRC = $(LIBSRC)/Xmu
+       TOOLKITSRC = $(LIBSRC)/Xt
+       AWIDGETSRC = $(LIBSRC)/Xaw
+       OLDXLIBSRC = $(LIBSRC)/oldX
+      XDMCPLIBSRC = $(LIBSRC)/Xdmcp
+      BDFTOSNFSRC = $(FONTSRC)/bdftosnf
+      BDFTOSNFSRC = $(FONTSRC)/clients/bdftosnf
+      BDFTOPCFSRC = $(FONTSRC)/clients/bdftopcf
+     MKFONTDIRSRC = $(FONTSRC)/clients/mkfontdir
+         FSLIBSRC = $(FONTSRC)/lib/fs
+    FONTSERVERSRC = $(FONTSRC)/server
+     EXTENSIONSRC = $(TOP)/extensions
+         XILIBSRC = $(EXTENSIONSRC)/lib/xinput
+        PEXLIBSRC = $(EXTENSIONSRC)/lib/PEXlib
+      PHIGSLIBSRC = $(EXTENSIONSRC)/lib/PEX
+
+# $XConsortium: sunLib.tmpl,v 1.14.1.2 92/11/11 09:55:02 rws Exp $
+
+SHLIBLDFLAGS = -assert pure-text
+PICFLAGS = -pic
+
+  DEPEXTENSIONLIB =
+     EXTENSIONLIB = -lXext
+
+          DEPXLIB = $(DEPEXTENSIONLIB)
+             XLIB = $(EXTENSIONLIB) -lX11
+
+        DEPXMULIB = $(USRLIBDIR)/libXmu.sa.$(SOXMUREV)
+       XMULIBONLY = -lXmu
+           XMULIB = -lXmu
+
+       DEPOLDXLIB =
+          OLDXLIB = -loldX
+
+      DEPXTOOLLIB = $(USRLIBDIR)/libXt.sa.$(SOXTREV)
+         XTOOLLIB = -lXt
+
+        DEPXAWLIB = $(USRLIBDIR)/libXaw.sa.$(SOXAWREV)
+           XAWLIB = -lXaw
+
+        DEPXILIB =
+           XILIB = -lXi
+
+        DEPPEXLIB =
+           PEXLIB = -lPEX5
+
+        SOXLIBREV = 4.10
+          SOXTREV = 4.10
+         SOXAWREV = 5.0
+        SOOLDXREV = 4.10
+         SOXMUREV = 4.10
+        SOXEXTREV = 4.10
+      SOXINPUTREV = 4.10
+         SOPEXREV = 1.0
+
+      DEPXAUTHLIB = $(USRLIBDIR)/libXau.a
+         XAUTHLIB =  -lXau
+      DEPXDMCPLIB = $(USRLIBDIR)/libXdmcp.a
+         XDMCPLIB =  -lXdmcp
+
+        DEPPHIGSLIB = $(USRLIBDIR)/libphigs.a
+           PHIGSLIB =  -lphigs
+
+       DEPXBSDLIB = $(USRLIBDIR)/libXbsd.a
+          XBSDLIB =  -lXbsd
+
+ LINTEXTENSIONLIB = $(LINTLIBDIR)/llib-lXext.ln
+         LINTXLIB = $(LINTLIBDIR)/llib-lX11.ln
+          LINTXMU = $(LINTLIBDIR)/llib-lXmu.ln
+        LINTXTOOL = $(LINTLIBDIR)/llib-lXt.ln
+          LINTXAW = $(LINTLIBDIR)/llib-lXaw.ln
+           LINTXI = $(LINTLIBDIR)/llib-lXi.ln
+          LINTPEX = $(LINTLIBDIR)/llib-lPEX5.ln
+        LINTPHIGS = $(LINTLIBDIR)/llib-lphigs.ln
+
+          DEPLIBS = $(DEPXAWLIB) $(DEPXMULIB) $(DEPXTOOLLIB) $(DEPXLIB)
+
+         DEPLIBS1 = $(DEPLIBS)
+         DEPLIBS2 = $(DEPLIBS)
+         DEPLIBS3 = $(DEPLIBS)
+
+# -------------------------------------------------------------------------
+# Imake rules for building libraries, programs, scripts, and data files
+# rules:  $XConsortium: Imake.rules,v 1.123 91/09/16 20:12:16 rws Exp $
+
+# -------------------------------------------------------------------------
+# start of Imakefile
+
+# Copyright 1990-92 GROUPE BULL -- See licence conditions in file COPYRIGHT
+#
+# XPM Imakefile - Arnaud LE HORS
+#
+
+# $XConsortium: Library.tmpl,v 1.12 92/03/20 15:05:19 rws Exp $
+
+         CC = cc
+  CCOPTIONS =
+STD_DEFINES =
+CDEBUGFLAGS = -O
+
+       INCLUDES = -I.
+   INSTALLFLAGS = $(INSTINCFLAGS)
+       LINTLIBS = $(LINTXTOLL) $(LINTXLIB)
+
+OS_NAME_DEFINES =
+
+## if your system doesn't provide strcasecmp add -DNEED_STRCASECMP
+## if your system doesn't provide strdup add -DNEED_STRDUP
+## if your system doesn't provide pipe remove -DZPIPE
+DEFINES = -DZPIPE
+
+HEADERS = xpm.h
+  SRCS1 = data.c create.c misc.c rgb.c scan.c parse.c \
+	  XpmWrFFrP.c XpmRdFToP.c XpmCrPFData.c XpmCrDataFP.c \
+	  XpmWrFFrI.c XpmRdFToI.c XpmCrIFData.c XpmCrDataFI.c \
+	  hashtable.c XpmRdFToData.c XpmWrFFrData.c
+   SRCS = $(SRCS1) sxpm.c
+  OBJS1 = data.o create.o misc.o rgb.o scan.o parse.o \
+	  XpmWrFFrP.o XpmRdFToP.o XpmCrPFData.o XpmCrDataFP.o \
+	  XpmWrFFrI.o XpmRdFToI.o XpmCrIFData.o XpmCrDataFI.o \
+	  hashtable.o XpmRdFToData.o XpmWrFFrData.o
+   OBJS = sxpm.o
+
+.c.o:
+	$(RM) $@
+	$(CC) -c $(CFLAGS) $(_NOOP_) $*.c
+
+all:: libXpm.a
+
+libXpm.a: $(OBJS1)
+	$(RM) $@
+	$(AR) $@ $(OBJS1)
+	$(RANLIB) $@
+
+lintlib:: llib-lXpm.ln
+
+llib-lXpm.ln: $(SRCS1)
+	$(RM) $@
+	$(LINT) $(LINTLIBFLAG)Xpm $(LINTFLAGS) $(SRCS1)
+
+install:: libXpm.a
+	@if [ -d $(DESTDIR)$(USRLIBDIR) ]; then set +x; \
+	else (set -x; $(MKDIRHIER) $(DESTDIR)$(USRLIBDIR)); fi
+	$(INSTALL) -c $(INSTLIBFLAGS) libXpm.a $(DESTDIR)$(USRLIBDIR)
+	$(RANLIB) $(RANLIBINSTFLAGS) $(DESTDIR)$(USRLIBDIR)/libXpm.a
+
+install.ln:: llib-lXpm.ln
+	@if [ -d $(DESTDIR)$(LINTLIBDIR) ]; then set +x; \
+	else (set -x; $(MKDIRHIER) $(DESTDIR)$(LINTLIBDIR)); fi
+	$(INSTALL) -c $(INSTLIBFLAGS) llib-lXpm.ln $(DESTDIR)$(LINTLIBDIR)
+
+install:: $(HEADERS)
+	@if [ -d $(DESTDIR)$(INCDIR) ]; then set +x; \
+	else (set -x; $(MKDIRHIER) $(DESTDIR)$(INCDIR)); fi
+	@case '${MFLAGS}' in *[i]*) set +e;; esac; \
+	for i in $(HEADERS); do \
+	(set -x; $(INSTALL) -c $(INSTALLFLAGS) $$i $(DESTDIR)$(INCDIR)); \
+	done
+
+depend::
+	$(DEPEND) $(DEPENDFLAGS) -s "# DO NOT DELETE" -- $(ALLDEFINES) -- $(SRCS)
+
+lint:
+	$(LINT) $(LINTFLAGS) $(SRCS1) $(LINTLIBS)
+lint1:
+	$(LINT) $(LINTFLAGS) $(FILE) $(LINTLIBS)
+
+        DEPLIBS = libXpm.a $(DEPXTOOLLIB) $(DEPXLIB)
+LOCAL_LIBRARIES = libXpm.a $(XTOOLLIB) $(XLIB)
+
+ PROGRAM = sxpm
+
+all:: sxpm
+
+sxpm: $(OBJS) $(DEPLIBS)
+	$(RM) $@
+	$(CC) -o $@ $(OBJS) $(LDOPTIONS) $(LOCAL_LIBRARIES) $(LDLIBS) $(EXTRA_LOAD_FLAGS)
+
+saber_sxpm:: $(SRCS)
+	# load $(ALLDEFINES) $(SRCS) $(LOCAL_LIBRARIES) $(SYS_LIBRARIES) $(EXTRA_LIBRARIES)
+
+osaber_sxpm:: $(OBJS)
+	# load $(ALLDEFINES) $(OBJS) $(LOCAL_LIBRARIES) $(SYS_LIBRARIES) $(EXTRA_LIBRARIES)
+
+install:: sxpm
+	@if [ -d $(DESTDIR)$(BINDIR) ]; then set +x; \
+	else (set -x; $(MKDIRHIER) $(DESTDIR)$(BINDIR)); fi
+	$(INSTALL) -c $(INSTPGMFLAGS)  sxpm $(DESTDIR)$(BINDIR)
+
+install.man:: sxpm.man
+	@if [ -d $(DESTDIR)$(MANDIR) ]; then set +x; \
+	else (set -x; $(MKDIRHIER) $(DESTDIR)$(MANDIR)); fi
+	$(INSTALL) -c $(INSTMANFLAGS) sxpm.man $(DESTDIR)$(MANDIR)/sxpm.$(MANSUFFIX)
+
+depend::
+	$(DEPEND) $(DEPENDFLAGS) -s "# DO NOT DELETE" -- $(ALLDEFINES) -- $(SRCS)
+
+lint:
+	$(LINT) $(LINTFLAGS) $(SRCS) $(LINTLIBS)
+lint1:
+	$(LINT) $(LINTFLAGS) $(FILE) $(LINTLIBS)
+
+clean::
+	$(RM) $(PROGRAM)
+
+clean::
+	$(RM) sxpmout.xpm
+
+# -------------------------------------------------------------------------
+# common rules for all Makefiles - do not edit
+
+emptyrule::
+
+clean::
+	$(RM_CMD) "#"*
+
+Makefile::
+	-@if [ -f Makefile ]; then set -x; \
+	$(RM) Makefile.bak; $(MV) Makefile Makefile.bak; \
+	else exit 0; fi
+	$(IMAKE_CMD) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT_DIR)
+
+tags::
+	$(TAGS) -w *.[ch]
+	$(TAGS) -xw *.[ch] > TAGS
+
+saber:
+	# load $(ALLDEFINES) $(SRCS)
+
+osaber:
+	# load $(ALLDEFINES) $(OBJS)
+
+# -------------------------------------------------------------------------
+# empty rules for directories that do not have SUBDIRS - do not edit
+
+install::
+	@echo "install in $(CURRENT_DIR) done"
+
+install.man::
+	@echo "install.man in $(CURRENT_DIR) done"
+
+Makefiles::
+
+includes::
+
+# -------------------------------------------------------------------------
+# dependencies generated by makedepend
+
diff --git a/src/xpm/doc/Makefile.noXtree b/src/xpm/doc/Makefile.noXtree
new file mode 100644
index 0000000..1119883
--- /dev/null
+++ b/src/xpm/doc/Makefile.noXtree
@@ -0,0 +1,85 @@
+# Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT
+#
+# XPM Makefile - Arnaud LE HORS
+#
+
+AR = ar r
+CC = cc
+RANLIB = ranlib
+RM = rm -f
+# on sysV, define this as cp.
+INSTALL = install -c
+
+DVIPS = dvips
+
+CDEBUGFLAGS= -O
+
+# if your system doesn't provide strcasecmp add -DNEED_STRCASECMP
+# if your system doesn't provide strdup add -DNEED_STRDUP
+# if your system doesn't provide pipe remove -DZPIPE
+DEFINES = -DZPIPE
+
+DESTBINDIR=/usr/local/bin/X11
+DESTLIBDIR=/usr/local/lib/X11
+DESTINCLUDEDIR=$(DESTLIBDIR)/xpm-include
+MANDIR=/usr/man/manl
+
+LIBDIRS= -L/usr/lib/X11 -L.
+LIBS= -lXpm -lXext -lXt -lX11
+OBJS= data.o create.o misc.o rgb.o scan.o parse.o hashtable.o \
+      XpmWrFFrP.o XpmRdFToP.o XpmCrPFData.o XpmCrDataFP.o \
+      XpmWrFFrI.o XpmRdFToI.o XpmCrIFData.o XpmCrDataFI.o \
+      XpmRdFToData.o XpmWrFFrData.o
+
+CFLAGS= $(CDEBUGFLAGS) $(DEFINES)
+
+all: sxpm
+
+clean: 
+	$(RM) *.o sxpm libXpm.a
+
+sxpm: libXpm.a sxpm.o
+	$(CC) $(CFLAGS) sxpm.o $(LIBDIRS) $(LIBS) -o sxpm
+
+libXpm.a: $(OBJS)
+	$(AR) libXpm.a $(OBJS)
+	$(RANLIB) libXpm.a
+
+install: install.lib install.sxpm install.man
+
+install.lib:
+	$(INSTALL) -m 0664 libXpm.a $(DESTLIBDIR)
+	cd $(DESTLIBDIR); $(RANLIB) libXpm.a
+	-mkdir $(DESTINCLUDEDIR)
+	-chmod ugo+rx $(DESTINCLUDEDIR)
+	$(INSTALL) -m 0444 xpm.h $(DESTINCLUDEDIR)
+
+install.sxpm:
+	$(INSTALL) -m 0755 sxpm $(DESTBINDIR)
+
+install.man:
+	$(INSTALL) -m 0644 sxpm.man $(MANDIR)/sxpm.l
+
+doc:	xpm.ps
+
+xpm.ps:	xpm.dvi
+	$(DVIPS) -o xpm.ps xpm
+
+xpm.dvi: xpm.tex
+	latex xpm
+	latex xpm
+
+print:	xpm.ps
+	lpr xpm.ps
+
+# Other dependencies.
+scan.o:	     xpmP.h
+parse.o:     xpmP.h
+data.o:      xpmP.h
+create.o:    xpmP.h
+free.o:	     xpmP.h
+rgb.o:	     xpmP.h
+XpmWrPixF.o:   xpmP.h
+XpmRdPixF.o:   xpmP.h
+XpmCrPFData.o: xpmP.h
+sxpm.o:	     xpm.h
diff --git a/src/xpm/doc/README b/src/xpm/doc/README
new file mode 100644
index 0000000..0807f5a
--- /dev/null
+++ b/src/xpm/doc/README
@@ -0,0 +1,176 @@
+** Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT **
+
+				XPM Version 3
+
+WHAT IS XPM?
+============
+
+XPM (X PixMap) is a format for storing/retrieving X pixmaps to/from files.
+
+Here is provided a library containing a set of four functions, similar to the
+X bitmap functions as defined in the Xlib: XpmCreatePixmapFromData,
+XpmCreateDataFromPixmap, XpmReadFileToPixmap and XpmWriteFileFromPixmap for
+respectively including, storing, reading and writing this format, plus four
+other: XpmCreateImageFromData, XpmCreateDataFromImage, XpmReadFileToImage and
+XpmWriteFileFromImage for working with images instead of pixmaps.
+
+This new version provides a C includable format, defaults for different types
+of display: monochrome/color/grayscale, hotspot coordinates and symbol names
+for colors for overriding default colors when creating the pixmap. It provides
+a mechanism for storing information while reading a file which is re-used
+while writing. This way comments, default colors and symbol names aren't lost.
+It also handles "transparent pixels" by returning a shape mask in addition to
+the created pixmap.
+
+See the XPM Manual for more details.
+
+HOW TO GET XPM?
+===============
+
+New xpm updates are announced on the comp.windows.x newsgroup, and on the
+"xpm-talk" list. All new "official" xpm releases can be found by ftp on:
+
+    export.lcs.mit.edu (18.30.0.238) contrib	 (Boston, USA)
+    avahi.inria.fr     (192.5.60.47) pub	 (Sophia Antipolis, France)
+
+
+DOCUMENTATION:
+=============
+
+Old users might read the CHANGES file for a history of changes interesting
+the user.
+
+Read the docs (xpm.tex is the manual in LaTeX form). The documentation is in
+LaTeX format (IMPORTANT: see the Makefile to know how to print it. The LaTeX
+source should work with most dvi2ps or dvips programs. I use myself Tomas
+Rokicki's dvips v5.0 that you can get by anonymous ftp on
+labrea.stanford.edu).  We can mail you a PostScript version of the
+documentation if you are not able to print it, or you can grab one on the ftp
+servers.
+
+INSTALLATION:
+============
+
+To obtain the XPM library, first uncompress and untar the compressed tar file
+in an approriate directory.
+
+Then you can either compile xpm via "imake" or in a stand-alone way.
+
+WITH IMAKE:
+
+	The Imakefile is provided. You should know how to use imake to build 
+	the XPM Makefile, by executing "xmkmf" then do:
+
+		make depend
+		make
+
+	which will build the XPM library and sxpm application. 
+	Then do:
+
+	     	make install
+		make install.man
+
+	which will install the library and the sxpm man page.
+
+	If it fails, you may edit the Imakefile to add compilation flags to
+	suit your machine.
+
+WITHOUT IMAKE:
+
+	To compile xpm, in the xpm directory you just created, do:
+
+	        make -f Makefile.noXtree
+
+	Then to install it, do:
+
+		make -f Makefile.noXtree install
+
+NOTE:   if you compile  with gcc, use "gcc -traditional", otherwise you will
+        have compilation warnings (but the code will work Ok)
+
+SXPM:
+====
+
+In addition to the library the sxpm tool is provided to show XPM file and
+convert them from XPM2 to XPM version 3. If you have previously done 'make' or
+'make all' you should have it yet, otherwise just do:
+
+		      make sxpm
+
+This application shows you most of the features of XPM and its source can be
+used to quickly see how to use the provided functions
+
+By executing 'sxpm' without any option you will get the usage.
+
+Executing 'sxpm -plaid' will show a demo of the XpmCreatePixmapFromData
+function. The pixmap is created from the static variable plaid defined in the
+sxpm.c file. Sxpm will end when you press the key Q in the created window.
+
+Executing 'sxpm -plaid -s lines_in_mix blue' will show the feature of
+overriding color symbols giving a colorname, and executing 'sxpm -p
+lines_in_mix 1' will show overriding giving pixel value.
+
+Then you should try 'sxpm -plaid -o output' to get an output file using the
+XpmWriteFileFromPixmap function.
+
+You can now try 'sxpm -plaid -o - -nod -rgb /usr/lib/X11/rgb.txt' to directly
+get the pixmap printed out on the standard output with colornames instead of
+rgb values.
+
+Then you should try 'sxpm plaid.xpm' to use the XpmReadFileToPixmap function,
+and 'cat plaid_mask.xpm|sxpm' to see how "transparent pixels" are handled.
+
+The XpmCreatePixmapFromData function is on purpose called without any Xpminfo 
+pointer to show the utility of this one. Indeed, compare the color section of
+the two files foo and bar obtained from 'sxpm -nod -plaid -o foo' and 
+'sxpm -nod plaid.xpm -o bar'.
+
+To end look at plaid_ext.xpm and try "sxpm -nod plaid_ext.xpm -v" to see how
+extensions are handled.
+
+Of course, other combinations are allowed and should be tried. Thus, 'sxpm
+plaid.xpm -o output -nod' will show you how to convert a file from XPM2 to a
+XPM version 3 using sxpm.
+
+See the manual page for more detail.
+
+CONVERTERS:
+==========
+
+In the converters directory you can find different converters about XPM.
+There is a perl script xpm1to3.pl to convert XPM1 format file to XPM version
+3. And there are files to build the converters ppmtoxpm and xpmtoppm; to get
+instructions about how to build them you should read the corresponding
+ppm.README file.
+
+KNOWN BUG:
+=========
+
+If two symbols get the same color pixel when reading a pixmap, one will be
+lost when writting it out.
+
+DISCUSSION:
+==========
+
+There is a mailing list to discuss about XPM which is xpm-talk@sophia.inria.fr.
+Any request to subscribe should be sent to xpm-talk-request@sophia.inria.fr.
+
+COPYRIGHT:
+==========
+
+  Copyright 1990-92 GROUPE BULL --
+  See license conditions in the COPYRIGHT file of the XPM distribution
+
+Please mail any bug reports or modifications done, comments, suggestions,
+requests for updates or patches to port on another machine to:
+
+lehors@sophia.inria.fr		(INTERNET)
+
+33 (FRANCE) 93.65.77.71		(VOICE PHONE)
+
+Arnaud Le Hors			(SURFACE MAIL)
+Bull c/o Inria BP. 109
+2004, Route des lucioles
+Sophia Antipolis
+06561 Valbonne Cedex
+FRANCE
diff --git a/src/xpm/doc/colas.sty b/src/xpm/doc/colas.sty
new file mode 100644
index 0000000..799e405
--- /dev/null
+++ b/src/xpm/doc/colas.sty
@@ -0,0 +1,294 @@
+% my add-on LaTeX macros
+% to be used like in:
+% \documentstyle[12pt,gwm]{report}
+
+% postscript inclusion:
+\def\texpsfig#1#2#3
+{\vbox{\kern #3pt\hbox{\special{psfile=#1}\kern #2pt}}\typeout{(#1)}}
+
+% RCS version stripping
+\def\RCSRevNum#1Revision: #2 ${#2}
+\def\RCSRevVersion#1Version: #2 ${#2}
+
+\newlength{\colaslength}
+\newlength{\colaslengthh}
+\newlength{\colasmargin}
+
+\def\exemplefont{\footnotesize}
+\def\usagefont{\large}
+\def\usageupspace{\vspace{0.1mm}}
+\newcommand{\Description}
+	{\list{}{\leftmargin 4cm \labelsep 0.1cm \labelwidth 3.9cm}}
+
+\def\descriptionlabel#1{\bf #1\hspace\labelsep\hfil}
+\def\description
+	{\list{}{\leftmargin 2.4cm \labelsep 0.1cm \labelwidth 2.3cm
+	\let\makelabel\descriptionlabel}}
+
+\def\upspace{\vspace{-2mm}}
+\def\undertablespace{\vspace{-3mm}}
+
+\def\Item#1#2{\upspace\pagebreak[1]\section*{\hspace{-7pt}
+	{\large\tt#1}{\normalsize\sf\quad ---\quad #2}}\vspace{-0.3cm}}
+
+\def\ITEMa#1#2{
+ \Item{#1}{#2}\markright{#1}
+ \label{#1}}
+\def\ITEMb#1#2#3{
+ \Item{\vbox{\hbox{#1}\hbox{#2}}}{#3}\markright{#1}
+ \label{#1} \label{#2}}
+\def\ITEMbi#1#2#3{
+ \Item{\vbox{\hbox{#1}\hbox{#2}}}{#3}\markright{#1}
+ \label{#2}}
+\def\ITEMc#1#2#3#4{
+ \Item{\vbox{\hbox{#1}\hbox{#2}\hbox{#3}}}{#4}\markright{#1}
+ \label{#1}\label{#2} \label{#3}}
+\def\ITEMci#1#2#3#4{
+ \Item{\vbox{\hbox{#1}\hbox{#2}\hbox{#3}}}{#4}\markright{#1}
+ \label{#2}\label{#3}}
+\def\ITEMd#1#2#3#4#5{
+ \Item{\vbox{\hbox{#1}\hbox{#2}\hbox{#3}\hbox{#4}}}{#5}\markright{#1}
+ \label{#1}\label{#2}\label{#3}\label{#4}}
+\def\ITEMe#1#2#3#4#5#6{
+ \Item{
+  \vbox{\hbox{#1}\hbox{#2}\hbox{#3}\hbox{#4}\hbox{#5}}}{#6}\markright{#1}
+ \label{#1}\label{#2}\label{#3}\label{#4}\label{#5}}
+\def\ITEMf#1#2#3#4#5#6#7{
+ \Item{
+    \vbox{\hbox{#1}\hbox{#2}\hbox{#3}\hbox{#4}\hbox{#5}\hbox{#6}}}{#7}
+	\markright{#1}
+ \label{#1}\label{#2}\label{#3}\label{#4}\label{#5}\label{#6}}
+
+\newcommand{\context}[1]{
+  Context used:
+    \begin{center}\begin{tabular}{@{\tt}l@{\hspace{1cm}}@{\rm}p{7cm}}
+    \multicolumn{1}{c}{\bf Variable}&\multicolumn{1}{c}{\bf used for}\\ 
+    \hline \multicolumn{2}{l}{\undertablespace}\\
+    #1
+    \end{tabular}\end{center}}
+
+\newcommand{\contextdim}[2]{
+  \setlength{\colaslength}{7cm}
+  \addtolength{\colaslength}{#1}
+  Context used:
+    \begin{center}\begin{tabular}{@{\tt}l@{\hspace{1cm}}@{\rm}p{\colaslength}}
+    \multicolumn{1}{c}{\bf Variable}&\multicolumn{1}{c}{\bf used for}\\ 
+    \hline  \multicolumn{2}{l}{\undertablespace}\\
+    #2
+    \end{tabular}\end{center}}
+
+\newcommand{\desctable}[3]{
+    \begin{center}\begin{tabular}{@{\bf}l@{\hspace{1cm}}@{\rm}p{7cm}}
+    \multicolumn{1}{c}{\bf #1}&\multicolumn{1}{c}{\bf #2}\\ 
+    \hline \multicolumn{2}{l}{\undertablespace}\\
+    #3
+    \end{tabular}\end{center}}
+
+\newcommand{\desctabledim}[4]{
+  \setlength{\colaslength}{7cm}
+  \addtolength{\colaslength}{#1}
+    \begin{center}\begin{tabular}{@{\bf}l@{\hspace{1cm}}@{\rm}p{\colaslength}}
+    \multicolumn{1}{c}{\bf #2}&\multicolumn{1}{c}{\bf #3}\\ 
+    \hline  \multicolumn{2}{l}{\undertablespace}\\
+    #4
+    \end{tabular}\end{center}}
+
+\newcommand{\exemples}[2]{
+  #1{\exemplefont 
+    \begin{center}\begin{tabular}{@{\tt}l@{\hspace{1cm}}@{\rm}p{5cm}}
+    #2
+    \end{tabular}\end{center}}}
+
+\newcommand{\exemplesdim}[3]{
+  \setlength{\colaslength}{5cm}
+  \addtolength{\colaslength}{#1}
+  #2{\exemplefont 
+    \begin{center}\begin{tabular}{@{\tt}l@{\hspace{1cm}}@{\rm}p{\colaslength}}
+    #3
+    \end{tabular}\end{center}}}
+
+\newcommand{\usagetype}[1]{{\sl #1}\vspace{0.2cm}}
+\newcommand{\usagetyped}[2]{{\sl #1}\quad{\it (#2)}\vspace{0.2cm}}
+\newcommand{\see}[1]{{\tt #1}}
+\newcommand{\seep}[1]{{\tt #1}, p~\pageref{#1}}
+\newcommand{\seensp}[1]{{\tt #1} (see p~\pageref{#1})}
+\newcommand{\seesnp}[1]{(see {\tt #1}, p~\pageref{#1})}
+\newcommand{\seeref}[1]{{\tt #1} (see \ref{#1}, p~\pageref{#1})}
+\newcommand{\seesp}[1]{(see \ref{#1}, p~\pageref{#1})}
+
+\def\smalldesc#1#2#3{#1&#3&#2\\}
+\newcommand{\bigdesc}[2]{
+  \setlength{\colaslength}{300pt}
+  \settowidth{\colaslengthh}{{\tt #1}}
+  \addtolength{\colaslength}{-\colaslengthh}
+    \begin{center}\begin{tabular}
+	{@{\tt}l@{\hspace{0.5cm}}@{\sf}p{\colaslength}@{\hspace{0.4cm}}@{\bf}r}
+   \multicolumn{1}{c}{\bf Object}&\multicolumn{1}{c}{\bf Description}&{\bf p}\\
+    \hline \multicolumn{3}{l}{\undertablespace}\\
+    #2
+    \end{tabular}\end{center}}
+
+\newcommand{\desc}[4]{
+  \setlength{\colaslength}{250pt}
+  \settowidth{\colaslengthh}{{\tt #1}}
+  \addtolength{\colaslength}{-\colaslengthh}
+    \begin{center}\begin{tabular}
+{@{\tt}l@{\hspace{0.5cm}}@{\sf}p{\colaslength}}
+    \multicolumn{1}{c}{\bf #2}&\multicolumn{1}{c}{\bf #3}\\
+    \hline \multicolumn{2}{l}{\undertablespace}\\
+    #4
+    \end{tabular}\end{center}}
+
+\newcommand{\contextdimtt}[2]{
+  \setlength{\colaslength}{250pt}
+  \settowidth{\colaslengthh}{{\tt #1}}
+  \addtolength{\colaslength}{-\colaslengthh}
+  Context used:
+    \begin{center}\begin{tabular}{@{\tt}l@{\hspace{1cm}}@{\rm}p{\colaslength}}
+    \multicolumn{1}{c}{\bf Variable}&\multicolumn{1}{c}{\bf used for}\\ 
+    \hline \multicolumn{2}{l}{\undertablespace}\\
+    #2
+    \end{tabular}\end{center}}
+
+\def\itemtt#1{\item[{\tt #1}]}
+\def\itemit#1{\item[{\it #1}]}
+
+
+% SIZE of page
+%=============
+
+\def\fullpage{\if@twoside \oddsidemargin 35pt \evensidemargin -8pt 
+\marginparsep 10pt \marginparpush 10pt \marginparwidth 10pt
+\else \oddsidemargin 0pt \evensidemargin 0pt 
+\marginparwidth 30pt\fi
+\textwidth 450pt \setlength{\colasmargin}{0pt}
+\def\colaspm{\hspace{0pt}}\def\colasmm{\hspace{0pt}}
+\def\colassmm{\hspace{0pt}}\def\colastitledisp{\hspace{0pt}}
+}
+\def\mediumpage{\if@twoside \oddsidemargin 75pt \evensidemargin 32pt 
+\marginparsep 10pt \marginparpush 10pt \marginparwidth 40pt
+\else \oddsidemargin 43pt \evensidemargin 63pt 
+\marginparwidth 30pt\fi
+\textwidth 410pt \setlength{\colasmargin}{0pt}
+\def\colaspm{\hspace{40pt}}\def\colasmm{\hspace{-40pt}}
+\def\colassmm{\hspace{-20pt}}\def\colastitledisp{\hspace{-45pt}}
+}
+\def\smallpage{\if@twoside \oddsidemargin 135pt \evensidemargin 92pt 
+\marginparsep 10pt \marginparpush 10pt \marginparwidth 80pt
+\else \oddsidemargin 123pt \evensidemargin 123pt
+\marginparwidth 30pt \fi
+\textwidth 350pt 
+\setlength{\colasmargin}{100pt}
+\def\colaspm{\hspace{100pt}}\def\colasmm{\hspace{-100pt}}
+\def\colassmm{\hspace{-60pt}}\def\colastitledisp{\hspace{-75pt}}
+}
+
+\smallpage
+\topmargin -30pt \headheight 12pt \headsep 25pt \footheight 12pt \footskip
+30pt 
+\textheight 680pt \columnsep 10pt \columnseprule 0pt 
+\footnotesep 12pt \skip\footins 6pt plus 2pt minus 2pt 
+\floatsep 12pt plus 2pt minus 2pt \textfloatsep 20pt plus 2pt minus 4pt
+\intextsep 12pt plus 2pt minus 2pt \@maxsep 20pt \dblfloatsep 12pt plus 2pt
+minus 2pt \dbltextfloatsep 20pt plus 2pt minus 4pt \@dblmaxsep 20pt 
+\@fptop 0pt plus 1fil \@fpsep 8pt plus 2fil \@fpbot 0pt plus 1fil 
+\@dblfptop 0pt plus 1fil \@dblfpsep 8pt plus 2fil \@dblfpbot 0pt plus 1fil
+
+\parskip 5pt plus 1pt \parindent 0pt \topsep 2pt plus 1pt minus 1pt
+\partopsep 0pt plus 1pt minus 1pt \itemsep 2pt plus 1pt minus 1pt 
+
+\reversemarginpar
+\@mparswitchfalse
+
+%% abbrevs
+
+\def\GWM{\sc Gwm}
+\def\WOOL{\sc Wool}
+
+%% fonts
+\def\Huge{\@setsize\Huge{30pt}\xxvpt\@xxvpt}
+
+%% chapter
+
+\def\@makechapterhead#1{ \vspace*{1pt} { \parindent 0pt \raggedright 
+ \Huge\bf \colasmm
+ \ifnum \c@secnumdepth >\m@ne \thechapter \quad \fi
+ #1\par 
+ \nobreak \vskip 20pt
+ \colasmm{\vbox{\hbox{\vrule height 5pt width450pt depth -3pt}
+ 			\vspace*{-1.1cm}
+ 		       \hbox{\vrule height 0.0pt width450pt depth 0.4pt}}}
+ \nobreak \vskip 50pt \nobreak } }
+
+\def\@makeschapterhead#1{ \vspace*{1pt} { \parindent 0pt \raggedright 
+ \Huge \bf \colasmm #1\par 
+ \nobreak \vskip 80pt } }
+
+\def\chapter{\clearpage \thispagestyle{pagenum} \global\@topnum\z@
+\@afterindentfalse \secdef\@chapter\@schapter} 
+\def\@chapter[#1]#2{\ifnum \c@secnumdepth >\m@ne
+ \refstepcounter{chapter}
+ \typeout{\@chapapp\space\thechapter.}
+ \addcontentsline{toc}{chapter}{\protect
+ \numberline{\thechapter}#1}\else
+ \addcontentsline{toc}{chapter}{#1}\fi
+ \chaptermark{#1}
+ \addtocontents{lof}{\protect\addvspace{10pt}}
+\addtocontents{lot}{\protect\addvspace{10pt}} \if@twocolumn
+\@topnewpage[\@makechapterhead{#2}] 
+ \else \@makechapterhead{#2}
+ \@afterheading \fi} 
+\def\@schapter#1{\if@twocolumn \@topnewpage[\@makeschapterhead{#1}]
+ \else \@makeschapterhead{#1} 
+ \@afterheading\fi}
+
+%% sections
+
+\def\section{\@startsection {section}{1}{\z@}{-3.5ex plus -1ex minus 
+ -.2ex}{2.3ex plus .2ex}{\Large\bf\colasmm}}
+\def\subsection{\@startsection{subsection}{2}{\z@}{-3.25ex plus -1ex minus 
+ -.2ex}{1.5ex plus .2ex}{\large\bf\colassmm}}
+\def\subsubsection{\@startsection{subsubsection}{3}{\z@}{-3.25ex plus
+-1ex minus -.2ex}{1.5ex plus .2ex}{\normalsize\bf}}
+\def\paragraph{\@startsection
+ {paragraph}{4}{\z@}{3.25ex plus 1ex minus .2ex}{-1em}{\normalsize\bf}}
+\def\subparagraph{\@startsection
+ {subparagraph}{4}{\parindent}{3.25ex plus 1ex minus 
+ .2ex}{-1em}{\normalsize\bf}}
+
+%% headings
+
+\if@twoside \def\ps@headings{\def\@oddfoot{}
+\def\@evenfoot{}\def\@evenhead{
+\colasmm\makebox[0pt][l]{\vrule height-4pt width450pt depth4.3pt}
+\bf\thepage\hfill \sl \leftmark}
+\def\@oddhead{
+\colasmm\makebox[0pt][l]{\vrule height-4pt width450pt depth4.3pt}
+\sl \rightmark \hfill\bf\thepage}
+\def\chaptermark##1{\markboth {\uppercase{\ifnum \c@secnumdepth
+>\m@ne
+ \@chapapp\ \thechapter. \ \fi ##1}}{}}\def\sectionmark##1{\markright
+{\uppercase{\ifnum \c@secnumdepth >\z@
+ \thesection. \ \fi ##1}}}}
+\else \def\ps@headings{\def\@oddfoot{}\def\@evenfoot{}\def\@oddhead{\hbox
+{}\sl \rightmark \hfill \rm\thepage}\def\chaptermark##1{\markright
+{\uppercase{\ifnum \c@secnumdepth >\m@ne
+ \@chapapp\ \thechapter. \ \fi ##1}}}}
+\fi
+
+\if@twoside \def\ps@pagenum{\def\@oddfoot{}
+\def\@evenfoot{}\def\@evenhead{
+\colasmm\bf\thepage\hfill}
+\def\@oddhead{
+\colasmm\hfill\bf\thepage}
+\def\chaptermark##1{\markboth {\uppercase{\ifnum \c@secnumdepth
+>\m@ne
+ \@chapapp\ \thechapter. \ \fi ##1}}{}}\def\sectionmark##1{\markright
+{\uppercase{\ifnum \c@secnumdepth >\z@
+ \thesection. \ \fi ##1}}}}
+\else \def\ps@pagenum{\def\@oddfoot{}\def\@evenfoot{}\def\@oddhead{\hbox
+{}\hfil \bf\thepage}\def\chaptermark##1{\markright
+{\uppercase{\ifnum \c@secnumdepth >\m@ne
+ \@chapapp\ \thechapter. \ \fi ##1}}}}
+\fi
+
diff --git a/src/xpm/doc/name-3.0b-3.0c b/src/xpm/doc/name-3.0b-3.0c
new file mode 100644
index 0000000..04c687b
--- /dev/null
+++ b/src/xpm/doc/name-3.0b-3.0c
@@ -0,0 +1,48 @@
+s/^XCreatePixmapFromData$/XpmCreatePixmapFromData/g
+s/^XCreatePixmapFromData\([^a-zA-Z_]\)/XpmCreatePixmapFromData\1/g
+s/\([^a-zA-Z_]\)XCreatePixmapFromData$/\1XpmCreatePixmapFromData/g
+s/\([^a-zA-Z_]\)XCreatePixmapFromData\([^a-zA-Z_]\)/\1XpmCreatePixmapFromData\2/g
+s/^XCreateDataFromPixmap$/XpmCreateDataFromPixmap/g
+s/^XCreateDataFromPixmap\([^a-zA-Z_]\)/XpmCreateDataFromPixmap\1/g
+s/\([^a-zA-Z_]\)XCreateDataFromPixmap$/\1XpmCreateDataFromPixmap/g
+s/\([^a-zA-Z_]\)XCreateDataFromPixmap\([^a-zA-Z_]\)/\1XpmCreateDataFromPixmap\2/g
+s/^XReadPixmapFile$/XpmReadPixmapFile/g
+s/^XReadPixmapFile\([^a-zA-Z_]\)/XpmReadPixmapFile\1/g
+s/\([^a-zA-Z_]\)XReadPixmapFile$/\1XpmReadPixmapFile/g
+s/\([^a-zA-Z_]\)XReadPixmapFile\([^a-zA-Z_]\)/\1XpmReadPixmapFile\2/g
+s/^XWritePixmapFile$/XpmWritePixmapFile/g
+s/^XWritePixmapFile\([^a-zA-Z_]\)/XpmWritePixmapFile\1/g
+s/\([^a-zA-Z_]\)XWritePixmapFile$/\1XpmWritePixmapFile/g
+s/\([^a-zA-Z_]\)XWritePixmapFile\([^a-zA-Z_]\)/\1XpmWritePixmapFile\2/g
+s/^XFreeXpmAttributes$/XpmFreeAttributes/g
+s/^XFreeXpmAttributes\([^a-zA-Z_]\)/XpmFreeAttributes\1/g
+s/\([^a-zA-Z_]\)XFreeXpmAttributes$/\1XpmFreeAttributes/g
+s/\([^a-zA-Z_]\)XFreeXpmAttributes\([^a-zA-Z_]\)/\1XpmFreeAttributes\2/g
+s/^PixmapColorError$/XpmPixmapColorError/g
+s/^PixmapColorError\([^a-zA-Z_]\)/XpmPixmapColorError\1/g
+s/\([^a-zA-Z_]\)PixmapColorError$/\1XpmPixmapColorError/g
+s/\([^a-zA-Z_]\)PixmapColorError\([^a-zA-Z_]\)/\1XpmPixmapColorError\2/g
+s/^PixmapSuccess$/XpmPixmapSuccess/g
+s/^PixmapSuccess\([^a-zA-Z_]\)/XpmPixmapSuccess\1/g
+s/\([^a-zA-Z_]\)PixmapSuccess$/\1XpmPixmapSuccess/g
+s/\([^a-zA-Z_]\)PixmapSuccess\([^a-zA-Z_]\)/\1XpmPixmapSuccess\2/g
+s/^PixmapOpenFailed$/XpmPixmapOpenFailed/g
+s/^PixmapOpenFailed\([^a-zA-Z_]\)/XpmPixmapOpenFailed\1/g
+s/\([^a-zA-Z_]\)PixmapOpenFailed$/\1XpmPixmapOpenFailed/g
+s/\([^a-zA-Z_]\)PixmapOpenFailed\([^a-zA-Z_]\)/\1XpmPixmapOpenFailed\2/g
+s/^PixmapFileInvalid$/XpmPixmapFileInvalid/g
+s/^PixmapFileInvalid\([^a-zA-Z_]\)/XpmPixmapFileInvalid\1/g
+s/\([^a-zA-Z_]\)PixmapFileInvalid$/\1XpmPixmapFileInvalid/g
+s/\([^a-zA-Z_]\)PixmapFileInvalid\([^a-zA-Z_]\)/\1XpmPixmapFileInvalid\2/g
+s/^PixmapNoMemory$/XpmPixmapNoMemory/g
+s/^PixmapNoMemory\([^a-zA-Z_]\)/XpmPixmapNoMemory\1/g
+s/\([^a-zA-Z_]\)PixmapNoMemory$/\1XpmPixmapNoMemory/g
+s/\([^a-zA-Z_]\)PixmapNoMemory\([^a-zA-Z_]\)/\1XpmPixmapNoMemory\2/g
+s/^PixmapColorFailed$/XpmPixmapColorFailed/g
+s/^PixmapColorFailed\([^a-zA-Z_]\)/XpmPixmapColorFailed\1/g
+s/\([^a-zA-Z_]\)PixmapColorFailed$/\1XpmPixmapColorFailed/g
+s/\([^a-zA-Z_]\)PixmapColorFailed\([^a-zA-Z_]\)/\1XpmPixmapColorFailed\2/g
+s/^ColorSymbol$/XpmColorSymbol/g
+s/^ColorSymbol\([^a-zA-Z_]\)/XpmColorSymbol\1/g
+s/\([^a-zA-Z_]\)ColorSymbol$/\1XpmColorSymbol/g
+s/\([^a-zA-Z_]\)ColorSymbol\([^a-zA-Z_]\)/\1XpmColorSymbol\2/g
diff --git a/src/xpm/doc/name-3.0c-3.0 b/src/xpm/doc/name-3.0c-3.0
new file mode 100644
index 0000000..3187d46
--- /dev/null
+++ b/src/xpm/doc/name-3.0c-3.0
@@ -0,0 +1,32 @@
+s/^XpmPixmapColorError$/XpmColorError/g
+s/^XpmPixmapColorError\([^a-zA-Z_]\)/XpmColorError\1/g
+s/\([^a-zA-Z_]\)XpmPixmapColorError$/\1XpmColorError/g
+s/\([^a-zA-Z_]\)XpmPixmapColorError\([^a-zA-Z_]\)/\1XpmColorError\2/g
+s/^XpmPixmapSuccess$/XpmSuccess/g
+s/^XpmPixmapSuccess\([^a-zA-Z_]\)/XpmSuccess\1/g
+s/\([^a-zA-Z_]\)XpmPixmapSuccess$/\1XpmSuccess/g
+s/\([^a-zA-Z_]\)XpmPixmapSuccess\([^a-zA-Z_]\)/\1XpmSuccess\2/g
+s/^XpmPixmapOpenFailed$/XpmOpenFailed/g
+s/^XpmPixmapOpenFailed\([^a-zA-Z_]\)/XpmOpenFailed\1/g
+s/\([^a-zA-Z_]\)XpmPixmapOpenFailed$/\1XpmOpenFailed/g
+s/\([^a-zA-Z_]\)XpmPixmapOpenFailed\([^a-zA-Z_]\)/\1XpmOpenFailed\2/g
+s/^XpmPixmapFileInvalid$/XpmFileInvalid/g
+s/^XpmPixmapFileInvalid\([^a-zA-Z_]\)/XpmFileInvalid\1/g
+s/\([^a-zA-Z_]\)XpmPixmapFileInvalid$/\1XpmFileInvalid/g
+s/\([^a-zA-Z_]\)XpmPixmapFileInvalid\([^a-zA-Z_]\)/\1XpmFileInvalid\2/g
+s/^XpmPixmapNoMemory$/XpmNoMemory/g
+s/^XpmPixmapNoMemory\([^a-zA-Z_]\)/XpmNoMemory\1/g
+s/\([^a-zA-Z_]\)XpmPixmapNoMemory$/\1XpmNoMemory/g
+s/\([^a-zA-Z_]\)XpmPixmapNoMemory\([^a-zA-Z_]\)/\1XpmNoMemory\2/g
+s/^XpmPixmapColorFailed$/XpmColorFailed/g
+s/^XpmPixmapColorFailed\([^a-zA-Z_]\)/XpmColorFailed\1/g
+s/\([^a-zA-Z_]\)XpmPixmapColorFailed$/\1XpmColorFailed/g
+s/\([^a-zA-Z_]\)XpmPixmapColorFailed\([^a-zA-Z_]\)/\1XpmColorFailed\2/g
+s/^XpmReadPixmapFile$/XpmReadFileToPixmap/g
+s/^XpmReadPixmapFile\([^a-zA-Z_]\)/XpmReadFileToPixmap\1/g
+s/\([^a-zA-Z_]\)XpmReadPixmapFile$/\1XpmReadFileToPixmap/g
+s/\([^a-zA-Z_]\)XpmReadPixmapFile\([^a-zA-Z_]\)/\1XpmReadFileToPixmap\2/g
+s/^XpmWritePixmapFile$/XpmWriteFileFromPixmap/g
+s/^XpmWritePixmapFile\([^a-zA-Z_]\)/XpmWriteFileFromPixmap\1/g
+s/\([^a-zA-Z_]\)XpmWritePixmapFile$/\1XpmWriteFileFromPixmap/g
+s/\([^a-zA-Z_]\)XpmWritePixmapFile\([^a-zA-Z_]\)/\1XpmWriteFileFromPixmap\2/g
diff --git a/src/xpm/doc/plaid.xpm b/src/xpm/doc/plaid.xpm
new file mode 100644
index 0000000..b0e9200
--- /dev/null
+++ b/src/xpm/doc/plaid.xpm
@@ -0,0 +1,34 @@
+/* XPM */
+static char * plaid[] = {
+/* plaid pixmap 
+ * width height ncolors chars_per_pixel */
+"22 22 4 2 ",
+/* colors */
+"   c red 	m white  s light_color ",
+"Y  c green	m black  s lines_in_mix ",
+"+  c yellow	m white  s lines_in_dark ",
+"x 		m black  s dark_color ",
+/* pixels */
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"Y Y Y Y Y x Y Y Y Y Y + x + x + x + x + x + ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ",
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x ", 
+"x x x x x x x x x x x x x x x x x x x x x x ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x "
+} ;
diff --git a/src/xpm/doc/plaid_mask.xpm b/src/xpm/doc/plaid_mask.xpm
new file mode 100644
index 0000000..167d338
--- /dev/null
+++ b/src/xpm/doc/plaid_mask.xpm
@@ -0,0 +1,35 @@
+/* XPM */
+static char * plaid[] = {
+/* plaid pixmap 
+ * width height ncolors chars_per_pixel */
+"22 22 5 2",
+/* colors */
+".  c red 	m white  s light_color ",
+"Y  c green	m black  s lines_in_mix ",
+"+  c yellow	m white  s lines_in_dark ",
+"x  		m black  s dark_color ",
+"   c none		 s mask ",
+/* pixels */
+"                      x x x x x + x x x x x ", 
+"                    . x x x x x x x x x x x ", 
+"                  . x x x x x x + x x x x x ", 
+"                . x . x x x x x x x x x x x ", 
+"              . x . x x x x x x + x x x x x ", 
+"            Y Y Y Y Y + x + x + x + x + x + ", 
+"          x x . x . x x x x x x + x x x x x ", 
+"        . x . x . x . x x x x x x x x x x x ", 
+"      . x x x . x . x x x x x x + x x x x x ", 
+"    . x . x . x . x . x x x x x x x x x x x ", 
+"  . x . x x x . x . x x x x x x + x x x x x ", 
+". . . . . x . . . . . x . x . x Y x . x . x ", 
+". . . . . x . . . . . . x . x . Y . x . x . ",
+". . . . . x . . . . . x . x . x Y x . x . x ", 
+". . . . . x . . . . . . x . x . Y . x . x . ", 
+". . . . . x . . . . . x . x . x Y x . x . x ", 
+"x x x x x x x x x x x x x x x x x x x x x x ", 
+". . . . . x . . . . . x . x . x Y x . x . x ", 
+". . . . . x . . . . . . x . x . Y . x . x . ", 
+". . . . . x . . . . . x . x . x Y x . x . x ", 
+". . . . . x . . . . . . x . x . Y . x . x . ", 
+". . . . . x . . . . . x . x . x Y x . x . x "
+} ;
diff --git a/src/xpm/doc/xpm.tex b/src/xpm/doc/xpm.tex
new file mode 100644
index 0000000..7614e89
--- /dev/null
+++ b/src/xpm/doc/xpm.tex
@@ -0,0 +1,849 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%                              XPM MANUAL                                    %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% adjust these for centering on the page:
+% upper-left corner of frame in title page must be at 60mm,60mm from 
+% upper-left corner of the page
+
+% normal (A4) on our Apple Laserwriter with dvi2ps
+%\hoffset 0cm
+%\voffset 0cm
+% normal (A4 & Letter) on our Apple Laserwriter with dvips v5.0
+\hoffset -5.5mm
+\voffset 0cm
+% our imagen
+%\hoffset -0.9cm
+%\voffset -2.2cm
+		   
+% NOTE: the following line MUST be commented out!
+%\includeonly{standard}
+
+\makeindex
+
+\documentstyle[twoside,colas]{article}
+
+% IF YOUR DVI PRINTER CHOKES ON INCLUDED POSTSCRIPT FILES
+% by the \special command, uncomment the following line:
+% \def\texpsfig#1#2#3{\fbox{Figure ``#1''}}
+
+
+\pagestyle{headings}
+\begin{document} 
+
+\thispagestyle{empty}
+\ 
+\hbox{\colastitledisp
+\vbox{
+\vspace{3cm}
+\begin{center}
+\fboxrule 0.4pt \fboxsep 1pt
+\fbox{\fboxrule 3pt \fboxsep 30pt \fbox{\Huge\bf XPM Manual}}
+\end{center}
+\vspace{2cm}
+\begin{center}
+\huge
+The {\bf X} {\bf P}ix{\bf M}ap Format
+\end{center}
+\vspace{2cm}
+\begin{center} 
+\Large Version \RCSRevVersion$Version: 3.2c $\\
+\end{center}
+\vspace{2cm}
+\begin{center}
+\LARGE\sf Arnaud Le Hors\\
+\large\tt lehors@sophia.inria.fr
+\end{center}
+\vspace{1cm}
+\vspace{1cm}
+\begin{center}
+\copyright BULL 1990-92
+\end{center}
+}}
+
+\newpage
+
+\section*{Copyright restrictions}
+{\bf\begin{flushleft} 
+Copyright 1990-92 GROUPE BULL\\
+\end{flushleft}}
+
+{\sf
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted, provided
+that the above copyright notice appear in all copies and that both that
+copyright notice and this permission notice appear in supporting
+documentation, and that the name of GROUPE BULL not be used in advertising
+or publicity pertaining to distribution of the software without specific,
+written prior permission.  GROUPE BULL makes no representations about the
+suitability of this software for any purpose.  It is provided ``as is''
+without express or implied warranty.
+
+GROUPE BULL disclaims all warranties with regard to this software,
+including all implied warranties of merchantability and fitness,
+in no event shall GROUPE BULL be liable for any special,
+indirect or consequential damages or any damages
+whatsoever resulting from loss of use, data or profits,
+whether in an action of contract, negligence or other tortious
+action, arising out of or in connection with the use 
+or performance of this software.
+}
+
+\section*{Acknowledgements}
+
+I want to thank my team partner and friend Colas Nahaboo who proposed me this
+project, and who actively participates to its design. I also want to thank all
+the users who help me to improve the library by giving feed back and sending
+bug reports.
+
+\begin{flushright}
+{\Large Arnaud Le Hors.\quad}
+{\small
+KOALA Project -- BULL Research c/o INRIA\\
+2004 route des Lucioles -- 06565 Valbonne Cedex -- FRANCE\\
+}
+\end{flushright}
+
+\section*{Support}
+
+\sloppy 
+You can mail any question or suggestion relative to {\bf XPM} by electronic
+mail to {\tt lehors@sophia.inria.fr}. There is also a mailing list, please
+mail requests to {\tt xpm-talk-request@sophia.inria.fr} to subscribe.  You can
+find the latest release by anonymous ftp on avahi.inria.fr (138.96.24.30) or
+export.lcs.mit.edu (18.30.0.238), and also an archive of the mailing list on
+avahi.
+
+
+\newpage
+\section{Introduction}
+First, Why another image format?  We (Koala team at Bull Research, France)
+felt that most images bundled with X applications will be small "icons", and
+that since many applications are color-customizable, existing image formats
+such as gif, tiff, iff, etc... were intended for big images with well-defined
+colors and so weren't adapted to the task.  So {\bf XPM} was designed with
+these criterions in mind:
+\begin{itemize}
+\item be editable by hand (under emacs, vi...). Color pixmap editors aren't
+available everywhere.
+\item be includable in C code. It is unreasonable to load
+1000 pixmap files on each start of an application.
+\item be a portable, mailable ascii format.
+\item provide defaults for monochrome/color/grayscale renderings.
+\item provide overriding of colors. This way if the user wants your application
+to be bluish instead of greenish, you can use the SAME icon files.
+\item allow comments to be included in the file.
+\item compression must be managed apart of the format.
+\end{itemize}
+
+\newpage
+\section{The {\bf XPM} Format}
+
+The {\bf XPM} format presents a C syntax, in order to provide the ability to
+include {\bf XPM} files in C and C++ programs.  It is in fact an array of
+strings composed of six different sections as follows:
+{\tt
+\begin{quote}
+/* XPM */
+static char* {\tt <variable\_name>}[] = \{
+
+<Values>
+
+<Colors>
+
+<Pixels>
+
+<Extensions>
+
+\};
+\end{quote}
+}
+
+The words are separated by a white space which can be composed of space and
+tabulation characters.  
+
+The {\tt <Values>} section is a string containing four or six integers in base
+10 that correspond to: the pixmap width and height, the number of colors, the
+number of characters per pixel (so there is no limit on the number of colors),
+and, optionally the hotspot coordinates and the {\bf XPMEXT} tag if there is
+any extension following the {\tt <Pixels>} section.
+
+{\tt <width> <height> <ncolors> <cpp> [<x\_hotspot> <y\_hotspot>] [XPMEXT]}
+
+The {\tt Colors} section contains as many strings as there are colors, and
+each string is as follows:
+
+{\tt <chars> \{<key> <color>\}+}
+
+Where {\tt <chars>} is the {\tt <chars\_per\_pixel>} length string (not
+surrounded by anything) representing the pixels, {\tt <color>} is the
+specified color, and {\tt <key>} is a keyword describing in which context this
+color should be used. Currently the keys may have the following values:
+
+\begin{tabbing}
+\hspace{1cm}\= g4 \= for 4-level grayscale\kill
+\> m  \>for mono visual\\
+\> s  \> for symbolic name\\
+\> g4 \> for 4-level grayscale\\
+\> g  \> for grayscale with more than 4 levels\\
+\> c  \> for color visual
+\end{tabbing}
+
+Colors can be specified by giving the colorname, a \# foolwed by the RGB code,
+or a \% followed by the HSV code. The symbolic name provides the ability of
+specifying the colors at load time and not to hard-code them in the file.
+Also the string {\bf None} can be given as a colorname to mean
+``transparent''. Transparency is handled by providing a masking bitmap in
+addition to the pixmap.
+
+The {\tt <Pixels>} section is composed by {\tt <height>} strings of {\tt
+<width>} * {\tt <chars\_per\_pixel>} characters, where every {\tt
+<chars\_per\_pixel>} length string must be one of the previously defined
+groups in the {\tt <Colors>} section.
+
+Then follows the {\tt <Extensions>} section which must be labeled, if not
+empty, in the {\tt <Values>} section as previously described.
+This section may be composed by several {\tt <Extension>} subsections which
+may be of two types:
+
+\begin{itemize}
+\item[] one stand alone string composed as follows:
+
+{\tt XPMEXT <extension-name> <extension-data>}
+
+\item[] or a block composed by several strings:
+
+{\tt XPMEXT <extension-name>}
+
+{\tt <related extension-data composed of several strings>}
+
+\end{itemize}
+
+Finally, if not empty, this section must end by the following string:
+
+{\tt XPMENDEXT}
+
+To avoid possible conflicts with extension names in shared files, they should
+be prefixed by the name of the company. This would ensure unicity.
+
+\vspace{0.5cm}
+Below is an example which is the XPM file of a plaid pixmap. This is a 22x22
+pixmap, with 4 colors and 2 characters per pixel. The hotspot coordinates are
+(0, 0). There are symbols and default colors for color and monochrome visuals.
+Finally there are two extensions.
+
+{\small \begin{verbatim}
+
+/* XPM */
+static char * plaid[] = {
+/* plaid pixmap 
+ * width height ncolors chars_per_pixel */
+"22 22 4 2 0 0 XPMEXT",
+/* colors */
+"   c red 	m white  s light_color ",
+"Y  c green	m black  s lines_in_mix ",
+"+  c yellow	m white  s lines_in_dark ",
+"x 		m black  s dark_color ",
+/* pixels */
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"Y Y Y Y Y x Y Y Y Y Y + x + x + x + x + x + ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"  x   x   x   x   x   x x x x x x x x x x x ", 
+"x   x   x x x   x   x x x x x x + x x x x x ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ",
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x ", 
+"x x x x x x x x x x x x x x x x x x x x x x ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x ", 
+"          x             x   x   Y   x   x   ", 
+"          x           x   x   x Y x   x   x "
+"XPMEXT ext1 data1",
+"XPMEXT ext2",
+"data2_1",
+"data2_2",
+"XPMENDEXT"
+};
+
+\end{verbatim}}
+
+\newpage
+\section{The {\bf XPM} Library}
+
+The XPM library provides a set of Xlib-level functions which allows to deal
+with images, pixmaps, XPM file, and data (included XPM file) in many ways.
+This section describes these functions and how to use them.
+
+\vspace{.5cm}
+To provide a simple interface all these functions take, in addition to their
+main arguments such as the display, a structure called {\bf XpmAttributes}.
+This structure may be considered as composed of two different groups of
+members. The first one is composed of attributes to pass data such as colormap
+and visual and attributes to retrieve returned data such as pixmap's width and
+height. The second group provides a way to rewrite an {\bf XPM} file without
+losing information such as comments, color defaults and symbolic names which
+may exist in the original file (i.e. the {\bf XpmInfo} structure in {\bf XPM 2}).
+The {\bf XpmAttributes} structure is defined as follows:
+
+{\small \begin{tabbing}
+
+\hspace{1cm}\= XpmColorSymbol *colorsymbols; \=/* List of color symbols */\kill
+typedef struct \{ \\
+\> unsigned long valuemask;  \>/* Specifies which attributes are defined */\\
+\\
+\> Visual *visual;	     \>/* Specifies the visual to use */ \\
+\> Colormap colormap; 	     \>/* Specifies the colormap to use */ \\
+\> unsigned int depth;	     \>/* Specifies the depth */ \\
+\> unsigned int width;	     \>/* Returns the width of the created pixmap */\\
+\> unsigned int height;      \>/* Returns the height of the created pixmap */\\
+\> unsigned int x\_hotspot;  \>/* Returns the x hotspot's coordinate */\\
+\> unsigned int y\_hotspot;  \>/* Returns the y hotspot's coordinate */ \\
+\> unsigned int cpp; 	     \>/* Specifies the number of char per pixel */ \\
+\> Pixel *pixels; 	     \>/* List of used color pixels */ \\
+\> unsigned int npixels;     \>/* Number of pixels */\\
+\> XpmColorSymbol *colorsymbols;\>/* Array of color symbols to override */ \\
+\> unsigned int numsymbols;  \>/* Number of symbols */ \\
+\> char *rgb\_fname;	     \>/* RGB text file name */ \\
+\> unsigned int nextensions; \>/* Number of extensions */ \\
+\> XpmExtension *extensions; \>/* Array of extensions */ \\
+\\
+\> /* Infos */  \\
+\> int ncolors;		     \>/* Number of colors */ \\
+\> char ***colorTable; 	     \>/* Color table pointer */ \\
+\> char *hints\_cmt; 	     \>/* Comment of the hints section */ \\
+\> char *colors\_cmt;	     \>/* Comment of the colors section */ \\
+\> char *pixels\_cmt;	     \>/* Comment of the pixels section */ \\
+\> unsigned int mask\_pixel; \>/* Transparent pixel's color table index */\\
+\\
+\> /* Color Allocation Directives */ \\
+\> unsigned int exactColors; \>/* Only use exact colors for visual */ \\
+\> unsigned int closeness;   \>/* Allowable RGB deviation */ \\
+\\
+\} XpmAttributes;
+
+\end{tabbing}}
+
+The valuemask is the bitwise inclusive OR of the valid attribute mask bits. If
+the valuemask is zero, the attributes are ignored and not referenced. And
+default values are taken for needed attributes which are not specified.
+
+The colorTable is a two dimensional array of strings, organized as follows:
+\begin{flushleft}
+\hspace{.5cm}colorTable[color\#][0] points to the character string associated
+to the color.\\
+\hspace{.5cm}colorTable[color\#][1] points to the symbolic name of the color.\\
+\hspace{.5cm}colorTable[color\#][2] points to the default color for monochrome
+visuals.\\
+\hspace{.5cm}colorTable[color\#][3] points to the default color for 4-level
+grayscale visuals.\\
+\hspace{.5cm}colorTable[color\#][4] points to the default color for other
+grayscale visuals.\\
+\hspace{.5cm}colorTable[color\#][5] points to the default color for color
+visuals. 
+\end{flushleft}
+
+Comments are limited to a single comment string by section. If more exist in
+the read file, then only the last comment of each section will be stored.
+
+To get information back while writing out to a file, you just have to set
+the mask bits {\bf XpmReturnInfos} to the valuemask of an {\bf XpmAttributes}
+structure that you pass to the {\bf XpmReadFileToPixmap} function while reading
+the file, and then give the structure back to the {\bf XpmWriteFileFromPixmap}
+function while writing.
+
+\vspace{.5cm}
+To allow overriding of colors at load time the {\bf XPM} library defines the
+{\bf XpmColorSymbol} structure which contains:
+
+\begin{tabbing}
+\hspace{1cm}\= char *value; \hspace{1.5cm}\= /* Color value */\kill
+typedef struct \{\\
+\> char *name; \> /* Symbolic color name */\\
+\> char *value;\> /* Color value */\\
+\> Pixel pixel;\> /* Color pixel */\\
+\} XpmColorSymbol;
+\end{tabbing}
+
+To override default colors at load time, you just have to pass, via the {\bf
+XpmAttributes} structure, a list of {\bf XpmColorSymbol} elements containing
+the desired colors to the {\bf XpmReadFileToPixmap} or {\bf
+XpmCreatePixmapFromData} {\bf XPM} functions. These colors can be specified by
+giving the color name in the value member or directly by giving the
+corresponding pixel in the pixel member. In the latter case the value member
+must be set to {\bf NULL} otherwise the given pixel will not be considered.
+
+In addition, is is possible to set the pixel for a specific color {\bf value}
+at load time by setting the color name to NULL, and setting the value and pixel
+fields appropriately. For example, by setting the color name to NULL, the
+value to ``red'' and the pixel to 51, all symbolic colors that are assigned to
+``red'' will be set to pixel 51. It is even possible to specify the pixel used
+for the transparent color ``none'' when no mask is required.
+
+\vspace{.5cm}
+To pass and retrieve extension data use the {\bf XpmExtension} structure which
+is defined below:
+
+\begin{tabbing}
+\hspace{1cm}\= unsigned int nlines; \hspace{1cm}\= /*  */ \kill
+typedef struct \{ \\
+\> char *name;		\> /* name of the extension */ \\
+\> unsigned int nlines;	\> /* number of lines in this extension */ \\
+\> char **lines;	\> /* pointer to the extension array of strings */ \\
+\}      XpmExtension;
+\end{tabbing}
+
+To retrieve possible extension data stored in an {\bf XPM} file or data, you
+must set the mask bits {\bf XpmReturnExtensions} to the valuemask of an {\bf
+XpmAttributes} structure that you pass to the read function you use. Then the
+same structure may be passed the same way to any write function if you set the
+mask bits {\bf XpmExtensions} to the valuemask.
+
+\vspace{.5cm}
+To create a pixmap from an {\bf XPM} file, use {\bf XpmReadFileToPixmap}.
+
+\begin{flushleft} 
+
+int XpmReadFileToPixmap({\it display, d, filename, \\
+\hspace{3cm}pixmap\_return, shapemask\_return, attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}Drawable {\it d;}\\
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}Pixmap {\it *pixmap\_return;}\\
+\hspace{1cm}Pixmap {\it *shapemask\_return;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{d} Specifies which screen the pixmap is created on.
+\itemit{filename} Specifies the file name to use.
+\itemit{pixmap\_return} Returns the pixmap which is created.
+\itemit{shapemask\_return} Returns the shapemask which is created, if any.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+to get and store information.
+
+\end{description} 
+
+The {\bf XpmReadFileToPixmap} function reads in a file containing a pixmap in
+the {\bf XPM} format. If the file cannot be opened, {\bf XpmReadFileToPixmap}
+returns {\bf XpmOpenFailed}. If the file can be opened but does not
+contain valid {\bf XPM} pixmap data, it returns {\bf XpmFileInvalid}. If
+insufficient working storage is allocated, it returns {\bf XpmNoMemory}.
+
+If the passed {\bf XpmAttributes} structure pointer is not {\bf NULL}, {\bf
+XpmReadFileToPixmap} looks for the following attributes: {\bf XpmVisual}, {\bf
+XpmColormap}, {\bf XpmDepth}, {\bf XpmColorSymbols}, {\bf XpmExactColors},
+{\bf XpmCloseness}, {\bf XpmReturnPixels}, {\bf XpmReturnExtensions},
+{\bf XpmReturnInfos}, and sets the {\bf XpmSize} and possibly the
+{\bf XpmHotspot} attributes when returning.
+
+{\bf XpmReadFileToPixmap} allocates colors, as read from the file or possibly
+overridden as specified in the {\bf XpmColorSymbols} attributes. The colors
+are allocated dependently on the type of visual and on the default colors. If
+no default value exits for the specified visual, it first looks for other
+defaults nearer to the monochrome visual type and secondly nearer to the color
+visual type. If the color which is found is not valid (cannot parse it), it
+looks for another default one according to the same algorithm.
+
+If allocating a color fails, and the {\bf closeness} attribute is set, it
+tries to find a color already in the colormap that is closest to the desired
+color, and uses that. If no color can be found that is within {\bf closeness}
+of the Red, Green and Blue components of the desired color, it reverts to
+trying other default values as explained above.
+
+The RGB Components are integers within the range 0 (black) to 65535 (white).
+A closeness of less than 10000, for example, will cause only quite close colors
+to be matched, while a closeness of more than 50000 will allow quite
+dissimilar colors to match. Specifying a closeness of more than 65535 will
+allow any color to match, thus forcing the icon to be drawn in color no matter
+how bad the colormap is. The value 40000 seems to be about right for many
+situations requiring reasonable but not perfect matches. With this setting the
+color must only be within the same general area of the RGB cube as the desired
+color.
+
+If the {\bf exactColors} attribute is set it then returns {\bf XpmColorError},
+otherwise it creates the pixmap and returns XpmSuccess. If no color is found,
+and no close color exists or is wanted, and all visuals have been exhausted,
+{\bf XpmColorFailed} is returned.
+
+{\bf XpmReadFileToPixmap} returns the created pixmap to pixmap\_return if not
+{\bf NULL} and possibly the created shapemask to shapemask\_return if not
+{\bf NULL}. If required it stores into the {\bf XpmAttributes} structure the
+list of the used pixels and possible comments, color defaults and symbols.
+When finished the caller must free the pixmaps using {\bf XFreePixmap}, the
+colors using {\bf XFreeColors}, and possibly the data returned into the
+{\bf XpmAttributes} using {\bf XpmFreeAttributes}.
+
+In addition on system which support such features {\bf XpmReadFileToPixmap}
+deals with compressed files by forking an uncompress process and reading from
+the piped result. It assumes that the specified file is compressed if the
+given file name ends by .Z. In case the file name does not end so, {\bf
+XpmReadFileToPixmap} first looks for a file of which the name is the given one
+followed by .Z; then if such a file does not exist, it looks for the given
+file (assumed as not compressed). And if instead of a file name {\bf NULL} is
+passed to {\bf XpmReadFileToPixmap}, it reads from the standard input.
+
+\vspace{.5cm}
+To write out a pixmap to an {\bf XPM} file, use {\bf XpmWriteFileFromPixmap}.
+
+\begin{flushleft} 
+
+int XpmWriteFileFromPixmap({\it display, filename, pixmap, shapemask,\\
+\hspace{3cm}attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}Pixmap {\it pixmap;}\\
+\hspace{1cm}Pixmap {\it shapemask;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{filename} Specifies the file name to use.
+\itemit{pixmap} Specifies the pixmap.
+\itemit{shapemask} Specifies the shape mask pixmap.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+containing information.
+
+\end{description} 
+
+The {\bf XpmWriteFileFromPixmap} function writes a pixmap and its possible
+shapemask out to a file in the {\bf XPM} format. If the file cannot be opened,
+it returns {\bf XpmOpenFailed}. If insufficient working storage is
+allocated, it returns {\bf XpmNoMemory}. If no error occurs then it
+returns {\bf XpmSuccess}.
+
+If the passed {\bf XpmAttributes} structure pointer is not {\bf NULL}, {\bf
+XpmWriteFileFromPixmap} look for the following attributes: {\bf XpmColormap},
+{\bf XpmSize}, {\bf XpmHotspot}, {\bf XpmCharsPerPixel}, {\bf XpmRgbFilename},
+{\bf XpmInfos} and {\bf XpmExtensions}.
+
+If the {\bf XpmSize} attributes are not defined {\bf XpmWriteFileFromPixmap}
+performs an {\bf XGetGeometry} operation. If the filename contains an
+extension such as ``.xpm'' it is cut off when writing out to the pixmap
+variable name. If the {\bf XpmInfos} attributes are defined it writes out
+possible stored information such as comments, color defaults and symbol.
+Finally if the {\bf XpmRgbFilename} attribute is defined, {\bf
+XpmWriteFileFromPixmap} searches for color names in this file and if found
+writes them out instead of the rgb values.
+
+In addition on system which support such features if the given file name ends
+by .Z it is assumed to be a compressed file. Then, {\bf XpmWriteFileFromPixmap}
+writes to a piped compress process. And if instead of a file name {\bf NULL}
+is passed to {\bf XpmWriteFileFromPixmap}, it writes to the standard output.
+
+\vspace{.5cm}
+To create a pixmap from an {\bf XPM} file directly included in a program, use
+{\bf XpmCreatePixmapFromData}.
+
+\begin{flushleft} 
+
+int XpmCreatePixmapFromData({\it display, d, data, \\
+\hspace{3cm}pixmap\_return, shapemask\_return, attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}Drawable {\it d;}\\
+\hspace{1cm}char {\it **data;}\\
+\hspace{1cm}Pixmap {\it *pixmap\_return;}\\
+\hspace{1cm}Pixmap {\it *shapemask\_return;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{d} Specifies which screen the pixmap is created on.
+\itemit{data} Specifies the location of the pixmap data.
+\itemit{pixmap\_return} Returns the pixmap which is created.
+\itemit{shapemask\_return} Returns the shape mask pixmap which is created if
+any.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+to get and store information, or {\bf NULL}. 
+
+\end{description} 
+
+The {\bf XpmCreatePixmapFromData} function allows you to include in your C
+program an {\bf XPM} pixmap file which was written out by {\bf
+XpmWriteFileFromPixmap} without reading in the pixmap file.
+
+{\bf XpmCreatePixmapFromData} exactly works as {\bf
+Xpm\-Read\-File\-To\-Pixmap} does and returns the same way. It just reads data
+instead of a file. Here again, it is the caller's responsibility to free the
+pixmaps, the colors and possibly the data returned into the {\bf
+XpmAttributes} structure.
+
+\vspace{.5cm}
+In some cases, one may want to create an {\bf XPM} data from a pixmap in order
+to be able to create a pixmap from this data using the {\bf
+XpmCreatePixmapFromData} function later on. To do so use {\bf
+XpmCreateDataFromPixmap}.
+
+\begin{flushleft}
+
+int XpmCreateDataFromPixmap({\it display, data\_return, pixmap, shapemask,\\
+\hspace{3cm}attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it ***data\_return;}\\
+\hspace{1cm}Pixmap {\it pixmap;}\\
+\hspace{1cm}Pixmap {\it shapemask;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{data\_return} Returns the data which is created.
+\itemit{pixmap} Specifies the pixmap.
+\itemit{shapemask} Specifies the shape mask pixmap.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+containing information.
+
+\end{description} 
+
+The {\bf XpmCreateDataFromPixmap} function exactly works as {\bf
+Xpm\-Write\-File\-From\-Pixmap} does and returns the same way. It just writes
+to a single block malloc'ed data instead of to a file. It is the caller's
+responsibility to free the data when finished.
+
+\vspace{.5cm}
+To do the same than the four functions described above do but with images
+instead of pixmaps use the functions {\bf XpmReadFileToImage}, {\bf
+XpmWriteFileFromImage}, {\bf XpmCreateImageFromData}, {\bf
+XpmCreateDataFromImage}.
+
+\vspace{.2cm}
+{\bf XpmReadFileToImage} creates an image from an {\bf XPM} file.
+
+\begin{flushleft} 
+
+int XpmReadFileToImage({\it display, filename, \\
+\hspace{3cm}image\_return, shapeimage\_return, attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}XImage {\it **image\_return;}\\
+\hspace{1cm}XImage {\it **shapeimage\_return;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{filename} Specifies the file name to use.
+\itemit{image\_return} Returns the image which is created.
+\itemit{shapeimage\_return} Returns the shape mask image which is created if
+any.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+to get and store information.
+
+\end{description} 
+
+\vspace{.5cm}
+{\bf XpmWriteFileFromImage} writes out an image to an {\bf XPM} file.
+
+\begin{flushleft} 
+
+int XpmWriteFileFromImage({\it display, filename, image, shapeimage,\\
+\hspace{3cm}attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}XImage {\it *image;}\\
+\hspace{1cm}XImage {\it *shapeimage;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{filename} Specifies the file name to use.
+\itemit{image} Specifies the image.
+\itemit{shapeimage} Specifies the shape mask image.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+containing information.
+
+\end{description} 
+
+\vspace{.5cm}
+{\bf XpmCreateImageFromData} creates an image from an {\bf XPM} file directly included in a program.
+
+\begin{flushleft} 
+
+int XpmCreateImageFromData({\it display, data, \\
+\hspace{3cm}image\_return, shapeimage\_return, attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it **data;}\\
+\hspace{1cm}XImage {\it **image\_return;}\\
+\hspace{1cm}XImage {\it **shapeimage\_return;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{data} Specifies the location of the image data.
+\itemit{image\_return} Returns the image which is created.
+\itemit{shapeimage\_return} Returns the shape mask image which is created if
+any.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+to get and store information, or {\bf NULL}. 
+
+\end{description} 
+
+\vspace{.5cm}
+{\bf XpmCreateDataFromImage} creates an {\bf XPM} data from an image.
+
+\begin{flushleft}
+
+int XpmCreateDataFromImage({\it display, data\_return, image, shapeimage,\\
+\hspace{3cm}attributes})\\
+
+\hspace{1cm}Display {\it *display;}\\
+\hspace{1cm}char {\it ***data\_return;}\\
+\hspace{1cm}XImage {\it *image;}\\
+\hspace{1cm}XImage {\it *shapeimage;}\\
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{display} Specifies the connection to the X server.
+\itemit{data\_return} Returns the data which is created.
+\itemit{image} Specifies the image.
+\itemit{shapeimage} Specifies the shape mask image.
+\itemit{attributes} Specifies the location of an {\bf XpmAttributes} structure
+containing information.
+
+\end{description} 
+
+These four functions work exactly the same way than the four ones previously
+described.
+
+\vspace{.5cm}
+To directly tranform an {\bf XPM} file to and from an {\bf XPM} data
+array, without requiring an open X display, use {\bf
+XpmReadFileToData} and {\bf XpmWriteFileFromData}.
+
+\vspace{.2cm}
+{\bf XpmReadFileToData} allocates and fills an XPM data array from an {\bf XPM} file.
+
+\begin{flushleft} 
+
+int XpmReadFileToData({\it filename, data\_return})\\
+
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}char {\it ***data\_return;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{filename} Specifies the file name to read.
+\itemit{data\_return} Returns the data array created.
+
+\end{description} 
+
+\vspace{.5cm}
+{\bf XpmWriteFileFromData} writes an {\b XPM} data array to an {\bf XPM} file.
+
+\begin{flushleft} 
+
+int XpmWriteFileFromData({\it filename, data})\\
+
+\hspace{1cm}char {\it *filename;}\\
+\hspace{1cm}char {\it **data;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{filename} Specifies the file name to write.
+\itemit{data} Specifies the {\b XPM} data array to read.
+
+\end{description} 
+
+\vspace{.5cm}
+To free possible data stored into an {\bf XpmAttributes} structure use {\bf
+XpmFreeAttributes}.
+
+\begin{flushleft} 
+
+int XpmFreeAttributes({\it attributes})\\
+
+\hspace{1cm}XpmAttributes {\it *attributes;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{attributes} Specifies the structure to free.
+
+\end{description}
+
+The {\bf XpmFreeAttributes} frees the structure members which have been
+malloc'ed: the pixels list and the infos members (comments strings and color
+table).
+
+\vspace{.5cm}
+To dynamically allocate an {\bf XpmAttributes} structure use the {\bf
+Xpm\-Attributes\-Size} function.
+
+\begin{flushleft} 
+
+int XpmAttributesSize()
+
+\end{flushleft}
+
+The {\bf XpmAttributesSize} function provides application using dynamic
+libraries with a safe way to allocate and then refer to an {\bf XpmAttributes}
+structure, disregarding whether the {\bf XpmAttributes} structure size has
+changed or not since compiled.
+
+\vspace{.5cm}
+To free data possibly stored into an array of {\bf XpmExtension} use {\bf
+XpmFreeExtensions}.
+
+\begin{flushleft} 
+
+int XpmFreeExtensions({\it extensions, nextensions})\\
+
+\hspace{1cm}XpmExtension {\it *extensions;}\\
+\hspace{1cm}int {\it nextensions;}
+
+\end{flushleft}
+
+\begin{description}
+
+\itemit{extensions} Specifies the array to free.
+\itemit{nextensions} Specifies the number of extensions.
+
+\end{description}
+
+This function frees all data stored in every extension and the array itself.
+Note that {\bf XpmFreeAttributes} call this function and thus most of the time
+it should not need to be explicitly called.
+
+\end{document} 
diff --git a/src/xpm/hashtable.c b/src/xpm/hashtable.c
new file mode 100644
index 0000000..e457e26
--- /dev/null
+++ b/src/xpm/hashtable.c
@@ -0,0 +1,205 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* hashtable.c:                                                                *
+*                                                                             *
+*  XPM library                                                                *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+*  this originaly comes from Colas Nahaboo as a part of Wool                  *
+*                                                                             *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+LFUNC(AtomMake, xpmHashAtom, (char *name, void *data));
+LFUNC(HashTableGrows, int, (xpmHashTable *table));
+
+static xpmHashAtom
+AtomMake(name, data)			/* makes an atom */
+    char *name;				/* WARNING: is just pointed to */
+    void *data;
+{
+    xpmHashAtom object = (xpmHashAtom) malloc(sizeof(struct _xpmHashAtom));
+    if (object) {
+	object->name = name;
+	object->data = data;
+    }
+    return object;
+}
+
+/************************\
+* 			 *
+*  hash table routines 	 *
+* 			 *
+\************************/
+
+/*
+ * Hash function definition:
+ * HASH_FUNCTION: hash function, hash = hashcode, hp = pointer on char,
+ *				 hash2 = temporary for hashcode.
+ * INITIAL_TABLE_SIZE in slots
+ * HASH_TABLE_GROWS how hash table grows.
+ */
+
+/* Mock lisp function */
+#define HASH_FUNCTION 	  hash = (hash << 5) - hash + *hp++;
+/* #define INITIAL_HASH_SIZE 2017 */
+#define INITIAL_HASH_SIZE 256		/* should be enough for colors */
+#define HASH_TABLE_GROWS  size = size * 2;
+
+/* aho-sethi-ullman's HPJ (sizes should be primes)*/
+#ifdef notdef
+#define HASH_FUNCTION	hash <<= 4; hash += *hp++; \
+    if(hash2 = hash & 0xf0000000) hash ^= (hash2 >> 24) ^ hash2;
+#define INITIAL_HASH_SIZE 4095		/* should be 2^n - 1 */
+#define HASH_TABLE_GROWS  size = size << 1 + 1;
+#endif
+
+/* GNU emacs function */
+/*
+#define HASH_FUNCTION 	  hash = (hash << 3) + (hash >> 28) + *hp++;
+#define INITIAL_HASH_SIZE 2017
+#define HASH_TABLE_GROWS  size = size * 2;
+*/
+
+/* end of hash functions */
+
+/*
+ * The hash table is used to store atoms via their NAME:
+ *
+ * NAME --hash--> ATOM |--name--> "foo"
+ *		       |--data--> any value which has to be stored
+ *
+ */
+
+/*
+ * xpmHashSlot gives the slot (pointer to xpmHashAtom) of a name
+ * (slot points to NULL if it is not defined)
+ *
+ */
+
+xpmHashAtom *
+xpmHashSlot(table, s)
+    xpmHashTable *table;
+    char *s;
+{
+    xpmHashAtom *atomTable = table->atomTable;
+    unsigned int hash, hash2;
+    xpmHashAtom *p;
+    char *hp = s;
+    char *ns;
+
+    hash = 0;
+    while (*hp) {			/* computes hash function */
+	HASH_FUNCTION
+    }
+    p = atomTable + hash % table->size;
+    while (*p) {
+	ns = (*p)->name;
+	if (ns[0] == s[0] && strcmp(ns, s) == 0)
+	    break;
+	p--;
+	if (p < atomTable)
+	    p = atomTable + table->size - 1;
+    }
+    return p;
+}
+
+static int
+HashTableGrows(table)
+    xpmHashTable *table;
+{
+    xpmHashAtom *atomTable = table->atomTable;
+    int size = table->size;
+    xpmHashAtom *t, *p;
+    int i;
+    int oldSize = size;
+
+    t = atomTable;
+    HASH_TABLE_GROWS
+	table->size = size;
+    table->limit = size / 3;
+    atomTable = (xpmHashAtom *) malloc(size * sizeof(*atomTable));
+    if (!atomTable)
+	return (XpmNoMemory);
+    table->atomTable = atomTable;
+    for (p = atomTable + size; p > atomTable;)
+	*--p = NULL;
+    for (i = 0, p = t; i < oldSize; i++, p++)
+	if (*p) {
+	    xpmHashAtom *ps = xpmHashSlot(table, (*p)->name);
+	    *ps = *p;
+	}
+    free(t);
+    return (XpmSuccess);
+}
+
+/*
+ * xpmHashIntern(table, name, data)
+ * an xpmHashAtom is created if name doesn't exist, with the given data.
+ */
+
+int
+xpmHashIntern(table, tag, data)
+    xpmHashTable *table;
+    char *tag;
+    void *data;
+{
+    xpmHashAtom *slot;
+
+    if (!*(slot = xpmHashSlot(table, tag))) {
+	/* undefined, make a new atom with the given data */
+	if (!(*slot = AtomMake(tag, data)))
+	    return (XpmNoMemory);
+	if (table->used >= table->limit) {
+	    int ErrorStatus;
+	    xpmHashAtom new = *slot;
+	    if ((ErrorStatus = HashTableGrows(table)) != XpmSuccess)
+		return(ErrorStatus);
+	    table->used++;
+	    return (XpmSuccess);
+	}
+	table->used++;
+    }
+    return (XpmSuccess);
+}
+
+/*
+ *  must be called before allocating any atom
+ */
+
+int
+xpmHashTableInit(table)
+    xpmHashTable *table;
+{
+    xpmHashAtom *p;
+    xpmHashAtom *atomTable;
+
+    table->size = INITIAL_HASH_SIZE;
+    table->limit = table->size / 3;
+    table->used = 0;
+    atomTable = (xpmHashAtom *) malloc(table->size * sizeof(*atomTable));
+    if (!atomTable)
+	return (XpmNoMemory);
+    for (p = atomTable + table->size; p > atomTable;)
+	*--p = NULL;
+    table->atomTable = atomTable;
+    return (XpmSuccess);
+}
+
+/*
+ *   frees a hashtable and all the stored atoms
+ */
+
+void
+xpmHashTableFree(table)
+    xpmHashTable *table;
+{
+    xpmHashAtom *p;
+    xpmHashAtom *atomTable = table->atomTable;
+    for (p = atomTable + table->size; p > atomTable;)
+	if (*--p)
+	    free(*p);
+    free(atomTable);
+    table->atomTable = NULL;
+}
diff --git a/src/xpm/misc.c b/src/xpm/misc.c
new file mode 100644
index 0000000..a34608c
--- /dev/null
+++ b/src/xpm/misc.c
@@ -0,0 +1,206 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* misc.c:                                                                     *
+*                                                                             *
+*  XPM library                                                               *
+*  Miscellaneous utilities                                                    *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+/*
+ * Free the computed color table
+ */
+
+xpmFreeColorTable(colorTable, ncolors)
+    char ***colorTable;
+    int ncolors;
+{
+    int a, b;
+    char ***ct, **cts;
+
+    if (colorTable) {
+	for (a = 0, ct = colorTable; a < ncolors; a++, ct++)
+	    if (*ct) {
+		for (b = 0, cts = *ct; b <= NKEYS; b++, cts++)
+		    if (*cts)
+			free(*cts);
+		free(*ct);
+	    }
+	free(colorTable);
+    }
+}
+
+
+/*
+ * Intialize the xpmInternAttrib pointers to Null to know
+ * which ones must be freed later on.
+ */
+
+xpmInitInternAttrib(attrib)
+    xpmInternAttrib *attrib;
+{
+    attrib->ncolors = 0;
+    attrib->colorTable = NULL;
+    attrib->pixelindex = NULL;
+    attrib->xcolors = NULL;
+    attrib->colorStrings = NULL;
+    attrib->mask_pixel = UNDEF_PIXEL;
+}
+
+
+/*
+ * Free the xpmInternAttrib pointers which have been allocated
+ */
+
+xpmFreeInternAttrib(attrib)
+    xpmInternAttrib *attrib;
+{
+    unsigned int a, ncolors;
+    char **sptr;
+
+    if (attrib->colorTable)
+	xpmFreeColorTable(attrib->colorTable, attrib->ncolors);
+    if (attrib->pixelindex)
+	free(attrib->pixelindex);
+    if (attrib->xcolors)
+	free(attrib->xcolors);
+    if (attrib->colorStrings) {
+	ncolors = attrib->ncolors;
+	for (a = 0, sptr = attrib->colorStrings; a < ncolors; a++, sptr++)
+	    if (*sptr)
+		free(*sptr);
+	free(attrib->colorStrings);
+    }
+}
+
+
+/*
+ * Free array of extensions
+ */
+XpmFreeExtensions(extensions, nextensions)
+    XpmExtension *extensions;
+    int          nextensions;
+{
+    unsigned int i, j, nlines;
+    XpmExtension *ext;
+    char **sptr;
+
+    if (extensions) {
+	for (i = 0, ext = extensions; i < nextensions; i++, ext++) {
+	    if (ext->name)
+		free(ext->name);
+	    nlines = ext->nlines;
+	    for (j = 0, sptr = ext->lines; j < nlines; j++, sptr++)
+		if (*sptr)
+		    free(*sptr);
+	    if (ext->lines)
+		free(ext->lines);
+	}
+	free(extensions);
+    }
+}
+
+
+/*
+ * Return the XpmAttributes structure size
+ */
+
+XpmAttributesSize()
+{
+    return sizeof(XpmAttributes);
+}
+
+
+/*
+ * Free the XpmAttributes structure members
+ * but the structure itself
+ */
+
+XpmFreeAttributes(attributes)
+    XpmAttributes *attributes;
+{
+    if (attributes) {
+	if (attributes->valuemask & XpmReturnPixels && attributes->pixels) {
+	    free(attributes->pixels);
+	    attributes->pixels = NULL;
+	    attributes->npixels = 0;
+	}
+	if (attributes->valuemask & XpmInfos) {
+	    if (attributes->colorTable) {
+		xpmFreeColorTable(attributes->colorTable, attributes->ncolors);
+		attributes->colorTable = NULL;
+		attributes->ncolors = 0;
+	    }
+	    if (attributes->hints_cmt) {
+		free(attributes->hints_cmt);
+		attributes->hints_cmt = NULL;
+	    }
+	    if (attributes->colors_cmt) {
+		free(attributes->colors_cmt);
+		attributes->colors_cmt = NULL;
+	    }
+	    if (attributes->pixels_cmt) {
+		free(attributes->pixels_cmt);
+		attributes->pixels_cmt = NULL;
+	    }
+	    if (attributes->pixels) {
+		free(attributes->pixels);
+		attributes->pixels = NULL;
+	    }
+	}
+	if (attributes->valuemask & XpmReturnExtensions
+	    && attributes->nextensions) {
+            XpmFreeExtensions(attributes->extensions, attributes->nextensions);
+	    attributes->nextensions = 0;
+	    attributes->extensions = NULL;
+	}
+	attributes->valuemask = 0;
+    }
+}
+
+
+/*
+ * Store into the XpmAttributes structure the required informations stored in
+ * the xpmInternAttrib structure.
+ */
+
+xpmSetAttributes(attrib, attributes)
+    xpmInternAttrib *attrib;
+    XpmAttributes *attributes;
+{
+    if (attributes) {
+	if (attributes->valuemask & XpmReturnInfos) {
+	    attributes->cpp = attrib->cpp;
+	    attributes->ncolors = attrib->ncolors;
+	    attributes->colorTable = attrib->colorTable;
+
+	    attrib->ncolors = 0;
+	    attrib->colorTable = NULL;
+	}
+	attributes->width = attrib->width;
+	attributes->height = attrib->height;
+	attributes->valuemask |= XpmSize;
+    }
+}
+
+#ifdef NEED_STRDUP
+
+/*
+ * in case strdup is not provided by the system here is one
+ * which does the trick
+ */
+char *
+strdup (s1)
+    char *s1;
+{
+    char *s2;
+    int l = strlen(s1) + 1;
+    if (s2 = (char *) malloc(l))
+	strncpy(s2, s1, l);
+    return s2;
+}
+
+#endif
diff --git a/src/xpm/parse.c b/src/xpm/parse.c
new file mode 100644
index 0000000..560b719
--- /dev/null
+++ b/src/xpm/parse.c
@@ -0,0 +1,537 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* parse.c:                                                                    *
+*                                                                             *
+*  XPM library                                                                *
+*  Parse an XPM file or array and store the found informations                *
+*  in an an xpmInternAttrib structure which is returned.                      *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:ctype.h"
+#else
+#include <ctype.h>
+#endif
+
+LFUNC(ParseValues, int, (xpmData *data, unsigned int *width,
+			 unsigned int *height, unsigned int *ncolors,
+			 unsigned int *cpp,  unsigned int *x_hotspot,
+			 unsigned int *y_hotspot, unsigned int *hotspot,
+			 unsigned int *extensions));
+
+LFUNC(ParseColors, int, (xpmData *data, unsigned int ncolors, unsigned int cpp,
+			 char ****colorTablePtr, xpmHashTable *hashtable));
+
+LFUNC(ParsePixels, int, (xpmData *data, unsigned int width, 
+			 unsigned int height, unsigned int ncolors,
+			 unsigned int cpp, char ***colorTable,
+			 xpmHashTable *hashtable, unsigned int **pixels));
+
+LFUNC(ParseExtensions, int, (xpmData *data, XpmExtension **extensions,
+			     unsigned int *nextensions));
+
+char *xpmColorKeys[] =
+{
+ "s",					/* key #1: symbol */
+ "m",					/* key #2: mono visual */
+ "g4",					/* key #3: 4 grays visual */
+ "g",					/* key #4: gray visual */
+ "c",					/* key #5: color visual */
+};
+
+
+/* function call in case of error, frees only locally allocated variables */
+#undef RETURN
+#define RETURN(status) \
+  { if (colorTable) xpmFreeColorTable(colorTable, ncolors); \
+    if (pixelindex) free(pixelindex); \
+    if (hints_cmt)  free(hints_cmt); \
+    if (colors_cmt) free(colors_cmt); \
+    if (pixels_cmt) free(pixels_cmt); \
+    return(status); }
+
+/*
+ * This function parses an Xpm file or data and store the found informations
+ * in an an xpmInternAttrib structure which is returned.
+ */
+int
+xpmParseData(data, attrib_return, attributes)
+    xpmData *data;
+    xpmInternAttrib *attrib_return;
+    XpmAttributes *attributes;
+{
+    /* variables to return */
+    unsigned int width, height, ncolors, cpp;
+    unsigned int x_hotspot, y_hotspot, hotspot = 0, extensions = 0;
+    char ***colorTable = NULL;
+    unsigned int *pixelindex = NULL;
+    char *hints_cmt = NULL;
+    char *colors_cmt = NULL;
+    char *pixels_cmt = NULL;
+
+    int ErrorStatus;
+    xpmHashTable hashtable;
+
+    /*
+     * read values
+     */
+    ErrorStatus = ParseValues(data, &width, &height, &ncolors, &cpp,
+			      &x_hotspot, &y_hotspot, &hotspot, &extensions);
+    if (ErrorStatus != XpmSuccess)
+	return(ErrorStatus);
+
+    /*
+     * store the hints comment line 
+     */
+    if (attributes && (attributes->valuemask & XpmReturnInfos))
+	xpmGetCmt(data, &hints_cmt);
+
+    /*
+     * init the hastable
+     */
+    if (USE_HASHTABLE) {
+	ErrorStatus = xpmHashTableInit(&hashtable);
+	if (ErrorStatus != XpmSuccess)
+	    return(ErrorStatus);
+    }
+    
+    /*
+     * read colors 
+     */
+    ErrorStatus = ParseColors(data, ncolors, cpp, &colorTable, &hashtable);
+    if (ErrorStatus != XpmSuccess)
+	RETURN(ErrorStatus);
+
+    /*
+     * store the colors comment line 
+     */
+    if (attributes && (attributes->valuemask & XpmReturnInfos))
+	xpmGetCmt(data, &colors_cmt);
+
+    /*
+     * read pixels and index them on color number 
+     */
+    ErrorStatus = ParsePixels(data, width, height, ncolors, cpp, colorTable,
+			      &hashtable, &pixelindex);
+
+    /*
+     * free the hastable
+     */
+    if (USE_HASHTABLE)
+	xpmHashTableFree(&hashtable);
+    
+    if (ErrorStatus != XpmSuccess)
+	RETURN(ErrorStatus);
+
+    /*
+     * store the pixels comment line 
+     */
+    if (attributes && (attributes->valuemask & XpmReturnInfos))
+	xpmGetCmt(data, &pixels_cmt);
+
+    /*
+     * parse extensions
+     */
+    if (attributes && (attributes->valuemask & XpmReturnExtensions)) 
+	if (extensions) {
+	    ErrorStatus = ParseExtensions(data, &attributes->extensions,
+					  &attributes->nextensions);
+	    if (ErrorStatus != XpmSuccess)
+		RETURN(ErrorStatus);
+	} else {
+	    attributes->extensions = NULL;
+	    attributes->nextensions = 0;
+	}
+
+    /*
+     * store found informations in the xpmInternAttrib structure 
+     */
+    attrib_return->width = width;
+    attrib_return->height = height;
+    attrib_return->cpp = cpp;
+    attrib_return->ncolors = ncolors;
+    attrib_return->colorTable = colorTable;
+    attrib_return->pixelindex = pixelindex;
+
+    if (attributes) {
+	if (attributes->valuemask & XpmReturnInfos) {
+	    attributes->hints_cmt = hints_cmt;
+	    attributes->colors_cmt = colors_cmt;
+	    attributes->pixels_cmt = pixels_cmt;
+	}
+	if (hotspot) {
+	    attributes->x_hotspot = x_hotspot;
+	    attributes->y_hotspot = y_hotspot;
+	    attributes->valuemask |= XpmHotspot;
+	}
+    }
+    return (XpmSuccess);
+}
+
+static int
+ParseValues(data, width, height, ncolors, cpp,
+	    x_hotspot, y_hotspot, hotspot, extensions)
+    xpmData *data;
+    unsigned int *width, *height, *ncolors, *cpp;
+    unsigned int *x_hotspot, *y_hotspot,  *hotspot;
+    unsigned int *extensions;
+{
+    unsigned int l;
+    char buf[BUFSIZ];
+
+    /*
+     * read values: width, height, ncolors, chars_per_pixel 
+     */
+    if (!(xpmNextUI(data, width) && xpmNextUI(data, height)
+	  && xpmNextUI(data, ncolors) && xpmNextUI(data, cpp)))
+	return(XpmFileInvalid);
+
+    /*
+     * read optional information (hotspot and/or XPMEXT) if any 
+     */
+    l = xpmNextWord(data, buf);
+    if (l) {
+	*extensions = l == 6 && !strncmp("XPMEXT", buf, 6);
+	if (*extensions)
+	    *hotspot = xpmNextUI(data, x_hotspot)
+		&& xpmNextUI(data, y_hotspot);
+	else {
+	    *hotspot = atoui(buf, l, x_hotspot) && xpmNextUI(data, y_hotspot);
+	    l = xpmNextWord(data, buf);
+	    *extensions = l == 6 && !strncmp("XPMEXT", buf, 6);
+	}
+    }
+    return (XpmSuccess);
+}
+
+static int
+ParseColors(data, ncolors, cpp, colorTablePtr, hashtable)
+    xpmData *data;
+    unsigned int ncolors;
+    unsigned int cpp;
+    char ****colorTablePtr;		/* Jee, that's something! */
+    xpmHashTable *hashtable;
+{
+    unsigned int key, l, a, b;
+    unsigned int curkey;		/* current color key */
+    unsigned int lastwaskey;		/* key read */
+    char buf[BUFSIZ];
+    char curbuf[BUFSIZ];		/* current buffer */
+    char ***ct, **cts, **sptr, *s;
+    char ***colorTable;
+    int ErrorStatus;
+
+    colorTable = (char ***) calloc(ncolors, sizeof(char **));
+    if (!colorTable)
+	return(XpmNoMemory);
+
+    for (a = 0, ct = colorTable; a < ncolors; a++, ct++) {
+	xpmNextString(data);		/* skip the line */
+	cts = *ct = (char **) calloc((NKEYS + 1), sizeof(char *));
+	if (!cts) {
+	    xpmFreeColorTable(colorTable, ncolors);
+	    return(XpmNoMemory);
+	}
+
+	/*
+	 * read pixel value 
+	 */
+	*cts = (char *) malloc(cpp + 1); /* + 1 for null terminated */
+	if (!*cts) {
+	    xpmFreeColorTable(colorTable, ncolors);
+	    return(XpmNoMemory);
+	}
+	for (b = 0, s = *cts; b < cpp; b++, s++)
+	    *s = xpmGetC(data);
+	*s = '\0';
+
+	/*
+	 * store the string in the hashtable with its color index number
+	 */
+	if (USE_HASHTABLE) {
+	    ErrorStatus = xpmHashIntern(hashtable, *cts, HashAtomData((long)a));
+	    if (ErrorStatus != XpmSuccess) {
+		xpmFreeColorTable(colorTable, ncolors);
+		return(ErrorStatus);
+	    }
+	}
+
+	/*
+	 * read color keys and values 
+	 */
+	curkey = 0;
+	lastwaskey = 0;
+	while (l = xpmNextWord(data, buf)) {
+	    if (!lastwaskey) {
+		for (key = 0, sptr = xpmColorKeys; key < NKEYS; key++, sptr++)
+		    if ((strlen(*sptr) == l) && (!strncmp(*sptr, buf, l)))
+			break;
+	    }
+	    if (!lastwaskey && key < NKEYS) { /* open new key */
+		if (curkey) {		/* flush string */
+		    s = cts[curkey] = (char *) malloc(strlen(curbuf) + 1);
+		    if (!s) {
+			xpmFreeColorTable(colorTable, ncolors);
+			return(XpmNoMemory);
+		    }
+		    strcpy(s, curbuf);
+		}
+		curkey = key + 1;	/* set new key  */
+		*curbuf = '\0';		/* reset curbuf */
+		lastwaskey = 1;
+	    } else {
+		if (!curkey) {		/* key without value */
+		    xpmFreeColorTable(colorTable, ncolors);
+		    return(XpmFileInvalid);
+		}
+		if (!lastwaskey)
+		    strcat(curbuf, " "); /* append space */
+		buf[l] = '\0';
+		strcat(curbuf, buf);	/* append buf */
+		lastwaskey = 0;
+	    }
+	}
+	if (!curkey) {			/* key without value */
+	    xpmFreeColorTable(colorTable, ncolors);
+	    return(XpmFileInvalid);
+	}
+	s = cts[curkey] = (char *) malloc(strlen(curbuf) + 1);
+	if (!s) {
+	    xpmFreeColorTable(colorTable, ncolors);
+	    return(XpmNoMemory);
+	}
+	strcpy(s, curbuf);
+    }
+    *colorTablePtr = colorTable;
+    return(XpmSuccess);
+}
+
+static int
+ParsePixels(data, width, height, ncolors, cpp, colorTable, hashtable, pixels)
+    xpmData *data;
+    unsigned int width;
+    unsigned int height;
+    unsigned int ncolors;
+    unsigned int cpp;
+    char ***colorTable;
+    xpmHashTable *hashtable;
+    unsigned int **pixels;
+{
+    unsigned int *iptr, *iptr2;
+    unsigned int a, x, y;
+
+    iptr2 = (unsigned int *) malloc(sizeof(unsigned int) * width * height);
+    if (!iptr2)
+	return(XpmNoMemory);
+
+    iptr = iptr2;
+
+    switch (cpp) {
+
+       case (1): /* Optimize for single character colors */
+       {
+	   unsigned short colidx[256];
+
+	   bzero(colidx, 256 * sizeof(short));
+	   for (a = 0; a < ncolors; a++)
+	       colidx[ colorTable[a][0][0] ] = a + 1;
+                
+	   for (y = 0; y < height; y++) 
+	   {
+	       xpmNextString(data);
+	       for (x = 0; x < width; x++, iptr++)
+	       {
+		   int idx = colidx[xpmGetC(data)];
+		   if ( idx != 0 )
+		       *iptr = idx - 1;
+		   else {
+		       free(iptr2);
+		       return(XpmFileInvalid);
+		   }
+	       }
+	   }
+       }
+       break;
+
+       case (2): /* Optimize for double character colors */
+       {
+	   unsigned short cidx[256][256];
+
+	   bzero(cidx, 256*256 * sizeof(short));
+	   for (a = 0; a < ncolors; a++)
+	       cidx [ colorTable[a][0][0] ][ colorTable[a][0][1] ] = a + 1;
+
+	   for (y = 0; y < height; y++) 
+	   {
+	       xpmNextString(data);
+	       for (x = 0; x < width; x++, iptr++)
+	       {
+		   int cc1 = xpmGetC(data);
+		   int idx = cidx[cc1][ xpmGetC(data) ];
+		   if ( idx != 0 )
+		       *iptr = idx - 1;
+		   else {
+		       free(iptr2);
+		       return(XpmFileInvalid);
+		   }
+	       }
+	   }
+       }
+       break;
+
+       default : /* Non-optimized case of long color names */
+       {
+	   char *s;
+	   char buf[BUFSIZ];
+
+	   buf[cpp] = '\0';
+	   if (USE_HASHTABLE) {
+	       xpmHashAtom *slot;
+
+	       for (y = 0; y < height; y++) {
+		   xpmNextString(data);
+		   for (x = 0; x < width; x++, iptr++) {
+		       for (a = 0, s = buf; a < cpp; a++, s++)
+			   *s = xpmGetC(data);
+		       slot = xpmHashSlot(hashtable, buf);
+		       if (!*slot) {		/* no color matches */
+			   free(iptr2);
+			   return(XpmFileInvalid);
+		       }
+		       *iptr = HashColorIndex(slot);
+		   }
+	       }
+	   } else {
+	       for (y = 0; y < height; y++) {
+		   xpmNextString(data);
+		   for (x = 0; x < width; x++, iptr++) {
+		       for (a = 0, s = buf; a < cpp; a++, s++)
+			   *s = xpmGetC(data);
+		       for (a = 0; a < ncolors; a++)
+			   if (!strcmp(colorTable[a][0], buf))
+			       break;
+		       if (a == ncolors) {	/* no color matches */
+			   free(iptr2);
+			   return(XpmFileInvalid);
+		       }
+		       *iptr = a;
+		   }
+	       }
+	   }
+       }
+       break;
+   }
+    *pixels = iptr2;
+    return (XpmSuccess);
+}
+
+static int
+ParseExtensions(data, extensions, nextensions)
+    xpmData *data;
+    XpmExtension **extensions;
+    unsigned int *nextensions;
+{
+    XpmExtension *exts = NULL, *ext;
+    unsigned int num = 0;
+    unsigned int nlines, a, l, notstart, notend = 0;
+    int status;
+    char *string, *s, *s2, **sp;
+
+    xpmNextString(data);
+    exts = (XpmExtension *) malloc(sizeof(XpmExtension));
+    /* get the whole string */
+    status = xpmGetString(data, &string, &l);
+    if (status != XpmSuccess) {
+	free(exts);
+	return(status);
+    }
+    /* look for the key word XPMEXT, skip lines before this */
+    while ((notstart = strncmp("XPMEXT", string, 6))
+	   && (notend = strncmp("XPMENDEXT", string, 9))) {
+	free(string);
+	xpmNextString(data);
+	status = xpmGetString(data, &string, &l);
+	if (status != XpmSuccess) {
+	    free(exts);
+	    return(status);
+	}
+    }
+    if (!notstart)
+	notend = strncmp("XPMENDEXT", string, 9);
+    while (!notstart && notend) {
+	/* there starts an extension */
+	ext = (XpmExtension *) realloc(exts, (num + 1) * sizeof(XpmExtension));
+	if (!ext) {
+	    free(string);
+	    XpmFreeExtensions(exts, num);
+	    return(XpmNoMemory);
+	}
+	exts = ext;
+	ext += num;
+	/* skip whitespace and store its name */
+	s2 = s = string + 6;
+	while (isspace(*s2))
+	    s2++;
+	a = s2 - s;
+	ext->name = (char *) malloc(l - a - 6);
+	if (!ext->name) {
+	    free(string);
+	    ext->lines = NULL;
+	    ext->nlines = 0;
+	    XpmFreeExtensions(exts, num + 1);
+	    return(XpmNoMemory);
+	}
+	strncpy(ext->name, s + a, l - a - 6);
+	free(string);
+	/* now store the related lines */
+	xpmNextString(data);
+	status = xpmGetString(data, &string, &l);
+	if (status != XpmSuccess) {
+	    ext->lines = NULL;
+	    ext->nlines = 0;
+	    XpmFreeExtensions(exts, num + 1);
+	    return(status);
+	}
+	ext->lines = (char **) malloc(sizeof(char *));
+	nlines = 0;
+	while ((notstart = strncmp("XPMEXT", string, 6))
+	       && (notend = strncmp("XPMENDEXT", string, 9))) {
+	    sp = (char **) realloc(ext->lines, (nlines + 1) * sizeof(char *));
+	    if (!sp) {
+		free(string);
+		ext->nlines = nlines;
+		XpmFreeExtensions(exts, num + 1);
+		return(XpmNoMemory);
+	    }
+	    ext->lines = sp;
+	    ext->lines[nlines] = string;
+	    nlines++;
+	    xpmNextString(data);
+	    status = xpmGetString(data, &string, &l);
+	    if (status != XpmSuccess) {
+		ext->nlines = nlines;
+		XpmFreeExtensions(exts, num + 1);
+		return(status);
+	    }
+	}
+	if (!nlines) {
+	    free(ext->lines);
+	    ext->lines = NULL;
+	}
+	ext->nlines = nlines;
+	num++;
+    }
+    if (!num) {
+	free(string);
+	free(exts);
+	exts = NULL;
+    } else if (!notend)
+	free(string);
+    *nextensions = num;
+    *extensions = exts;
+    return(XpmSuccess);
+}
diff --git a/src/xpm/rename b/src/xpm/rename
new file mode 100755
index 0000000..a767d5e
--- /dev/null
+++ b/src/xpm/rename
@@ -0,0 +1,24 @@
+#!/bin/sh
+# rename is provided to easily update code using sed-command files
+
+USAGE='rename sed-command-file file1 file2...
+    apply all sed-command-file to the files file1 file2
+'
+
+if test "$1" = '-?'; then echo "$USAGE";exit 1;fi
+commands=$1
+shift
+
+for i in $*
+do if test -f $i
+   then echo -n "$i: "
+	echo -n "."
+	sed -f $commands $i > /tmp/rename.sed.$$;
+	if test ! -s /tmp/rename.sed.$$; then rm /tmp/rename.sed.$$; exit 1;fi
+	if cmp /tmp/rename.sed.$$ $i >/dev/null; then echo 
+	else cp $i $i.BAK; cp /tmp/rename.sed.$$ $i; echo " modified."
+	fi
+   fi
+done
+
+rm -f /tmp/rename.sed.$$ /tmp/rename.sed.$$.org
diff --git a/src/xpm/rgb.c b/src/xpm/rgb.c
new file mode 100644
index 0000000..6694a60
--- /dev/null
+++ b/src/xpm/rgb.c
@@ -0,0 +1,136 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* rgb.c:                                                                      *
+*                                                                             *
+*  XPM library                                                                *
+*  Rgb file utilities                                                         *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+/*
+ * Part of this code has been taken from the ppmtoxpm.c file written by Mark
+ * W. Snitily but has been modified for my special need
+ */
+
+#include "xpmP.h"
+#ifdef VMS
+#include "sys$library:ctype.h"
+#include "sys$library:string.h"
+#else
+#include <ctype.h>
+#if defined(SYSV) || defined(SVR4)
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#endif
+
+/*
+ * Read a rgb text file.  It stores the rgb values (0->65535)
+ * and the rgb mnemonics (malloc'ed) into the "rgbn" array.  Returns the
+ * number of entries stored. 
+ */
+int
+xpmReadRgbNames(rgb_fname, rgbn)
+    char *rgb_fname;
+    xpmRgbName rgbn[];
+
+{
+    FILE *rgbf;
+    int i, items, red, green, blue;
+    char line[512], name[512], *rgbname, *n, *m;
+    xpmRgbName *rgb;
+
+    /* Open the rgb text file.  Abort if error. */
+    if ((rgbf = fopen(rgb_fname, "r")) == NULL)
+	return 0;
+
+    /* Loop reading each line in the file. */
+    for (i = 0, rgb = rgbn; fgets(line, sizeof(line), rgbf); i++, rgb++) {
+
+	/* Quit if rgb text file is too large. */
+	if (i == MAX_RGBNAMES) {
+	    /* Too many entries in rgb text file, give up here */
+	    break;
+	}
+	/* Read the line.  Skip silently if bad. */
+	items = sscanf(line, "%d %d %d %[^\n]\n", &red, &green, &blue, name);
+	if (items != 4) {
+	    i--;
+	    continue;
+	}
+
+	/*
+	 * Make sure rgb values are within 0->255 range. Skip silently if
+	 * bad. 
+	 */
+	if (red < 0 || red > 0xFF ||
+	    green < 0 || green > 0xFF ||
+	    blue < 0 || blue > 0xFF) {
+	    i--;
+	    continue;
+	}
+	/* Allocate memory for ascii name. If error give up here. */
+	if (!(rgbname = (char *) malloc(strlen(name) + 1)))
+	    break;
+
+	/* Copy string to ascii name and lowercase it. */
+	for (n = name, m = rgbname; *n; n++)
+	    *m++ = isupper(*n) ? tolower(*n) : *n;
+	*m = '\0';
+
+	/* Save the rgb values and ascii name in the array. */
+	rgb->r = red * 257;		/* 65535/255 = 257 */
+	rgb->g = green * 257;
+	rgb->b = blue * 257;
+	rgb->name = rgbname;
+    }
+
+    fclose(rgbf);
+
+    /* Return the number of read rgb names. */
+    return i < 0 ? 0 : i;
+}
+
+/*
+ * Return the color name corresponding to the given rgb values
+ */
+char *
+xpmGetRgbName(rgbn, rgbn_max, red, green, blue)
+    xpmRgbName rgbn[];			/* rgb mnemonics from rgb text file */
+int rgbn_max;				/* number of rgb mnemonics in table */
+int red, green, blue;			/* rgb values */
+
+{
+    int i;
+    xpmRgbName *rgb;
+
+    /*
+     * Just perform a dumb linear search over the rgb values of the color
+     * mnemonics.  One could speed things up by sorting the rgb values and
+     * using a binary search, or building a hash table, etc... 
+     */
+    for (i = 0, rgb = rgbn; i < rgbn_max; i++, rgb++)
+	if (red == rgb->r && green == rgb->g && blue == rgb->b)
+	    return rgb->name;
+
+    /* if not found return NULL */
+    return NULL;
+}
+
+/*
+ * Free the strings which have been malloc'ed in xpmReadRgbNames
+ */
+void
+xpmFreeRgbNames(rgbn, rgbn_max)
+    xpmRgbName rgbn[];
+int rgbn_max;
+
+{
+    int i;
+    xpmRgbName *rgb;
+
+    for (i = 0, rgb = rgbn; i < rgbn_max; i++, rgb++)
+	free(rgb->name);
+}
diff --git a/src/xpm/scan.c b/src/xpm/scan.c
new file mode 100644
index 0000000..2cee34c
--- /dev/null
+++ b/src/xpm/scan.c
@@ -0,0 +1,567 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* scan.c:                                                                     *
+*                                                                             *
+*  XPM library                                                                *
+*  Scanning utility for XPM file format                                        *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#include "xpmP.h"
+
+#define MAXPRINTABLE 93			/* number of printable ascii chars
+					 * minus \ and " for string compat
+					 * and / to avoid comment conflicts. */
+
+static char *printable =
+" .XoO+@#$%&*=-;:?>,<1234567890qwertyuipasdfghjklzxcvbnmMNBVCZ\
+ASDFGHJKLPIUYTREWQ!~^/()_`'][{}|";
+
+ /*
+  * printable begin with a space, so in most case, due to my algorithm, when
+  * the number of different colors is less than MAXPRINTABLE, it will give a
+  * char follow by "nothing" (a space) in the readable xpm file 
+  */
+
+
+typedef struct {
+    Pixel *pixels;
+    unsigned int *pixelindex;
+    unsigned int size;
+    unsigned int ncolors;
+    unsigned int mask_pixel;		/* whether there is or not */
+}      PixelsMap;
+
+LFUNC(storePixel, int, (Pixel pixel, PixelsMap * pmap,
+			unsigned int *index_return));
+
+LFUNC(storeMaskPixel, int, (Pixel pixel, PixelsMap * pmap,
+			    unsigned int *index_return));
+
+LFUNC(GetImagePixels, int, (XImage * image, unsigned int width,
+			    unsigned int height, PixelsMap * pmap));
+
+LFUNC(GetImagePixels32, int, (XImage * image, unsigned int width,
+			      unsigned int height, PixelsMap * pmap));
+
+LFUNC(GetImagePixels16, int, (XImage * image, unsigned int width,
+			      unsigned int height, PixelsMap * pmap));
+
+LFUNC(GetImagePixels8, int, (XImage * image, unsigned int width,
+			     unsigned int height, PixelsMap * pmap));
+
+LFUNC(GetImagePixels1, int, (XImage * image, unsigned int width,
+			     unsigned int height, PixelsMap * pmap,
+			     int (*storeFunc) ()));
+
+/*
+ * This function stores the given pixel in the given arrays which are grown
+ * if not large enough.
+ */
+static int
+storePixel(pixel, pmap, index_return)
+    Pixel pixel;
+    PixelsMap *pmap;
+    unsigned int *index_return;
+{
+    register unsigned int a;
+    register Pixel *p;
+    register unsigned int ncolors;
+
+    if (*index_return) {		/* this is a transparent pixel! */
+	*index_return = 0;
+	return 0;
+    }
+    ncolors = pmap->ncolors;
+    p = &(pmap->pixels[pmap->mask_pixel]);
+    for (a = pmap->mask_pixel; a < ncolors; a++, p++)
+	if (*p == pixel)
+	    break;
+    if (a == ncolors) {
+	if (ncolors > pmap->size) {
+
+	    pmap->size *= 2;
+	    p = (Pixel *) realloc(pmap->pixels, sizeof(Pixel) * pmap->size);
+	    if (!p)
+		return (1);
+	    pmap->pixels = p;
+
+	}
+	(pmap->pixels)[ncolors] = pixel;
+	pmap->ncolors++;
+    }
+    *index_return = a;
+    return 0;
+}
+
+static int
+storeMaskPixel(pixel, pmap, index_return)
+    Pixel pixel;
+    PixelsMap *pmap;
+    unsigned int *index_return;
+{
+    if (!pixel) {
+	if (!pmap->ncolors) {
+	    pmap->ncolors = 1;
+	    (pmap->pixels)[0] = 0;
+	    pmap->mask_pixel = 1;
+	}
+	*index_return = 1;
+    } else
+	*index_return = 0;
+    return 0;
+}
+
+/* function call in case of error, frees only locally allocated variables */
+#undef RETURN
+#define RETURN(status) \
+  { if (pmap.pixelindex) free(pmap.pixelindex); \
+    if (pmap.pixels) free(pmap.pixels); \
+    if (xcolors) free(xcolors); \
+    if (colorStrings) { \
+	for (a = 0; a < pmap.ncolors; a++) \
+	    if (colorStrings[a]) \
+		free(colorStrings[a]); \
+	free(colorStrings); \
+    } \
+    return(status); }
+
+/*
+ * This function scans the given image and stores the found informations in
+ * the xpmInternAttrib structure which is returned.
+ */
+int
+xpmScanImage(display, image, shapeimage, attributes, attrib)
+    Display *display;
+    XImage *image;
+    XImage *shapeimage;
+    XpmAttributes *attributes;
+    xpmInternAttrib *attrib;
+
+{
+    /* variables stored in the XpmAttributes structure */
+    Colormap colormap;
+    unsigned int cpp;
+
+    /* variables to return */
+    PixelsMap pmap;
+    char **colorStrings = NULL;
+    XColor *xcolors = NULL;
+    int ErrorStatus;
+
+    /* calculation variables */
+    unsigned int width = 0;
+    unsigned int height = 0;
+    unsigned int cppm;			/* minimum chars per pixel */
+    unsigned int a, b, c;
+    register char *s;
+
+    /* initialize pmap */
+    pmap.pixels = NULL;
+    pmap.pixelindex = NULL;
+    pmap.size = 256;			/* should be enough most of the time */
+    pmap.ncolors = 0;
+    pmap.mask_pixel = 0;
+
+    /*
+     * get geometry 
+     */
+    if (image) {
+	width = image->width;
+	height = image->height;
+    } else if (shapeimage) {
+	width = shapeimage->width;
+	height = shapeimage->height;
+    }
+
+    /*
+     * retrieve information from the XpmAttributes 
+     */
+    if (attributes && attributes->valuemask & XpmColormap)
+	colormap = attributes->colormap;
+    else
+	colormap = DefaultColormap(display, DefaultScreen(display));
+
+    if (attributes && (attributes->valuemask & XpmCharsPerPixel
+		       || attributes->valuemask & XpmInfos))
+	cpp = attributes->cpp;
+    else
+	cpp = 0;
+
+    pmap.pixelindex =
+	(unsigned int *) calloc(width * height, sizeof(unsigned int));
+    if (!pmap.pixelindex)
+	RETURN(XpmNoMemory);
+
+    pmap.pixels = (Pixel *) malloc(sizeof(Pixel) * pmap.size);
+    if (!pmap.pixels)
+	RETURN(XpmNoMemory);
+
+    /*
+     * scan shape mask if any 
+     */
+    if (shapeimage) {
+	ErrorStatus = GetImagePixels1(shapeimage, width, height, &pmap,
+				      storeMaskPixel);
+	if (ErrorStatus != XpmSuccess)
+	    RETURN(ErrorStatus);
+    }
+
+    /*
+     * scan the image data 
+     *
+     * In case depth is 1 or bits_per_pixel is 4, 6, 8, 24 or 32 use optimized
+     * functions, otherwise use slower but sure general one. 
+     *
+     */
+
+    if (image) {
+	if (image->depth == 1)
+	    ErrorStatus = GetImagePixels1(image, width, height, &pmap,
+					  storePixel);
+	else if (image->bits_per_pixel == 8)
+	    ErrorStatus = GetImagePixels8(image, width, height, &pmap);
+	else if (image->bits_per_pixel == 16)
+	    ErrorStatus = GetImagePixels16(image, width, height, &pmap);
+	else if (image->bits_per_pixel == 32)
+	    ErrorStatus = GetImagePixels32(image, width, height, &pmap);
+	else
+	    ErrorStatus = GetImagePixels(image, width, height, &pmap);
+
+	if (ErrorStatus != XpmSuccess)
+	    RETURN(ErrorStatus);
+    }
+
+    /*
+     * get rgb values and a string of char for each color 
+     */
+
+    xcolors = (XColor *) malloc(sizeof(XColor) * pmap.ncolors);
+    if (!xcolors)
+	RETURN(XpmNoMemory);
+    colorStrings = (char **) calloc(pmap.ncolors, sizeof(char *));
+    if (!colorStrings)
+	RETURN(XpmNoMemory);
+
+    for (cppm = 1, c = MAXPRINTABLE; pmap.ncolors > c; cppm++)
+	c *= MAXPRINTABLE;
+    if (cpp < cppm)
+	cpp = cppm;
+
+    for (a = 0; a < pmap.ncolors; a++) {
+	if (!(s = colorStrings[a] = (char *) malloc(cpp)))
+	    RETURN(XpmNoMemory);
+	*s++ = printable[c = a % MAXPRINTABLE];
+	for (b = 1; b < cpp; b++, s++)
+	    *s = printable[c = ((a - c) / MAXPRINTABLE) % MAXPRINTABLE];
+	xcolors[a].pixel = pmap.pixels[a];
+    }
+
+    XQueryColors(display, colormap, xcolors, pmap.ncolors);
+
+    /*
+     * store found informations in the xpmInternAttrib structure 
+     */
+    attrib->width = width;
+    attrib->height = height;
+    attrib->cpp = cpp;
+    attrib->ncolors = pmap.ncolors;
+    attrib->mask_pixel = pmap.mask_pixel ? 0 : UNDEF_PIXEL;
+    attrib->pixelindex = pmap.pixelindex;
+    attrib->xcolors = xcolors;
+    attrib->colorStrings = colorStrings;
+
+    free(pmap.pixels);
+    return (XpmSuccess);
+}
+
+
+
+/*
+ * The functions below are written from X11R5 MIT's code (XImUtil.c)
+ *
+ * The idea is to have faster functions than the standard XGetPixel function
+ * to scan the image data. Indeed we can speed up things by suppressing tests
+ * performed for each pixel. We do exactly the same tests but at the image
+ * level. Assuming that we use only ZPixmap images. 
+ */
+
+static unsigned long Const low_bits_table[] = {
+			    0x00000000, 0x00000001, 0x00000003, 0x00000007,
+			    0x0000000f, 0x0000001f, 0x0000003f, 0x0000007f,
+			    0x000000ff, 0x000001ff, 0x000003ff, 0x000007ff,
+			    0x00000fff, 0x00001fff, 0x00003fff, 0x00007fff,
+			    0x0000ffff, 0x0001ffff, 0x0003ffff, 0x0007ffff,
+			    0x000fffff, 0x001fffff, 0x003fffff, 0x007fffff,
+			    0x00ffffff, 0x01ffffff, 0x03ffffff, 0x07ffffff,
+			    0x0fffffff, 0x1fffffff, 0x3fffffff, 0x7fffffff,
+					       0xffffffff
+};
+
+/*
+ * Default method to scan pixels of a Z image data structure.
+ * The algorithm used is:
+ *
+ *	copy the source bitmap_unit or Zpixel into temp
+ *	normalize temp if needed
+ *	extract the pixel bits into return value
+ *
+ */
+
+static int
+GetImagePixels(image, width, height, pmap)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    PixelsMap *pmap;
+{
+    register char *src;
+    register char *dst;
+    register unsigned int *iptr;
+    register char *data;
+    register int x, y, i;
+    int bits, depth, ibu, ibpp;
+    unsigned long lbt;
+    Pixel pixel, px;
+
+    data = image->data;
+    iptr = pmap->pixelindex;
+    depth = image->depth;
+    lbt = low_bits_table[depth];
+    ibpp = image->bits_per_pixel;
+    if (image->depth == 1) {
+	ibu = image->bitmap_unit;
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		src = &data[XYINDEX(x, y, image)];
+		dst = (char *) &pixel;
+		pixel = 0;
+		for (i = ibu >> 3; --i >= 0;)
+		    *dst++ = *src++;
+		XYNORMALIZE(&pixel, image);
+		bits = x % ibu;
+		pixel = ((((char *) &pixel)[bits >> 3]) >> (bits & 7)) & 1;
+		if (ibpp != depth)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    } else {
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		src = &data[ZINDEX(x, y, image)];
+		dst = (char *) &px;
+		px = 0;
+		for (i = (ibpp + 7) >> 3; --i >= 0;)
+		    *dst++ = *src++;
+		ZNORMALIZE(&px, image);
+		pixel = 0;
+		for (i = sizeof(unsigned long); --i >= 0;)
+		    pixel = (pixel << 8) | ((unsigned char *) &px)[i];
+		if (ibpp == 4) {
+		    if (x & 1)
+			pixel >>= 4;
+		    else
+			pixel &= 0xf;
+		}
+		if (ibpp != depth)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    }
+    return(XpmSuccess);
+}
+
+/*
+ * scan pixels of a 32-bits Z image data structure
+ */
+
+#ifndef WORD64
+static unsigned long byteorderpixel = MSBFirst << 24;
+
+#endif
+
+static int
+GetImagePixels32(image, width, height, pmap)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    PixelsMap *pmap;
+{
+    register unsigned char *addr;
+    register unsigned char *data;
+    register unsigned int *iptr;
+    register int x, y;
+    unsigned long lbt;
+    Pixel pixel;
+    int depth;
+
+    data = (unsigned char *) image->data;
+    iptr = pmap->pixelindex;
+    depth = image->depth;
+    lbt = low_bits_table[depth];
+#ifndef WORD64
+    if (*((char *) &byteorderpixel) == image->byte_order) {
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		pixel = *((unsigned long *)addr);
+		if (depth != 32)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    } else
+#endif
+    if (image->byte_order == MSBFirst)
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		pixel = ((unsigned long) addr[0] << 24 |
+			 (unsigned long) addr[1] << 16 |
+			 (unsigned long) addr[2] << 8 |
+			 addr[4]);
+		if (depth != 32)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    else
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX32(x, y, image)];
+		pixel = (addr[0] |
+			 (unsigned long) addr[1] << 8 |
+			 (unsigned long) addr[2] << 16 |
+			 (unsigned long) addr[3] << 24);
+		if (depth != 32)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    return(XpmSuccess);
+}
+
+/*
+ * scan pixels of a 16-bits Z image data structure
+ */
+
+static int
+GetImagePixels16(image, width, height, pmap)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    PixelsMap *pmap;
+{
+    register unsigned char *addr;
+    register unsigned char *data;
+    register unsigned int *iptr;
+    register int x, y;
+    unsigned long lbt;
+    Pixel pixel;
+    int depth;
+
+    data = (unsigned char *) image->data;
+    iptr = pmap->pixelindex;
+    depth = image->depth;
+    lbt = low_bits_table[depth];
+    if (image->byte_order == MSBFirst)
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX16(x, y, image)];
+		pixel = addr[0] << 8 | addr[1];
+		if (depth != 16)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    else
+	for (y = 0; y < height; y++)
+	    for (x = 0; x < width; x++, iptr++) {
+		addr = &data[ZINDEX16(x, y, image)];
+		pixel = addr[0] | addr[1] << 8;
+		if (depth != 16)
+		    pixel &= lbt;
+		if (storePixel(pixel, pmap, iptr))
+		    return (XpmNoMemory);
+	    }
+    return(XpmSuccess);
+}
+
+/*
+ * scan pixels of a 8-bits Z image data structure
+ */
+
+static int
+GetImagePixels8(image, width, height, pmap)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    PixelsMap *pmap;
+{
+    register unsigned int *iptr;
+    register unsigned char *data;
+    register int x, y;
+    unsigned long lbt;
+    Pixel pixel;
+    int depth;
+
+    data = (unsigned char *) image->data;
+    iptr = pmap->pixelindex;
+    depth = image->depth;
+    lbt = low_bits_table[depth];
+    for (y = 0; y < height; y++)
+	for (x = 0; x < width; x++, iptr++) {
+	    pixel = data[ZINDEX8(x, y, image)];
+	    if (depth != 8)
+		pixel &= lbt;
+	    if (storePixel(pixel, pmap, iptr))
+		return (XpmNoMemory);
+	}
+    return(XpmSuccess);
+}
+
+/*
+ * scan pixels of a 1-bit depth Z image data structure
+ */
+
+static int
+GetImagePixels1(image, width, height, pmap, storeFunc)
+    XImage *image;
+    unsigned int width;
+    unsigned int height;
+    PixelsMap *pmap;
+    int (*storeFunc) ();
+
+{
+    register unsigned int *iptr;
+    register int x, y;
+    register char *data;
+    Pixel pixel;
+
+    if (image->byte_order != image->bitmap_bit_order)
+	return(GetImagePixels(image, width, height, pmap));
+    else {
+	data = image->data;
+	iptr = pmap->pixelindex;
+	if (image->bitmap_bit_order == MSBFirst)
+	    for (y = 0; y < height; y++)
+		for (x = 0; x < width; x++, iptr++) {
+		    pixel = (data[ZINDEX1(x, y, image)] & (0x80 >> (x & 7)))
+			? 1 : 0;
+		    if ((*storeFunc) (pixel, pmap, iptr))
+			return (XpmNoMemory);
+		}
+	else
+	    for (y = 0; y < height; y++)
+		for (x = 0; x < width; x++, iptr++) {
+		    pixel = (data[ZINDEX1(x, y, image)] & (1 << (x & 7)))
+			? 1 : 0;
+		    if ((*storeFunc) (pixel, pmap, iptr))
+			return (XpmNoMemory);
+		}
+    }
+    return(XpmSuccess);
+}
diff --git a/src/xpm/sxpm.c b/src/xpm/sxpm.c
new file mode 100644
index 0000000..9ee3ad3
--- /dev/null
+++ b/src/xpm/sxpm.c
@@ -0,0 +1,580 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* sxpm.c:                                                                     *
+*                                                                             *
+*  Show XPM File program                                                      *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#ifdef VMS
+#include "decw$include:Xlib.h"
+#include "decw$include:Intrinsic.h"
+#include "decw$include:Shell.h"
+#include "decw$include:shape.h"
+#else
+#include <X11/StringDefs.h>
+#include <X11/Intrinsic.h>
+#include <X11/Shell.h>
+#include <X11/extensions/shape.h>
+#endif
+
+#include "xpm.h"
+
+#ifdef Debug
+/* memory leak control tool */
+#include <mnemosyne.h>
+#endif
+
+/* XPM */
+/* plaid pixmap */
+static char *plaid[] =
+{
+/* width height ncolors chars_per_pixel */
+ "22 22 4 2 XPMEXT",
+/* colors */
+ "   c red 	m white  s light_color",
+ "Y  c green	m black  s lines_in_mix",
+ "+  c yellow	m white  s lines_in_dark",
+ "x 		m black  s dark_color",
+/* pixels */
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "  x   x   x   x   x   x x x x x x x x x x x ",
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "  x   x   x   x   x   x x x x x x x x x x x ",
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "Y Y Y Y Y x Y Y Y Y Y + x + x + x + x + x + ",
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "  x   x   x   x   x   x x x x x x x x x x x ",
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "  x   x   x   x   x   x x x x x x x x x x x ",
+ "x   x   x x x   x   x x x x x x + x x x x x ",
+ "          x           x   x   x Y x   x   x ",
+ "          x             x   x   Y   x   x   ",
+ "          x           x   x   x Y x   x   x ",
+ "          x             x   x   Y   x   x   ",
+ "          x           x   x   x Y x   x   x ",
+ "x x x x x x x x x x x x x x x x x x x x x x ",
+ "          x           x   x   x Y x   x   x ",
+ "          x             x   x   Y   x   x   ",
+ "          x           x   x   x Y x   x   x ",
+ "          x             x   x   Y   x   x   ",
+ "          x           x   x   x Y x   x   x ",
+"bullshit",
+"XPMEXT ext1 data1",
+"XPMEXT ext2",
+"data2_1",
+"data2_2",
+"XPMEXT",
+"foo",
+"",
+"XPMEXT ext3",
+"data3",
+"XPMENDEXT"
+};
+
+#define win XtWindow(topw)
+#define dpy XtDisplay(topw)
+#define screen XtScreen(topw)
+#define root XRootWindowOfScreen(screen)
+#define xrdb XtDatabase(dpy)
+static Colormap colormap;
+
+void Usage();
+void ErrorMessage();
+void Punt();
+void kinput();
+
+#define IWIDTH      50
+#define IHEIGHT     50
+
+typedef struct _XpmIcon {
+    Pixmap pixmap;
+    Pixmap mask;
+    XpmAttributes attributes;
+} XpmIcon;
+
+static char **command;
+static Widget topw;
+static XpmIcon view, icon;
+static XrmOptionDescRec options[] = {
+    {"-hints", ".hints", XrmoptionNoArg, (XtPointer) "True"},
+    {"-icon", ".icon", XrmoptionSepArg, (XtPointer) NULL},
+};
+
+main(argc, argv)
+    int argc;
+    char **argv;
+{
+    int ErrorStatus;
+    unsigned int verbose = 0;
+    unsigned int stdinf = 1;
+    unsigned int stdoutf = 0;
+    unsigned int nod = 0;
+    unsigned int incResize = 0;
+    unsigned int resize = 0;
+    unsigned int w_rtn;
+    unsigned int h_rtn;
+    char *input = NULL;
+    char *output = NULL;
+    char *iconFile = NULL;
+    unsigned int numsymbols = 0;
+    XpmColorSymbol symbols[10];
+    char *stype;
+    XrmValue val;
+    unsigned long valuemask = 0;
+    int n;
+    Arg args[3];
+
+#ifdef Debug2
+    char **data;
+
+#endif
+
+    topw = XtInitialize(argv[0], "Sxpm",
+			options, XtNumber(options), &argc, argv);
+
+    if (!topw) {
+	fprintf(stderr, "Sxpm Error... [ Undefined DISPLAY ]\n");
+	exit(1);
+    }
+
+    colormap = XDefaultColormapOfScreen(screen);
+
+    /*
+     * geometry management 
+     */
+
+    if (XrmGetResource(xrdb, NULL, "sxpm.geometry", &stype, &val)
+	|| XrmGetResource(xrdb, NULL, "Sxpm.geometry", &stype, &val)) {
+
+	int flags;
+	int x_rtn;
+	int y_rtn;
+	char *geo = NULL;
+
+	geo = (char *) val.addr;
+	flags = XParseGeometry(geo, &x_rtn, &y_rtn,
+			       (unsigned int *) &w_rtn,
+			       (unsigned int *) &h_rtn);
+	if (!((WidthValue & flags) && (HeightValue & flags)))
+	    resize = 1;
+    } else
+	resize = 1;
+
+    n = 0;
+    if (resize) {
+	w_rtn = 0;
+	h_rtn = 0;
+	XtSetArg(args[n], XtNwidth, 1);
+	n++;
+	XtSetArg(args[n], XtNheight, 1);
+	n++;
+    }
+    XtSetArg(args[n], XtNmappedWhenManaged, False);
+    n++;
+    XtSetValues(topw, args, n);
+
+    if ((XrmGetResource(xrdb, "sxpm.hints", "", &stype, &val)
+	 || XrmGetResource(xrdb, "Sxpm.hints", "", &stype, &val))
+	&& !strcmp((char *) val.addr, "True")) {
+	/* gotcha */
+	incResize = 1;
+	resize = 1;
+    }
+
+    /*
+     * icon management 
+     */
+
+    if (XrmGetResource(xrdb, "sxpm.icon", "", &stype, &val) ||
+	XrmGetResource(xrdb, "Sxpm.icon", "", &stype, &val)) {
+	iconFile = (char *) val.addr;
+    }
+    if (iconFile) {
+
+	XColor color, junk;
+	Pixel bpix;
+	Window iconW;
+
+	if (XAllocNamedColor(dpy, colormap, "black", &color, &junk))
+	    bpix = color.pixel;
+	else
+	    bpix = XBlackPixelOfScreen(screen);
+
+	iconW = XCreateSimpleWindow(dpy, root, 0, 0,
+				    IWIDTH, IHEIGHT, 1, bpix, bpix);
+
+	icon.attributes.valuemask = XpmReturnPixels;
+	ErrorStatus = XpmReadFileToPixmap(dpy, root, iconFile, &icon.pixmap,
+					  &icon.mask, &icon.attributes);
+	ErrorMessage(ErrorStatus, "Icon");
+
+	XSetWindowBackgroundPixmap(dpy, iconW, icon.pixmap);
+
+	n = 0;
+	XtSetArg(args[n], XtNbackground, bpix);
+	n++;
+	XtSetArg(args[n], XtNiconWindow, iconW);
+	n++;
+	XtSetValues(topw, args, n);
+    }
+
+    /*
+     * arguments parsing 
+     */
+
+    command = argv;
+    for (n = 1; n < argc; n++) {
+	if (strncmp(argv[n], "-plaid", 3) == 0) {
+	    stdinf = 0;
+	    continue;
+	}
+	if (argv[n][0] != '-') {
+	    stdinf = 0;
+	    input = argv[n];
+	    continue;
+	}
+	if ((strlen(argv[n]) == 1) && (argv[n][0] == '-'))
+	    /* stdin */
+	    continue;
+	if (strncmp(argv[n], "-o", 2) == 0) {
+	    if (n < argc - 1) {
+		if ((strlen(argv[n + 1]) == 1) && (argv[n + 1][0] == '-'))
+		    stdoutf = 1;
+		else
+		    output = argv[n + 1];
+		n++;
+		continue;
+	    } else
+		Usage();
+	}
+        if (strncmp(argv[n], "-nod", 2) == 0) {
+            nod = 1;
+            continue;
+        }
+	if (strncmp(argv[n], "-s", 2) == 0) {
+	    if (n < argc - 2) {
+		valuemask |= XpmColorSymbols;
+		symbols[numsymbols].name = argv[++n];
+		symbols[numsymbols++].value = argv[++n];
+		continue;
+	    } else
+		Usage();
+	}
+	if (strncmp(argv[n], "-p", 2) == 0) {
+	    if (n < argc - 2) {
+		valuemask |= XpmColorSymbols;
+		symbols[numsymbols].name = argv[++n];
+		symbols[numsymbols].value = NULL;
+		symbols[numsymbols++].pixel = atol(argv[++n]);
+		continue;
+	    }
+	}
+	if (strcmp(argv[n], "-closecolors") == 0) {
+	    valuemask |= XpmCloseness;
+	    view.attributes.closeness = 40000;
+	    continue;
+	}
+	if (strncmp(argv[n], "-rgb", 3) == 0) {
+	    if (n < argc - 1) {
+		valuemask |= XpmRgbFilename;
+		view.attributes.rgb_fname = argv[++n];
+		continue;
+	    } else
+		Usage();
+
+	}
+        if (strncmp(argv[n], "-v", 2) == 0) {
+            verbose = 1;
+            continue;
+        }
+        if (strncmp(argv[n], "-c", 2) == 0) {
+	    valuemask |= XpmColormap;
+            continue;
+        }
+	Usage();
+    }
+
+    XtRealizeWidget(topw);
+    if (valuemask & XpmColormap) {
+	colormap = XCreateColormap(dpy, win,
+				   DefaultVisual(dpy, DefaultScreen(dpy)),
+				   AllocNone);
+	view.attributes.colormap = colormap;
+	XSetWindowColormap(dpy, win, colormap);
+    }
+    view.attributes.colorsymbols = symbols;
+    view.attributes.numsymbols = numsymbols;
+    view.attributes.valuemask = valuemask;
+
+#ifdef Debug2
+    /* this is just to test the XpmCreateDataFromPixmap function */
+
+    view.attributes.valuemask |= XpmReturnPixels;
+    view.attributes.valuemask |= XpmReturnExtensions;
+    ErrorStatus = XpmCreatePixmapFromData(dpy, win, plaid,
+					  &view.pixmap, &view.mask,
+					  &view.attributes);
+    ErrorMessage(ErrorStatus, "Plaid");
+
+    ErrorStatus = XpmCreateDataFromPixmap(dpy, &data, view.pixmap, view.mask,
+					  &view.attributes);
+    ErrorMessage(ErrorStatus, "Data");
+    if (verbose && view.attributes.nextensions) {
+	unsigned int i, j;
+	for (i = 0; i < view.attributes.nextensions; i++) {
+	    fprintf(stderr, "Xpm extension : %s\n",
+		    view.attributes.extensions[i].name);
+	    for (j = 0; j < view.attributes.extensions[i].nlines; j++)
+		fprintf(stderr, "\t\t%s\n",
+			view.attributes.extensions[i].lines[j]);
+	}
+    }
+
+    XFreePixmap(dpy, view.pixmap);
+    if (view.mask)
+	XFreePixmap(dpy, view.mask);
+
+    XFreeColors(dpy, colormap,
+		view.attributes.pixels, view.attributes.npixels, 0);
+
+    XpmFreeAttributes(&view.attributes);
+    view.attributes.valuemask = valuemask;
+#endif
+
+    if (input || stdinf) {
+	view.attributes.valuemask |= XpmReturnInfos;
+	view.attributes.valuemask |= XpmReturnPixels;
+	view.attributes.valuemask |= XpmReturnExtensions;
+
+#ifdef Debug2
+	free(data);
+
+	ErrorStatus = XpmReadFileToData(input, &data);
+	ErrorMessage(ErrorStatus, "ReadFileToData");
+	ErrorStatus = XpmCreatePixmapFromData(dpy, win, data,
+					      &view.pixmap, &view.mask,
+					      &view.attributes);
+	ErrorMessage(ErrorStatus, "CreatePixmapFromData");
+	ErrorStatus = XpmWriteFileFromData("sxpmout.xpm", data);
+	ErrorMessage(ErrorStatus, "WriteFileFromData");
+	free(data);
+#endif
+	
+	ErrorStatus = XpmReadFileToPixmap(dpy, win, input,
+					  &view.pixmap, &view.mask,
+					  &view.attributes);
+	ErrorMessage(ErrorStatus, "Read");
+	if (verbose && view.attributes.nextensions) {
+	    unsigned int i, j;
+	    for (i = 0; i < view.attributes.nextensions; i++) {
+		fprintf(stderr, "Xpm extension : %s\n",
+		       view.attributes.extensions[i].name);
+		for (j = 0; j < view.attributes.extensions[i].nlines; j++)
+		    fprintf(stderr, "\t\t%s\n",
+			    view.attributes.extensions[i].lines[j]);
+	    }
+	}
+    } else {
+#ifdef Debug2
+	ErrorStatus = XpmCreatePixmapFromData(dpy, win, data,
+					      &view.pixmap, &view.mask,
+					      &view.attributes);
+	free(data);
+#else
+	ErrorStatus = XpmCreatePixmapFromData(dpy, win, plaid,
+					      &view.pixmap, &view.mask,
+					      &view.attributes);
+#endif
+	ErrorMessage(ErrorStatus, "Plaid");
+    }
+    if (output || stdoutf) {
+	ErrorStatus = XpmWriteFileFromPixmap(dpy, output, view.pixmap,
+					     view.mask, &view.attributes);
+	ErrorMessage(ErrorStatus, "Write");
+    }
+    if (!nod) {
+
+	/*
+	 * manage display if requested 
+	 */
+
+	XSizeHints size_hints;
+	char *xString = NULL;
+
+	if (w_rtn && h_rtn
+	    && ((w_rtn < view.attributes.width)
+		|| h_rtn < view.attributes.height)) {
+	    resize = 1;
+	}
+	if (resize) {
+	    XtResizeWidget(topw,
+			 view.attributes.width, view.attributes.height, 1);
+	}
+	if (incResize) {
+	    size_hints.flags = USSize | PMinSize | PResizeInc;
+	    size_hints.height = view.attributes.height;
+	    size_hints.width = view.attributes.width;
+	    size_hints.height_inc = view.attributes.height;
+	    size_hints.width_inc = view.attributes.width;
+	} else
+	    size_hints.flags = PMinSize;
+
+	size_hints.min_height = view.attributes.height;
+	size_hints.min_width = view.attributes.width;
+	XSetWMNormalHints(dpy, win, &size_hints);
+
+	if (input) {
+	    xString = (char *) XtMalloc((sizeof(char) * strlen(input)) + 20);
+	    sprintf(xString, "Sxpm: %s\0", input);
+	    XStoreName(dpy, XtWindow(topw), xString);
+	    XSetIconName(dpy, XtWindow(topw), xString);
+	} else if (stdinf) {
+	    XStoreName(dpy, XtWindow(topw), "Sxpm: stdin");
+	    XSetIconName(dpy, XtWindow(topw), "Sxpm: stdin");
+	} else {
+	    XStoreName(dpy, XtWindow(topw), "Sxpm");
+	    XSetIconName(dpy, XtWindow(topw), "Sxpm");
+	}
+
+	XtAddEventHandler(topw, KeyPressMask, False,
+			  (XtEventHandler) kinput, NULL);
+	XSetWindowBackgroundPixmap(dpy, win, view.pixmap);
+
+	if (view.mask)
+	    XShapeCombineMask(dpy, win, ShapeBounding, 0, 0,
+			      view.mask, ShapeSet);
+
+	XClearWindow(dpy, win);
+	XMapWindow(dpy, win);
+	if (xString)
+	    XtFree(xString);
+	XtMainLoop();
+    }
+    Punt(0);
+}
+
+void
+Usage()
+{
+    fprintf(stderr, "\nUsage:  %s [options...]\n", command[0]);
+    fprintf(stderr, "%s\n", "Where options are:");
+    fprintf(stderr, "\n%s\n",
+	    "[-d host:display]            Display to connect to.");
+    fprintf(stderr, "%s\n",
+	    "[-g geom]                    Geometry of window.");
+    fprintf(stderr, "%s\n",
+	    "[-hints]                     Set ResizeInc for window.");
+    fprintf(stderr, "%s\n",
+	    "[-icon filename]             Set pixmap for iconWindow.");
+    fprintf(stderr, "%s\n",
+	    "[-s symbol_name color_name]  Overwrite color defaults.");
+    fprintf(stderr, "%s\n",
+	    "[-p symbol_name pixel_value] Overwrite color defaults.");
+    fprintf(stderr, "%s\n",
+	    "[-closecolors]               Try to use `close' colors.");
+    fprintf(stderr, "%s\n",
+	    "[-plaid]                     Read the included plaid pixmap.");
+    fprintf(stderr, "%s\n",
+	    "[filename]                   Read from file 'filename', and from \
+standard");
+    fprintf(stderr, "%s\n",
+	    "                             input if 'filename' is '-'.");
+    fprintf(stderr, "%s\n",
+	    "[-o filename]                Write to file 'filename', and to \
+standard");
+    fprintf(stderr, "%s\n",
+	    "                             output if 'filename' is '-'.");
+    fprintf(stderr, "%s\n",
+	    "[-nod]                       Don't display in window.");
+    fprintf(stderr, "%s\n",
+	    "[-rgb filename]              Search color names in the \
+rgb text file 'filename'.");
+    fprintf(stderr, "%s\n",
+	    "[-c]                         Use a private colormap.");
+    fprintf(stderr, "%s\n\n",
+	    "[-v]                         Verbose - print out extensions.");
+    fprintf(stderr, "%s\n\n",
+	    "if no input is specified sxpm reads from standard input.");
+    exit(0);
+}
+
+
+void
+ErrorMessage(ErrorStatus, tag)
+    int ErrorStatus;
+    char *tag;
+{
+    char *error = NULL;
+    char *warning = NULL;
+
+    switch (ErrorStatus) {
+    case XpmSuccess:
+	return;
+    case XpmColorError:
+	warning = "Could not parse or alloc requested color";
+	break;
+    case XpmOpenFailed:
+	error = "Cannot open file";
+	break;
+    case XpmFileInvalid:
+	error = "Invalid XPM file";
+	break;
+    case XpmNoMemory:
+	error = "Not enough memory";
+	break;
+    case XpmColorFailed:
+	error = "Failed to parse or alloc some color";
+	break;
+    }
+
+    if (warning)
+	printf("%s Xpm Warning: %s.\n", tag, warning);
+
+    if (error) {
+	printf("%s Xpm Error: %s.\n", tag, error);
+	Punt(1);
+    }
+}
+
+void
+Punt(i)
+    int i;
+{
+    if (icon.pixmap) {
+	XFreePixmap(dpy, icon.pixmap);
+	if (icon.mask)
+	    XFreePixmap(dpy, icon.mask);
+
+	XFreeColors(dpy, colormap,
+		    icon.attributes.pixels, icon.attributes.npixels, 0);
+
+	XpmFreeAttributes(&icon.attributes);
+    }
+    if (view.pixmap) {
+	XFreePixmap(dpy, view.pixmap);
+	if (view.mask)
+	    XFreePixmap(dpy, view.mask);
+
+	XFreeColors(dpy, colormap,
+		    view.attributes.pixels, view.attributes.npixels, 0);
+
+	XpmFreeAttributes(&view.attributes);
+    }
+    exit(i);
+}
+
+void
+kinput(widget, tag, xe, b)
+    Widget widget;
+    char *tag;
+    XEvent *xe;
+    Boolean *b;
+{
+    char c = '\0';
+
+    XLookupString(&(xe->xkey), &c, 1, NULL, NULL);
+    if (c == 'q' || c == 'Q')
+	Punt(0);
+}
diff --git a/src/xpm/sxpm.man b/src/xpm/sxpm.man
new file mode 100644
index 0000000..28b6d44
--- /dev/null
+++ b/src/xpm/sxpm.man
@@ -0,0 +1,89 @@
+.\"Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT
+.TH SXPM 1
+.PD
+.ad b
+.SH NAME
+sxpm \- Show an XPM (X PixMap) file and/or convert XPM2 files to XPM version 3.
+.SH SYNOPSIS
+\fBsxpm\fR
+[\|\fB-d\fR displayname\|] 
+[\|\fB-g\fR geometry\|] 
+[\|\fB-hints\fR\|] 
+[\|\fB-icon\fR filename\|] 
+[\|\fB-s\fR symbol color_name\|] 
+[\|\fB-p\fR symbol pixel_value\|] 
+[\|\fB-plaid\| | \|\fRfilename\| | \|-\|]
+[\|\fB-o\fR filename\| | \|\fB-o\fR -\|] 
+[\|\fB-nod\fR\|] 
+[\|\fB-rgb\fR filename\|] 
+[\|\fB-c\fR\|] 
+[\|\fB-v\fR\|] 
+.SH DESCRIPTION
+.PP
+The \fIsxpm\fP program can be used to view any XPM (version 2 or 3) file and/or
+to convert a file from XPM2 to XPM version 3. If \fIsxpm\fP is run without any
+option specified, the usage is displayed. If no geometry is specified, the
+show window will have the size of the read pixmap. Pressing the key Q in the
+window will quit the program.
+.SH OPTIONS
+.TP 8
+.B \-d \fIdisplay\fP
+Specifies the display to connect to.
+.TP 8
+.B \-g \fIgeom\fP
+Window geometry (default is pixmap's size).
+.TP 8
+.B \-hints
+Set ResizeInc for window.
+.TP 8
+.B \-icon \fIfilename\fP
+Set icon to pixmap created from the file \fIfilename\fP.
+.TP 8
+.B \-s \fIsymbol colorname\fP
+Overwrite default color to \fIsymbol\fP to \fIcolorname\fp.
+.TP 8
+.B \-p \fIsymbol pixelvalue\fP
+Overwrite default color to \fIsymbol\fP to \fIpixelvalue\fp.
+.TP 8
+.B \-closecolors
+Try to use "close colors" before reverting to other visuals.
+.TP 8
+.B \-plaid
+Show the plaid pixmap which is stored as data\fP.
+.TP 8
+.B \fIfilename\fP
+Read from the file \fIfilename\fP and from standard input if \fIfilename\fP is '-'.
+If no input is specified sxpm reads from standard input.
+.TP 8
+.B \-o \fIfilename\fP
+Write to the file \fIfilename\fP (overwrite if it already exists) and to
+standard output if \fIfilename\fP is '-'.
+.TP 8
+.B \-nod
+Do not display the pixmap in a window.  (Useful when using as converter)
+.TP 8
+.B \-rgb \fIfilename\fP
+Search color names in the file \fIfilename\fP and write them out instead of
+the rgb values.
+.TP 8
+.B \-c
+To use a private colormap.
+.TP 8
+.B \-v
+Verbose - to print out extensions (stderr).
+
+
+.SH KNOWN BUGS
+When converting a file from XPM2 to XPM version 3, if several pixels (symbols)
+get the same color only one will be in the file written out.
+.br
+Some window managers may not accept a pixmap which is not a bitmap as icon
+because this does not respect ICCCM, many of the well known ones will accept
+it though.
+
+.SH AUTHOR
+Arnaud Le Hors    (lehors@sophia.inria.fr)
+.br
+Bull Research France
+.br
+Copyright (C) 1990-92,92 by Groupe Bull.
diff --git a/src/xpm/xpm.h b/src/xpm/xpm.h
new file mode 100644
index 0000000..e12b42c
--- /dev/null
+++ b/src/xpm/xpm.h
@@ -0,0 +1,237 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* xpm.h:                                                                      *
+*                                                                             *
+*  XPM library                                                                *
+*  Include file                                                               *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#ifndef XPM_h
+#define XPM_h
+
+#ifdef VMS
+#include "decw$include:Xlib.h"
+#include "decw$include:Intrinsic.h"
+#include "sys$library:stdio.h"
+#else
+#include <stdio.h>
+#include <X11/Xlib.h>
+#include <X11/Intrinsic.h>
+#endif
+
+/* we keep the same codes as for Bitmap management */
+#ifndef _XUTIL_H_
+#ifdef VMS
+#include "decw$include:Xutil.h"
+#else
+#include <X11/Xutil.h>
+#endif
+#endif
+
+/* Return ErrorStatus codes:
+ * null     if full success
+ * positive if partial success
+ * negative if failure
+ */
+
+#define XpmColorError    1
+#define XpmSuccess       0
+#define XpmOpenFailed   -1
+#define XpmFileInvalid  -2
+#define XpmNoMemory     -3
+#define XpmColorFailed  -4
+
+
+typedef struct {
+    char *name;				/* Symbolic color name */
+    char *value;			/* Color value */
+    Pixel pixel;			/* Color pixel */
+}      XpmColorSymbol;
+
+typedef struct {
+    char *name;				/* name of the extension */
+    unsigned int nlines;		/* number of lines in this extension */
+    char **lines;			/* pointer to the extension array of 
+					   strings */
+}      XpmExtension;
+
+typedef struct {
+    unsigned long valuemask;		/* Specifies which attributes are
+					 * defined */
+
+    Visual *visual;			/* Specifies the visual to use */
+    Colormap colormap;			/* Specifies the colormap to use */
+    unsigned int depth;			/* Specifies the depth */
+    unsigned int width;			/* Returns the width of the created
+					 * pixmap */
+    unsigned int height;		/* Returns the height of the created
+					 * pixmap */
+    unsigned int x_hotspot;		/* Returns the x hotspot's
+					 * coordinate */
+    unsigned int y_hotspot;		/* Returns the y hotspot's
+					 * coordinate */
+    unsigned int cpp;			/* Specifies the number of char per
+					 * pixel */
+    Pixel *pixels;			/* List of used color pixels */
+    unsigned int npixels;		/* Number of pixels */
+    XpmColorSymbol *colorsymbols;	/* Array of color symbols to
+					 * override */
+    unsigned int numsymbols;		/* Number of symbols */
+    char *rgb_fname;			/* RGB text file name */
+    unsigned int nextensions;		/* number of extensions */
+    XpmExtension *extensions;		/* pointer to array of extensions */
+
+    /* Infos */
+    unsigned int ncolors;		/* Number of colors */
+    char ***colorTable;			/* Color table pointer */
+    char *hints_cmt;			/* Comment of the hints section */
+    char *colors_cmt;			/* Comment of the colors section */
+    char *pixels_cmt;			/* Comment of the pixels section */
+    unsigned int mask_pixel;		/* Transparent pixel's color table
+					 * index */
+    /* Color Allocation Directives */
+    unsigned int exactColors;		/* Only use exact colors for visual */
+    unsigned int closeness;		/* Allowable RGB deviation */
+
+}      XpmAttributes;
+
+/* Xpm attribute value masks bits */
+#define XpmVisual	   (1L<<0)
+#define XpmColormap	   (1L<<1)
+#define XpmDepth	   (1L<<2)
+#define XpmSize		   (1L<<3)	/* width & height */
+#define XpmHotspot	   (1L<<4)	/* x_hotspot & y_hotspot */
+#define XpmCharsPerPixel   (1L<<5)
+#define XpmColorSymbols	   (1L<<6)
+#define XpmRgbFilename	   (1L<<7)
+#define XpmInfos	   (1L<<8)	/* all infos members */
+#define XpmExtensions      (1L<<10)
+
+#define XpmReturnPixels	   (1L<<9)
+#define XpmReturnInfos	   XpmInfos
+#define XpmReturnExtensions XpmExtensions
+
+#define XpmExactColors     (1L<<11)
+#define XpmCloseness	   (1L<<12)
+
+/*
+ * minimal portability layer between ansi and KR C 
+ */
+
+/* forward declaration of functions with prototypes */
+
+#if __STDC__ || defined(__cplusplus) || defined(c_plusplus)
+ /* ANSI || C++ */
+#define FUNC(f, t, p) extern t f p
+#define LFUNC(f, t, p) static t f p
+#else					/* K&R */
+#define FUNC(f, t, p) extern t f()
+#define LFUNC(f, t, p) static t f()
+#endif					/* end of K&R */
+
+
+/*
+ * functions declarations
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+    FUNC(XpmCreatePixmapFromData, int, (Display * display,
+					Drawable d,
+					char **data,
+					Pixmap * pixmap_return,
+					Pixmap * shapemask_return,
+					XpmAttributes * attributes));
+
+    FUNC(XpmCreateDataFromPixmap, int, (Display * display,
+					char ***data_return,
+					Pixmap pixmap,
+					Pixmap shapemask,
+					XpmAttributes * attributes));
+
+    FUNC(XpmReadFileToPixmap, int, (Display * display,
+				    Drawable d,
+				    char *filename,
+				    Pixmap * pixmap_return,
+				    Pixmap * shapemask_return,
+				    XpmAttributes * attributes));
+
+    FUNC(XpmWriteFileFromPixmap, int, (Display * display,
+				       char *filename,
+				       Pixmap pixmap,
+				       Pixmap shapemask,
+				       XpmAttributes * attributes));
+
+    FUNC(XpmCreateImageFromData, int, (Display * display,
+				       char **data,
+				       XImage ** image_return,
+				       XImage ** shapemask_return,
+				       XpmAttributes * attributes));
+
+    FUNC(XpmCreateDataFromImage, int, (Display * display,
+				       char ***data_return,
+				       XImage * image,
+				       XImage * shapeimage,
+				       XpmAttributes * attributes));
+
+    FUNC(XpmReadFileToImage, int, (Display * display,
+				   char *filename,
+				   XImage ** image_return,
+				   XImage ** shapeimage_return,
+				   XpmAttributes * attributes));
+
+    FUNC(XpmWriteFileFromImage, int, (Display * display,
+				      char *filename,
+				      XImage * image,
+				      XImage * shapeimage,
+				      XpmAttributes * attributes));
+
+    FUNC(XpmAttributesSize, int, ());
+    FUNC(XpmFreeAttributes, int, (XpmAttributes * attributes));
+    FUNC(XpmFreeExtensions, int, (XpmExtension * extensions, int nextensions));
+
+#ifdef __cplusplus
+}					/* for C++ V2.0 */
+
+#endif
+
+
+/* backward compatibility */
+
+/* for version 3.0c */
+#define XpmPixmapColorError  XpmColorError
+#define XpmPixmapSuccess     XpmSuccess
+#define XpmPixmapOpenFailed  XpmOpenFailed
+#define XpmPixmapFileInvalid XpmFileInvalid
+#define XpmPixmapNoMemory    XpmNoMemory
+#define XpmPixmapColorFailed XpmColorFailed
+
+#define XpmReadPixmapFile(dpy, d, file, pix, mask, att) \
+    XpmReadFileToPixmap(dpy, d, file, pix, mask, att)
+#define XpmWritePixmapFile(dpy, file, pix, mask, att) \
+    XpmWriteFileFromPixmap(dpy, file, pix, mask, att)
+
+/* for version 3.0b */
+#define PixmapColorError  XpmColorError
+#define PixmapSuccess     XpmSuccess
+#define PixmapOpenFailed  XpmOpenFailed
+#define PixmapFileInvalid XpmFileInvalid
+#define PixmapNoMemory    XpmNoMemory
+#define PixmapColorFailed XpmColorFailed
+
+#define ColorSymbol XpmColorSymbol
+
+#define XReadPixmapFile(dpy, d, file, pix, mask, att) \
+    XpmReadFileToPixmap(dpy, d, file, pix, mask, att)
+#define XWritePixmapFile(dpy, file, pix, mask, att) \
+    XpmWriteFileFromPixmap(dpy, file, pix, mask, att)
+#define XCreatePixmapFromData(dpy, d, data, pix, mask, att) \
+    XpmCreatePixmapFromData(dpy, d, data, pix, mask, att)
+#define XCreateDataFromPixmap(dpy, data, pix, mask, att) \
+    XpmCreateDataFromPixmap(dpy, data, pix, mask, att)
+
+#endif
diff --git a/src/xpm/xpmP.h b/src/xpm/xpmP.h
new file mode 100644
index 0000000..e65a68c
--- /dev/null
+++ b/src/xpm/xpmP.h
@@ -0,0 +1,279 @@
+/* Copyright 1990-92 GROUPE BULL -- See license conditions in file COPYRIGHT */
+/*****************************************************************************\
+* xpmP.h:                                                                     *
+*                                                                             *
+*  XPM library                                                                *
+*  Private Include file                                                       *
+*                                                                             *
+*  Developed by Arnaud Le Hors                                                *
+\*****************************************************************************/
+
+#ifndef XPMP_h
+#define XPMP_h
+
+#ifdef Debug
+/* memory leak control tool */
+#include <mnemosyne.h>
+#endif
+
+#ifdef VMS
+#include "decw$include:Xlib.h"
+#include "decw$include:Intrinsic.h"
+#include "sys$library:stdio.h"
+#else
+#include <stdio.h>
+#include <stdlib.h>
+#include <X11/Xlib.h>
+#include <X11/Intrinsic.h>
+/* stdio.h doesn't declare popen on a Sequent DYNIX OS */
+#ifdef sequent
+extern FILE *popen();
+#endif
+#endif
+
+#include "xpm.h"
+
+/* we keep the same codes as for Bitmap management */
+#ifndef _XUTIL_H_
+#ifdef VMS
+#include "decw$include:Xutil.h"
+#else
+#include <X11/Xutil.h>
+#endif
+#endif
+
+#if defined(SYSV) || defined(SVR4)
+#define bcopy(source, dest, count) memcpy(dest, source, count)
+#define bzero(addr, count) memset(addr, 0, count)
+#endif
+
+typedef struct {
+    unsigned int type;
+    union {
+	FILE *file;
+	char **data;
+    }     stream;
+    char *cptr;
+    unsigned int line;
+    int CommentLength;
+    char Comment[BUFSIZ];
+    char *Bcmt, *Ecmt, Bos, Eos;
+}      xpmData;
+
+#define XPMARRAY 0
+#define XPMFILE  1
+#define XPMPIPE  2
+
+typedef unsigned char byte;
+
+#define EOL '\n'
+#define TAB '\t'
+#define SPC ' '
+
+typedef struct {
+    char *type;				/* key word */
+    char *Bcmt;				/* string beginning comments */
+    char *Ecmt;				/* string ending comments */
+    char Bos;				/* character beginning strings */
+    char Eos;				/* character ending strings */
+    char *Strs;				/* strings separator */
+    char *Dec;				/* data declaration string */
+    char *Boa;				/* string beginning assignment */
+    char *Eoa;				/* string ending assignment */
+}      xpmDataType;
+
+extern xpmDataType xpmDataTypes[];
+
+/*
+ * rgb values and ascii names (from rgb text file) rgb values,
+ * range of 0 -> 65535 color mnemonic of rgb value
+ */
+typedef struct {
+    int r, g, b;
+    char *name;
+}      xpmRgbName;
+
+/* Maximum number of rgb mnemonics allowed in rgb text file. */
+#define MAX_RGBNAMES 1024
+
+extern char *xpmColorKeys[];
+
+#define TRANSPARENT_COLOR "None"	/* this must be a string! */
+
+/* number of xpmColorKeys */
+#define NKEYS 5
+
+/*
+ * key numbers for visual type, they must fit along with the number key of
+ * each corresponding element in xpmColorKeys[] defined in xpm.h
+ */
+#define MONO	2
+#define GRAY4	3
+#define GRAY 	4
+#define COLOR	5
+
+/* structure containing data related to an Xpm pixmap */
+typedef struct {
+    char *name;
+    unsigned int width;
+    unsigned int height;
+    unsigned int cpp;
+    unsigned int ncolors;
+    char ***colorTable;
+    unsigned int *pixelindex;
+    XColor *xcolors;
+    char **colorStrings;
+    unsigned int mask_pixel;		/* mask pixel's colorTable index */
+}      xpmInternAttrib;
+
+#define UNDEF_PIXEL 0x80000000
+
+/* XPM private routines */
+
+FUNC(xpmWriteData, int, (xpmData * mdata,
+		    xpmInternAttrib * attrib, XpmAttributes * attributes));
+
+FUNC(xpmCreateData, int, (char ***data_return,
+		    xpmInternAttrib * attrib, XpmAttributes * attributes));
+
+FUNC(xpmParseDataAndCreateImage, int, (xpmData * data,
+				       Display * display,
+				       XImage ** image_return,
+				       XImage ** shapeimage_return,
+				       xpmInternAttrib * attrib_return,
+				       XpmAttributes * attributes));
+
+FUNC(xpmCreateImage, int, (Display * display,
+			   xpmInternAttrib * attrib,
+			   XImage ** image_return,
+			   XImage ** shapeimage_return,
+			   XpmAttributes * attributes));
+
+FUNC(xpmParseData, int, (xpmData * data,
+			 xpmInternAttrib * attrib_return,
+			 XpmAttributes * attributes));
+
+FUNC(xpmScanImage, int, (Display * display,
+			 XImage * image,
+			 XImage * shapeimage,
+			 XpmAttributes * attributes,
+			 xpmInternAttrib * attrib));
+
+FUNC(xpmFreeColorTable, int, (char ***colorTable, int ncolors));
+
+FUNC(xpmInitInternAttrib, int, (xpmInternAttrib * xmpdata));
+
+FUNC(xpmFreeInternAttrib, int, (xpmInternAttrib * xmpdata));
+
+FUNC(xpmSetAttributes, int, (xpmInternAttrib * attrib,
+			     XpmAttributes * attributes));
+
+FUNC(xpmGetAttributes, int, (XpmAttributes * attributes,
+			     xpmInternAttrib * attrib));
+
+/* I/O utility */
+
+FUNC(xpmNextString, int, (xpmData * mdata));
+FUNC(xpmNextUI, int, (xpmData * mdata, unsigned int *ui_return));
+
+#define xpmGetC(mdata) \
+	(mdata->type ? (getc(mdata->stream.file)) : (*mdata->cptr++))
+
+FUNC(xpmNextWord, unsigned int, (xpmData * mdata, char *buf));
+FUNC(xpmGetCmt, int, (xpmData * mdata, char **cmt));
+FUNC(xpmReadFile, int, (char *filename, xpmData * mdata));
+FUNC(xpmWriteFile, int, (char *filename, xpmData * mdata));
+FUNC(xpmOpenArray, void, (char **data, xpmData * mdata));
+FUNC(XpmDataClose, int, (xpmData * mdata));
+
+/* RGB utility */
+
+FUNC(xpmReadRgbNames, int, (char *rgb_fname, xpmRgbName * rgbn));
+FUNC(xpmGetRgbName, char *, (xpmRgbName * rgbn, int rgbn_max,
+			     int red, int green, int blue));
+FUNC(xpmFreeRgbNames, void, (xpmRgbName * rgbn, int rgbn_max));
+
+FUNC(xpm_xynormalizeimagebits, void, (register unsigned char *bp,
+				      register XImage * img));
+FUNC(xpm_znormalizeimagebits, void, (register unsigned char *bp,
+				     register XImage * img));
+
+/*
+ * Macros
+ * 
+ * The XYNORMALIZE macro determines whether XY format data requires 
+ * normalization and calls a routine to do so if needed. The logic in
+ * this module is designed for LSBFirst byte and bit order, so 
+ * normalization is done as required to present the data in this order.
+ *
+ * The ZNORMALIZE macro performs byte and nibble order normalization if 
+ * required for Z format data.
+ * 
+ * The XYINDEX macro computes the index to the starting byte (char) boundary
+ * for a bitmap_unit containing a pixel with coordinates x and y for image
+ * data in XY format.
+ * 
+ * The ZINDEX* macros compute the index to the starting byte (char) boundary 
+ * for a pixel with coordinates x and y for image data in ZPixmap format.
+ * 
+ */
+
+#define XYNORMALIZE(bp, img) \
+    if ((img->byte_order == MSBFirst) || (img->bitmap_bit_order == MSBFirst)) \
+	xpm_xynormalizeimagebits((unsigned char *)(bp), img)
+
+#define ZNORMALIZE(bp, img) \
+    if (img->byte_order == MSBFirst) \
+	xpm_znormalizeimagebits((unsigned char *)(bp), img)
+
+#define XYINDEX(x, y, img) \
+    ((y) * img->bytes_per_line) + \
+    (((x) + img->xoffset) / img->bitmap_unit) * (img->bitmap_unit >> 3)
+
+#define ZINDEX(x, y, img) ((y) * img->bytes_per_line) + \
+    (((x) * img->bits_per_pixel) >> 3)
+
+#define ZINDEX32(x, y, img) ((y) * img->bytes_per_line) + ((x) << 2)
+
+#define ZINDEX16(x, y, img) ((y) * img->bytes_per_line) + ((x) << 1)
+
+#define ZINDEX8(x, y, img) ((y) * img->bytes_per_line) + (x)
+
+#define ZINDEX1(x, y, img) ((y) * img->bytes_per_line) + ((x) >> 3)
+
+#if __STDC__
+#define Const const
+#else
+#define Const				/**/
+#endif
+
+/*
+ * there are structures and functions related to hastable code
+ */
+
+typedef struct _xpmHashAtom {
+    char *name;
+    void *data;
+}      *xpmHashAtom;
+
+typedef struct {
+    int size;
+    int limit;
+    int used;
+    xpmHashAtom *atomTable;
+} xpmHashTable;
+
+FUNC(xpmHashTableInit, int, (xpmHashTable *table));
+FUNC(xpmHashTableFree, void, (xpmHashTable *table));
+FUNC(xpmHashSlot, xpmHashAtom *, (xpmHashTable *table, char *s));
+FUNC(xpmHashIntern, int, (xpmHashTable *table, char *tag, void *data));
+
+#define HashAtomData(i) ((void *)i)
+#define HashColorIndex(slot) ((unsigned int)(unsigned long)((*slot)->data))
+#define USE_HASHTABLE (cpp > 2 && ncolors > 4)
+
+#ifdef NEED_STRDUP
+FUNC(strdup, char *, (char *s1));
+#endif
+
+#endif